ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Socket.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.27 by root, Mon May 26 04:30:30 2008 UTC vs.
Revision 1.42 by root, Thu May 29 23:18:37 2008 UTC

… …
38no warnings; 38no warnings;
39use strict; 39use strict;
40 40
41use Carp (); 41use Carp ();
42use Errno (); 42use Errno ();
43use Socket qw(AF_INET SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR); 43use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);
44 44
45use AnyEvent (); 45use AnyEvent ();
46use AnyEvent::Util qw(guard fh_nonblocking AF_INET6); 46use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);
47use AnyEvent::DNS (); 47use AnyEvent::DNS ();
48 48
49use base 'Exporter'; 49use base 'Exporter';
50 50
51our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect); 51our @EXPORT = qw(
52 parse_ipv4 parse_ipv6
53 parse_ip parse_address
54 format_ip format_address
55 address_family
56 inet_aton
57 tcp_server
58 tcp_connect
59);
52 60
53our $VERSION = '1.0'; 61our $VERSION = '1.0';
54 62
55=item $ipn = parse_ipv4 $dotted_quad 63=item $ipn = parse_ipv4 $dotted_quad
56 64
… …
128 136
129 # and done 137 # and done
130 pack "n*", map hex, @h, @t 138 pack "n*", map hex, @h, @t
131} 139}
132 140
141sub parse_unix($) {
142 $_[0] eq "unix/"
143 ? pack "S", AF_UNIX
144 : undef
145
146}
147
133=item $ipn = parse_ip $text 148=item $ipn = parse_address $text
134 149
135Combines C<parse_ipv4> and C<parse_ipv6> in one function. 150Combines C<parse_ipv4> and C<parse_ipv6> in one function. The address
151here refers to the host address (not socket address) in network form
152(binary).
136 153
137=cut 154If the C<$text> is C<unix/>, then this function returns a special token
155recognised by the other functions in this module to mean "UNIX domain
156socket".
138 157
158=cut
159
139sub parse_ip($) { 160sub parse_address($) {
140 &parse_ipv4 || &parse_ipv6 161 &parse_ipv4 || &parse_ipv6 || &parse_unix
141} 162}
142 163
164*parse_ip =\&parse_address; #d#
165
166=item $sa_family = address_family $ipn
167
168Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)
169of the given host address in network format.
170
171=cut
172
173sub address_family($) {
174 4 == length $_[0]
175 ? AF_INET
176 : 16 == length $_[0]
177 ? AF_INET6
178 : unpack "S", $_[0]
179}
180
143=item $text = format_ip $ipn 181=item $text = format_address $ipn
144 182
145Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets) 183Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16
146and converts it into textual form. 184octets for IPv6) and convert it into textual form.
185
186Returns C<unix/> for UNIX domain sockets.
147 187
148This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>, 188This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>,
149except it automatically detects the address type. 189except it automatically detects the address type.
150 190
151=cut 191Returns C<undef> if it cannot detect the type.
152 192
153sub format_ip; 193=cut
194
195sub format_address;
154sub format_ip($) { 196sub format_address($) {
155 if (4 == length $_[0]) { 197 my $af = address_family $_[0];
198 if ($af == AF_INET) {
156 return join ".", unpack "C4", $_[0] 199 return join ".", unpack "C4", $_[0]
157 } elsif (16 == length $_[0]) { 200 } elsif ($af == AF_INET6) {
201 if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {
202 return "::";
203 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {
204 return "::1";
205 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
206 # v4compatible
207 return "::" . format_address substr $_[0], 12;
158 if (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { 208 } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
159 # v4mapped 209 # v4mapped
160 return "::ffff:" . format_ip substr $_[0], 12; 210 return "::ffff:" . format_address substr $_[0], 12;
211 } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
212 # v4translated
213 return "::ffff:0:" . format_address substr $_[0], 12;
161 } else { 214 } else {
162 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; 215 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
163 216
217 # this is rather sucky, I admit
164 $ip =~ s/^0:(?:0:)*(0$)?/::/ 218 $ip =~ s/^0:(?:0:)*(0$)?/::/
165 or $ip =~ s/(:0)+$/::/ 219 or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/
166 or $ip =~ s/(:0)+/:/; 220 or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/
221 or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/
222 or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/
223 or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/
224 or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/
225 or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/;
167 return $ip 226 return $ip
168 } 227 }
228 } elsif ($af == AF_UNIX) {
229 return "unix/"
169 } else { 230 } else {
170 return undef 231 return undef
171 } 232 }
172} 233}
234
235*format_ip = \&format_address;
173 236
174=item inet_aton $name_or_address, $cb->(@addresses) 237=item inet_aton $name_or_address, $cb->(@addresses)
175 238
176Works similarly to its Socket counterpart, except that it uses a 239Works similarly to its Socket counterpart, except that it uses a
177callback. Also, if a host has only an IPv6 address, this might be passed 240callback. Also, if a host has only an IPv6 address, this might be passed
178to the callback instead (use the length to detect this - 4 for IPv4, 16 241to the callback instead (use the length to detect this - 4 for IPv4, 16
179for IPv6). 242for IPv6).
180 243
181Unlike the L<Socket> function of the same name, you can get multiple IPv4 244Unlike the L<Socket> function of the same name, you can get multiple IPv4
182and IPv6 addresses as result. 245and IPv6 addresses as result (and maybe even other adrdess types).
183 246
184=cut 247=cut
185 248
186sub inet_aton { 249sub inet_aton {
187 my ($name, $cb) = @_; 250 my ($name, $cb) = @_;
… …
205 } 268 }
206 }); 269 });
207 } 270 }
208} 271}
209 272
273# check for broken platforms with extra field in sockaddr structure
274# kind of a rfc vs. bsd issue, as usual (ok, normally it's a
275# unix vs. bsd issue, a iso C vs. bsd issue or simply a
276# correctness vs. bsd issue.
277my $pack_family = (0x55 == Socket::sockaddr_family "\x55\x55")
278 ? "xC" : "S";
279
210=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host 280=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host
211 281
212Pack the given port/host combination into a binary sockaddr structure. Handles 282Pack the given port/host combination into a binary sockaddr
213both IPv4 and IPv6 host addresses. 283structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX
284domain sockets (C<$host> == C<unix/> and C<$service> == absolute
285pathname).
214 286
215=cut 287=cut
216 288
217sub pack_sockaddr($$) { 289sub pack_sockaddr($$) {
218 if (4 == length $_[1]) { 290 my $af = address_family $_[1];
291
292 if ($af == AF_INET) {
219 Socket::pack_sockaddr_in $_[0], $_[1] 293 Socket::pack_sockaddr_in $_[0], $_[1]
220 } elsif (16 == length $_[1]) { 294 } elsif ($af == AF_INET6) {
221 pack "SnL a16 L", 295 pack "$pack_family nL a16 L",
222 AF_INET6, 296 AF_INET6,
223 $_[0], # port 297 $_[0], # port
224 0, # flowinfo 298 0, # flowinfo
225 $_[1], # addr 299 $_[1], # addr
226 0 # scope id 300 0 # scope id
301 } elsif ($af == AF_UNIX) {
302 Socket::pack_sockaddr_un $_[0]
227 } else { 303 } else {
228 Carp::croak "pack_sockaddr: invalid host"; 304 Carp::croak "pack_sockaddr: invalid host";
229 } 305 }
230} 306}
231 307
232=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa 308=item ($service, $host) = AnyEvent::Socket::unpack_sockaddr $sa
233 309
234Unpack the given binary sockaddr structure (as used by bind, getpeername 310Unpack the given binary sockaddr structure (as used by bind, getpeername
235etc.) into a C<$port, $host> combination. 311etc.) into a C<$service, $host> combination.
236 312
237Handles both IPv4 and IPv6 sockaddr structures. 313For IPv4 and IPv6, C<$service> is the port number and C<$host> the host
314address in network format (binary).
315
316For UNIX domain sockets, C<$service> is the absolute pathname and C<$host>
317is a special token that is understood by the other functions in this
318module (C<format_address> converts it to C<unix/>).
238 319
239=cut 320=cut
240 321
241sub unpack_sockaddr($) { 322sub unpack_sockaddr($) {
242 my $af = unpack "S", $_[0]; 323 my $af = Socket::sockaddr_family $_[0];
243 324
244 if ($af == AF_INET) { 325 if ($af == AF_INET) {
245 Socket::unpack_sockaddr_in $_[0] 326 Socket::unpack_sockaddr_in $_[0]
246 } elsif ($af == AF_INET6) { 327 } elsif ($af == AF_INET6) {
247 unpack "x2 n x4 a16", $_[0] 328 unpack "x2 n x4 a16", $_[0]
329 } elsif ($af == AF_UNIX) {
330 ((Socket::unpack_sockaddr_un $_[0]), pack "S", AF_UNIX)
248 } else { 331 } else {
249 Carp::croak "unpack_sockaddr: unsupported protocol family $af"; 332 Carp::croak "unpack_sockaddr: unsupported protocol family $af";
250 } 333 }
251} 334}
252 335
253sub _tcp_port($) { 336=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
254 $_[0] =~ /^(\d*)$/ and return $1*1;
255 337
256 (getservbyname $_[0], "tcp")[2] 338Tries to resolve the given nodename and service name into protocol families
339and sockaddr structures usable to connect to this node and service in a
340protocol-independent way. It works remotely similar to the getaddrinfo
341posix function.
342
343For internet addresses, C<$node> is either an IPv4 or IPv6 address or an
344internet hostname, and C<$service> is either a service name (port name
345from F</etc/services>) or a numerical port number. If both C<$node> and
346C<$service> are names, then SRV records will be consulted to find the real
347service, otherwise they will be used as-is. If you know that the service
348name is not in your services database, then you can specify the service in
349the format C<name=port> (e.g. C<http=80>).
350
351For UNIX domain sockets, C<$node> must be the string C<unix/> and
352C<$service> must be the absolute pathname of the socket. In this case,
353C<$proto> will be ignored.
354
355C<$proto> must be a protocol name, currently C<tcp>, C<udp> or
356C<sctp>. The default is currently C<tcp>, but in the future, this function
357might try to use other protocols such as C<sctp>, depending on the socket
358type and any SRV records it might find.
359
360C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
361only IPv4) or C<6> (use only IPv6). This setting might be influenced by
362C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
363
364C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
365C<undef> in which case it gets automatically chosen).
366
367The callback will receive zero or more array references that contain
368C<$family, $type, $proto> for use in C<socket> and a binary
369C<$sockaddr> for use in C<connect> (or C<bind>).
370
371The application should try these in the order given.
372
373Example:
374
375 resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
376
377=cut
378
379sub resolve_sockaddr($$$$$$) {
380 my ($node, $service, $proto, $family, $type, $cb) = @_;
381
382 if ($node eq "unix/") {
383 return $cb->() if $family || !/^\//; # no can do
384
385 return $cb->([AF_UNIX, $type, 0, Socket::pack_sockaddr_un $service]);
386 }
387
388 unless (AF_INET6) {
389 $family != 6
390 or return $cb->();
391
392 $family = 4;
393 }
394
395 $cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4};
396 $cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6};
397
398 $family ||= 4 unless $AnyEvent::PROTOCOL{ipv6};
399 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4};
400
401 $proto ||= "tcp";
402 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
403
404 my $proton = (getprotobyname $proto)[2]
257 or Carp::croak "$_[0]: service unknown" 405 or Carp::croak "$proto: protocol unknown";
406
407 my $port;
408
409 if ($service =~ /^(\S+)=(\d+)$/) {
410 ($service, $port) = ($1, $2);
411 } elsif ($service =~ /^\d+$/) {
412 ($service, $port) = (undef, $service);
413 } else {
414 $port = (getservbyname $service, $proto)[2]
415 or Carp::croak "$service/$proto: service unknown";
416 }
417
418 my @target = [$node, $port];
419
420 # resolve a records / provide sockaddr structures
421 my $resolve = sub {
422 my @res;
423 my $cv = AnyEvent->condvar (cb => sub {
424 $cb->(
425 map $_->[2],
426 sort {
427 $AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}
428 or $a->[0] <=> $b->[0]
429 }
430 @res
431 )
432 });
433
434 $cv->begin;
435 for my $idx (0 .. $#target) {
436 my ($node, $port) = @{ $target[$idx] };
437
438 if (my $noden = parse_address $node) {
439 my $af = address_family $noden;
440
441 if ($af == AF_INET && $family != 6) {
442 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
443 pack_sockaddr $port, $noden]]
444 }
445
446 if ($af == AF_INET6 && $family != 4) {
447 push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
448 pack_sockaddr $port, $noden]]
449 }
450 } else {
451 # ipv4
452 if ($family != 6) {
453 $cv->begin;
454 AnyEvent::DNS::a $node, sub {
455 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
456 pack_sockaddr $port, parse_ipv4 $_]]
457 for @_;
458 $cv->end;
459 };
460 }
461
462 # ipv6
463 if ($family != 4) {
464 $cv->begin;
465 AnyEvent::DNS::aaaa $node, sub {
466 push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
467 pack_sockaddr $port, parse_ipv6 $_]]
468 for @_;
469 $cv->end;
470 };
471 }
472 }
473 }
474 $cv->end;
475 };
476
477 # try srv records, if applicable
478 if ($node eq "localhost") {
479 @target = (["127.0.0.1", $port], ["::1", $port]);
480 &$resolve;
481 } elsif (defined $service && !parse_address $node) {
482 AnyEvent::DNS::srv $service, $proto, $node, sub {
483 my (@srv) = @_;
484
485 # no srv records, continue traditionally
486 @srv
487 or return &$resolve;
488
489 # only srv record has "." ("" here) => abort
490 $srv[0][2] ne "" || $#srv
491 or return $cb->();
492
493 # use srv records then
494 @target = map ["$_->[3].", $_->[2]],
495 grep $_->[3] ne ".",
496 @srv;
497
498 &$resolve;
499 };
500 } else {
501 &$resolve;
502 }
258} 503}
259 504
260=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb] 505=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
261 506
262This is a convenience function that creates a TCP socket and makes a 100% 507This is a convenience function that creates a TCP socket and makes a 100%
263non-blocking connect to the given C<$host> (which can be a hostname or a 508non-blocking connect to the given C<$host> (which can be a hostname or
509a textual IP address, or the string C<unix/> for UNIX domain sockets)
264textual IP address) and C<$service> (which can be a numeric port number or 510and C<$service> (which can be a numeric port number or a service name,
265a service name, or a C<servicename=portnumber> string). 511or a C<servicename=portnumber> string, or the pathname to a UNIX domain
512socket).
266 513
267If both C<$host> and C<$port> are names, then this function will use SRV 514If both C<$host> and C<$port> are names, then this function will use SRV
268records to locate the real target(s). 515records to locate the real target(s).
269 516
270In either case, it will create a list of target hosts (e.g. for multihomed 517In either case, it will create a list of target hosts (e.g. for multihomed
… …
302timeout is to be used). 549timeout is to be used).
303 550
304Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP 551Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP
305socket (although only IPv4 is currently supported by this module). 552socket (although only IPv4 is currently supported by this module).
306 553
307Note to Microsoft Windows users: Windows (of course) doesn't correctly 554Note to the poor Microsoft Windows users: Windows (of course) doesn't
308signal connection errors at all, so unless your event library works around 555correctly signal connection errors, so unless your event library works
309this failed connections will simply hang and time-out. The only event 556around this, failed connections will simply hang. The only event libraries
310library that handles this condition correctly is L<EV>, so this is highly 557that handle this condition correctly are L<EV> and L<Glib>. Additionally,
558AnyEvent works around this bug with L<Event> and in its pure-perl
559backend. All other libraries cannot correctly handle this condition. To
311recommended. To lessen the impact of this windows bug, a default timeout 560lessen the impact of this windows bug, a default timeout of 30 seconds
312of 30 seconds will be imposed on windows. Cygwin is not affected. 561will be imposed on windows. Cygwin is not affected.
313 562
314Simple Example: connect to localhost on port 22. 563Simple Example: connect to localhost on port 22.
315 564
316 tcp_connect localhost => 22, sub { 565 tcp_connect localhost => 22, sub {
317 my $fh = shift 566 my $fh = shift
… …
355 # could call $fh->bind etc. here 604 # could call $fh->bind etc. here
356 605
357 15 606 15
358 }; 607 };
359 608
609Example: connect to a UNIX domain socket.
610
611 tcp_connect "unix/", "/tmp/.X11-unix/X0", sub {
612 ...
613 }
614
360=cut 615=cut
361 616
362sub tcp_connect($$$;$) { 617sub tcp_connect($$$;$) {
363 my ($host, $port, $connect, $prepare) = @_; 618 my ($host, $port, $connect, $prepare) = @_;
364 619
365 # see http://cr.yp.to/docs/connect.html for some background 620 # see http://cr.yp.to/docs/connect.html for some background
621 # also http://advogato.org/article/672.html
366 622
367 my %state = ( fh => undef ); 623 my %state = ( fh => undef );
368 624
369 # name resolution 625 # name/service to type/sockaddr resolution
370 AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub { 626 resolve_sockaddr $host, $port, 0, 0, 0, sub {
371 my @target = @_; 627 my @target = @_;
372 628
373 $state{next} = sub { 629 $state{next} = sub {
374 return unless exists $state{fh}; 630 return unless exists $state{fh};
375 631
… …
387 643
388 fh_nonblocking $state{fh}, 1; 644 fh_nonblocking $state{fh}, 1;
389 645
390 my $timeout = $prepare && $prepare->($state{fh}); 646 my $timeout = $prepare && $prepare->($state{fh});
391 647
392 $timeout ||= 30 if $^O =~ /mswin32/i; 648 $timeout ||= 30 if AnyEvent::WIN32;
393 649
394 $state{to} = AnyEvent->timer (after => $timeout, cb => sub { 650 $state{to} = AnyEvent->timer (after => $timeout, cb => sub {
395 $! = &Errno::ETIMEDOUT; 651 $! = &Errno::ETIMEDOUT;
396 $state{next}(); 652 $state{next}();
397 }) if $timeout; 653 }) if $timeout;
… …
408 664
409 my $guard = guard { 665 my $guard = guard {
410 %state = (); 666 %state = ();
411 }; 667 };
412 668
413 $connect->($state{fh}, format_ip $host, $port, sub { 669 $connect->($state{fh}, format_address $host, $port, sub {
414 $guard->cancel; 670 $guard->cancel;
415 $state{next}(); 671 $state{next}();
416 }); 672 });
417 } else { 673 } else {
418 # dummy read to fetch real error code 674 # dummy read to fetch real error code
… …
422 }; 678 };
423 679
424 # now connect 680 # now connect
425 if (connect $state{fh}, $sockaddr) { 681 if (connect $state{fh}, $sockaddr) {
426 $connected->(); 682 $connected->();
427 } elsif ($! == &Errno::EINPROGRESS || $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX 683 } elsif ($! == &Errno::EINPROGRESS # POSIX
684 || $! == &Errno::EWOULDBLOCK
685 # WSAEINPROGRESS intentionally not checked - it means something else entirely
686 || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
687 || $! == AnyEvent::Util::WSAEWOULDBLOCK) {
428 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected); 688 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
429 } else { 689 } else {
430 %state = (); 690 $state{next}();
431 $connect->();
432 } 691 }
433 }; 692 };
434 693
435 $! = &Errno::ENXIO; 694 $! = &Errno::ENXIO;
436 $state{next}(); 695 $state{next}();
437 }; 696 };
438 697
439 defined wantarray && guard { %state = () } 698 defined wantarray && guard { %state = () }
440} 699}
441 700
442=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb] 701=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]
443 702
444Create and bind a TCP socket to the given host, and port, set the 703Create and bind a stream socket to the given host, and port, set the
445SO_REUSEADDR flag and call C<listen>. 704SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name
705implies, this function can also bind on UNIX domain sockets.
446 706
447C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it 707For internet sockets, C<$host> must be an IPv4 or IPv6 address (or
448binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the 708C<undef>, in which case it binds either to C<0> or to C<::>, depending
449preferred protocol). 709on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in
710future versions, as applicable).
450 711
451To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6 712To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
452wildcard address, use C<::>. 713wildcard address, use C<::>.
453 714
454The port is specified by C<$port>, which must be either a service name or 715The port is specified by C<$service>, which must be either a service name or
455a numeric port number (or C<0> or C<undef>, in which case an ephemeral 716a numeric port number (or C<0> or C<undef>, in which case an ephemeral
456port will be used). 717port will be used).
718
719For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be
720the absolute pathname of the socket. This function will try to C<unlink>
721the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,
722below.
457 723
458For each new connection that could be C<accept>ed, call the C<< 724For each new connection that could be C<accept>ed, call the C<<
459$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking 725$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
460mode) as first and the peer host and port as second and third arguments 726mode) as first and the peer host and port as second and third arguments
461(see C<tcp_connect> for details). 727(see C<tcp_connect> for details).
… …
473address and port number of the local socket endpoint as second and third 739address and port number of the local socket endpoint as second and third
474arguments. 740arguments.
475 741
476It should return the length of the listen queue (or C<0> for the default). 742It should return the length of the listen queue (or C<0> for the default).
477 743
744Note to IPv6 users: RFC-compliant behaviour for IPv6 sockets listening on
745C<::> is to bind to both IPv6 and IPv4 addresses by default on dual-stack
746hosts. Unfortunately, only GNU/Linux seems to implement this properly, so
747if you want both IPv4 and IPv6 listening sockets you should create the
748IPv6 socket first and then attempt to bind on the IPv4 socket, but ignore
749any C<EADDRINUSE> errors.
750
478Example: bind on some TCP port on the local machine and tell each client 751Example: bind on some TCP port on the local machine and tell each client
479to go away. 752to go away.
480 753
481 tcp_server undef, undef, sub { 754 tcp_server undef, undef, sub {
482 my ($fh, $host, $port) = @_; 755 my ($fh, $host, $port) = @_;
… …
488 }; 761 };
489 762
490=cut 763=cut
491 764
492sub tcp_server($$$;$) { 765sub tcp_server($$$;$) {
493 my ($host, $port, $accept, $prepare) = @_; 766 my ($host, $service, $accept, $prepare) = @_;
494 767
495 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6 768 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
496 ? "::" : "0" 769 ? "::" : "0"
497 unless defined $host; 770 unless defined $host;
498 771
499 my $ipn = parse_ip $host 772 my $ipn = parse_address $host
500 or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address"; 773 or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address";
501 774
502 my $domain = 4 == length $ipn ? AF_INET : AF_INET6; 775 my $af = address_family $ipn;
503 776
504 my %state; 777 my %state;
505 778
779 # win32 perl is too stupid to get this right :/
780 Carp::croak "tcp_server/socket: address family not supported"
781 if AnyEvent::WIN32 && $af == AF_UNIX;
782
506 socket $state{fh}, $domain, SOCK_STREAM, 0 783 socket $state{fh}, $af, SOCK_STREAM, 0
507 or Carp::croak "socket: $!"; 784 or Carp::croak "tcp_server/socket: $!";
508 785
786 if ($af == AF_INET || $af == AF_INET6) {
509 setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1 787 setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
510 or Carp::croak "so_reuseaddr: $!"; 788 or Carp::croak "tcp_server/so_reuseaddr: $!"
789 unless AnyEvent::WIN32; # work around windows bug
511 790
791 unless ($service =~ /^\d*$/) {
792 $service = (getservbyname $service, "tcp")[2]
793 or Carp::croak "$service: service unknown"
794 }
795 } elsif ($af == AF_UNIX) {
796 unlink $service;
797 }
798
512 bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn 799 bind $state{fh}, pack_sockaddr $service, $ipn
513 or Carp::croak "bind: $!"; 800 or Carp::croak "bind: $!";
514 801
515 fh_nonblocking $state{fh}, 1; 802 fh_nonblocking $state{fh}, 1;
516 803
517 my $len; 804 my $len;
518 805
519 if ($prepare) { 806 if ($prepare) {
520 my ($port, $host) = unpack_sockaddr getsockname $state{fh}; 807 my ($service, $host) = unpack_sockaddr getsockname $state{fh};
521 $len = $prepare && $prepare->($state{fh}, format_ip $host, $port); 808 $len = $prepare && $prepare->($state{fh}, format_address $host, $service);
522 } 809 }
523 810
524 $len ||= 128; 811 $len ||= 128;
525 812
526 listen $state{fh}, $len 813 listen $state{fh}, $len
… …
528 815
529 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub { 816 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
530 # this closure keeps $state alive 817 # this closure keeps $state alive
531 while (my $peer = accept my $fh, $state{fh}) { 818 while (my $peer = accept my $fh, $state{fh}) {
532 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not 819 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
820
533 my ($port, $host) = unpack_sockaddr $peer; 821 my ($service, $host) = unpack_sockaddr $peer;
534 $accept->($fh, format_ip $host, $port); 822 $accept->($fh, format_address $host, $service);
535 } 823 }
536 }); 824 });
537 825
538 defined wantarray 826 defined wantarray
539 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency 827 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
… …
542 830
5431; 8311;
544 832
545=back 833=back
546 834
835=head1 SECURITY CONSIDERATIONS
836
837This module is quite powerful, with with power comes the ability to abuse
838as well: If you accept "hostnames" and ports from untrusted sources,
839then note that this can be abused to delete files (host=C<unix/>). This
840is not really a problem with this module, however, as blindly accepting
841any address and protocol and trying to bind a server or connect to it is
842harmful in general.
843
547=head1 AUTHOR 844=head1 AUTHOR
548 845
549 Marc Lehmann <schmorp@schmorp.de> 846 Marc Lehmann <schmorp@schmorp.de>
550 http://home.schmorp.de/ 847 http://home.schmorp.de/
551 848

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines