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.30 by root, Mon May 26 06:18:53 2008 UTC vs.
Revision 1.36 by root, Wed May 28 21:29:03 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 eq substr $_[0], 0, 12) {
202 # v4compatible
203 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) { 204 } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
159 # v4mapped 205 # v4mapped
160 return "::ffff:" . format_ip substr $_[0], 12; 206 return "::ffff:" . format_address substr $_[0], 12;
207 } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
208 # v4translated
209 return "::ffff:0:" . format_address substr $_[0], 12;
161 } else { 210 } else {
162 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; 211 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
163 212
164 $ip =~ s/^0:(?:0:)*(0$)?/::/ 213 $ip =~ s/^0:(?:0:)*(0$)?/::/
165 or $ip =~ s/(:0)+$/::/ 214 or $ip =~ s/(:0)+$/::/
166 or $ip =~ s/(:0)+/:/; 215 or $ip =~ s/(:0)+/:/;
167 return $ip 216 return $ip
168 } 217 }
218 } elsif ($af == AF_UNIX) {
219 return "unix/"
169 } else { 220 } else {
170 return undef 221 return undef
171 } 222 }
172} 223}
224
225*format_ip = \&format_address;
173 226
174=item inet_aton $name_or_address, $cb->(@addresses) 227=item inet_aton $name_or_address, $cb->(@addresses)
175 228
176Works similarly to its Socket counterpart, except that it uses a 229Works similarly to its Socket counterpart, except that it uses a
177callback. Also, if a host has only an IPv6 address, this might be passed 230callback. 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 231to the callback instead (use the length to detect this - 4 for IPv4, 16
179for IPv6). 232for IPv6).
180 233
181Unlike the L<Socket> function of the same name, you can get multiple IPv4 234Unlike the L<Socket> function of the same name, you can get multiple IPv4
182and IPv6 addresses as result. 235and IPv6 addresses as result (and maybe even other adrdess types).
183 236
184=cut 237=cut
185 238
186sub inet_aton { 239sub inet_aton {
187 my ($name, $cb) = @_; 240 my ($name, $cb) = @_;
… …
205 } 258 }
206 }); 259 });
207 } 260 }
208} 261}
209 262
263# check for broken platforms with extra field in sockaddr structure
264# kind of a rfc vs. bsd issue, as usual (ok, normally it's a
265# unix vs. bsd issue, a iso C vs. bsd issue or simply a
266# correctness vs. bsd issue.
267my $pack_family = 0x55 == Socket::sockaddr_family "\x55\x55"
268 ? "xC" : "S";
269
210=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host 270=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host
211 271
212Pack the given port/host combination into a binary sockaddr structure. Handles 272Pack the given port/host combination into a binary sockaddr
213both IPv4 and IPv6 host addresses. 273structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX
274domain sockets (C<$host> == C<unix/> and C<$service> == absolute
275pathname).
214 276
215=cut 277=cut
216 278
217sub pack_sockaddr($$) { 279sub pack_sockaddr($$) {
218 if (4 == length $_[1]) { 280 my $af = address_family $_[1];
281
282 if ($af == AF_INET) {
219 Socket::pack_sockaddr_in $_[0], $_[1] 283 Socket::pack_sockaddr_in $_[0], $_[1]
220 } elsif (16 == length $_[1]) { 284 } elsif ($af == AF_INET6) {
221 pack "SnL a16 L", 285 pack "$pack_family nL a16 L",
222 AF_INET6, 286 AF_INET6,
223 $_[0], # port 287 $_[0], # port
224 0, # flowinfo 288 0, # flowinfo
225 $_[1], # addr 289 $_[1], # addr
226 0 # scope id 290 0 # scope id
291 } elsif ($af == AF_UNIX) {
292 Socket::pack_sockaddr_un $_[0]
227 } else { 293 } else {
228 Carp::croak "pack_sockaddr: invalid host"; 294 Carp::croak "pack_sockaddr: invalid host";
229 } 295 }
230} 296}
231 297
232=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa 298=item ($service, $host) = AnyEvent::Socket::unpack_sockaddr $sa
233 299
234Unpack the given binary sockaddr structure (as used by bind, getpeername 300Unpack the given binary sockaddr structure (as used by bind, getpeername
235etc.) into a C<$port, $host> combination. 301etc.) into a C<$service, $host> combination.
236 302
237Handles both IPv4 and IPv6 sockaddr structures. 303For IPv4 and IPv6, C<$service> is the port number and C<$host> the host
304address in network format (binary).
305
306For UNIX domain sockets, C<$service> is the absolute pathname and C<$host>
307is a special token that is understood by the other functions in this
308module (C<format_address> converts it to C<unix/>).
238 309
239=cut 310=cut
240 311
241sub unpack_sockaddr($) { 312sub unpack_sockaddr($) {
242 my $af = unpack "S", $_[0]; 313 my $af = Socket::sockaddr_family $_[0];
243 314
244 if ($af == AF_INET) { 315 if ($af == AF_INET) {
245 Socket::unpack_sockaddr_in $_[0] 316 Socket::unpack_sockaddr_in $_[0]
246 } elsif ($af == AF_INET6) { 317 } elsif ($af == AF_INET6) {
247 unpack "x2 n x4 a16", $_[0] 318 unpack "x2 n x4 a16", $_[0]
319 } elsif ($af == AF_UNIX) {
320 ((Socket::unpack_sockaddr_un $_[0]), pack "S", AF_UNIX)
248 } else { 321 } else {
249 Carp::croak "unpack_sockaddr: unsupported protocol family $af"; 322 Carp::croak "unpack_sockaddr: unsupported protocol family $af";
250 } 323 }
251} 324}
252 325
253sub _tcp_port($) { 326=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
254 $_[0] =~ /^(\d*)$/ and return $1*1;
255 327
256 (getservbyname $_[0], "tcp")[2] 328Tries to resolve the given nodename and service name into protocol families
329and sockaddr structures usable to connect to this node and service in a
330protocol-independent way. It works remotely similar to the getaddrinfo
331posix function.
332
333For internet addresses, C<$node> is either an IPv4 or IPv6 address or an
334internet hostname, and C<$service> is either a service name (port name
335from F</etc/services>) or a numerical port number. If both C<$node> and
336C<$service> are names, then SRV records will be consulted to find the real
337service, otherwise they will be used as-is. If you know that the service
338name is not in your services database, then you can specify the service in
339the format C<name=port> (e.g. C<http=80>).
340
341For UNIX domain sockets, C<$node> must be the string C<unix/> and
342C<$service> must be the absolute pathname of the socket. In this case,
343C<$proto> will be ignored.
344
345C<$proto> must be a protocol name, currently C<tcp>, C<udp> or
346C<sctp>. The default is currently C<tcp>, but in the future, this function
347might try to use other protocols such as C<sctp>, depending on the socket
348type and any SRV records it might find.
349
350C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
351only IPv4) or C<6> (use only IPv6). This setting might be influenced by
352C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
353
354C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
355C<undef> in which case it gets automatically chosen).
356
357The callback will receive zero or more array references that contain
358C<$family, $type, $proto> for use in C<socket> and a binary
359C<$sockaddr> for use in C<connect> (or C<bind>).
360
361The application should try these in the order given.
362
363Example:
364
365 resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
366
367=cut
368
369sub resolve_sockaddr($$$$$$) {
370 my ($node, $service, $proto, $family, $type, $cb) = @_;
371
372 if ($node eq "unix/") {
373 return $cb->() if $family || !/^\//; # no can do
374
375 return $cb->([AF_UNIX, $type, 0, Socket::pack_sockaddr_un $service]);
376 }
377
378 unless (AF_INET6) {
379 $family != 6
380 or return $cb->();
381
382 $family = 4;
383 }
384
385 $cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4};
386 $cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6};
387
388 $family ||= 4 unless $AnyEvent::PROTOCOL{ipv6};
389 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4};
390
391 $proto ||= "tcp";
392 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
393
394 my $proton = (getprotobyname $proto)[2]
257 or Carp::croak "$_[0]: service unknown" 395 or Carp::croak "$proto: protocol unknown";
396
397 my $port;
398
399 if ($service =~ /^(\S+)=(\d+)$/) {
400 ($service, $port) = ($1, $2);
401 } elsif ($service =~ /^\d+$/) {
402 ($service, $port) = (undef, $service);
403 } else {
404 $port = (getservbyname $service, $proto)[2]
405 or Carp::croak "$service/$proto: service unknown";
406 }
407
408 my @target = [$node, $port];
409
410 # resolve a records / provide sockaddr structures
411 my $resolve = sub {
412 my @res;
413 my $cv = AnyEvent->condvar (cb => sub {
414 $cb->(
415 map $_->[2],
416 sort {
417 $AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}
418 or $a->[0] <=> $b->[0]
419 }
420 @res
421 )
422 });
423
424 $cv->begin;
425 for my $idx (0 .. $#target) {
426 my ($node, $port) = @{ $target[$idx] };
427
428 if (my $noden = parse_address $node) {
429 if (4 == length $noden && $family != 6) {
430 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
431 pack_sockaddr $port, $noden]]
432 }
433
434 if (16 == length $noden && $family != 4) {
435 push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
436 pack_sockaddr $port, $noden]]
437 }
438 } else {
439 # ipv4
440 if ($family != 6) {
441 $cv->begin;
442 a $node, sub {
443 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
444 pack_sockaddr $port, parse_ipv4 $_]]
445 for @_;
446 $cv->end;
447 };
448 }
449
450 # ipv6
451 if ($family != 4) {
452 $cv->begin;
453 aaaa $node, sub {
454 push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
455 pack_sockaddr $port, parse_ipv6 $_]]
456 for @_;
457 $cv->end;
458 };
459 }
460 }
461 }
462 $cv->end;
463 };
464
465 # try srv records, if applicable
466 if ($node eq "localhost") {
467 @target = (["127.0.0.1", $port], ["::1", $port]);
468 &$resolve;
469 } elsif (defined $service && !parse_address $node) {
470 srv $service, $proto, $node, sub {
471 my (@srv) = @_;
472
473 # no srv records, continue traditionally
474 @srv
475 or return &$resolve;
476
477 # only srv record has "." => abort
478 $srv[0][2] ne "." || $#srv
479 or return $cb->();
480
481 # use srv records then
482 @target = map ["$_->[3].", $_->[2]],
483 grep $_->[3] ne ".",
484 @srv;
485
486 &$resolve;
487 };
488 } else {
489 &$resolve;
490 }
258} 491}
259 492
260=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb] 493=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
261 494
262This is a convenience function that creates a TCP socket and makes a 100% 495This 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 496non-blocking connect to the given C<$host> (which can be a hostname or
497a 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 498and C<$service> (which can be a numeric port number or a service name,
265a service name, or a C<servicename=portnumber> string). 499or a C<servicename=portnumber> string, or the pathname to a UNIX domain
500socket).
266 501
267If both C<$host> and C<$port> are names, then this function will use SRV 502If both C<$host> and C<$port> are names, then this function will use SRV
268records to locate the real target(s). 503records to locate the real target(s).
269 504
270In either case, it will create a list of target hosts (e.g. for multihomed 505In either case, it will create a list of target hosts (e.g. for multihomed
… …
357 # could call $fh->bind etc. here 592 # could call $fh->bind etc. here
358 593
359 15 594 15
360 }; 595 };
361 596
597Example: connect to a UNIX domain socket.
598
599 tcp_connect "unix/", "/tmp/.X11-unix/X0", sub {
600 ...
601 }
602
362=cut 603=cut
363 604
364sub tcp_connect($$$;$) { 605sub tcp_connect($$$;$) {
365 my ($host, $port, $connect, $prepare) = @_; 606 my ($host, $port, $connect, $prepare) = @_;
366 607
367 # see http://cr.yp.to/docs/connect.html for some background 608 # see http://cr.yp.to/docs/connect.html for some background
609 # also http://advogato.org/article/672.html
368 610
369 my %state = ( fh => undef ); 611 my %state = ( fh => undef );
370 612
371 # name resolution 613 # name/service to type/sockaddr resolution
372 AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub { 614 resolve_sockaddr $host, $port, 0, 0, 0, sub {
373 my @target = @_; 615 my @target = @_;
374 616
375 $state{next} = sub { 617 $state{next} = sub {
376 return unless exists $state{fh}; 618 return unless exists $state{fh};
377 619
… …
410 652
411 my $guard = guard { 653 my $guard = guard {
412 %state = (); 654 %state = ();
413 }; 655 };
414 656
415 $connect->($state{fh}, format_ip $host, $port, sub { 657 $connect->($state{fh}, format_address $host, $port, sub {
416 $guard->cancel; 658 $guard->cancel;
417 $state{next}(); 659 $state{next}();
418 }); 660 });
419 } else { 661 } else {
420 # dummy read to fetch real error code 662 # dummy read to fetch real error code
… …
424 }; 666 };
425 667
426 # now connect 668 # now connect
427 if (connect $state{fh}, $sockaddr) { 669 if (connect $state{fh}, $sockaddr) {
428 $connected->(); 670 $connected->();
429 } elsif ($! == &Errno::EINPROGRESS || $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX 671 } elsif ($! == &Errno::EINPROGRESS # POSIX
672 || $! == &Errno::EWOULDBLOCK
673 # WSAEINPROGRESS intentionally not checked - it means something else entirely
674 || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
675 || $! == AnyEvent::Util::WSAEWOULDBLOCK) {
430 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected); 676 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
431 } else { 677 } else {
432 $state{next}(); 678 $state{next}();
433 } 679 }
434 }; 680 };
… …
438 }; 684 };
439 685
440 defined wantarray && guard { %state = () } 686 defined wantarray && guard { %state = () }
441} 687}
442 688
443=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb] 689=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]
444 690
445Create and bind a TCP socket to the given host, and port, set the 691Create and bind a stream socket to the given host, and port, set the
446SO_REUSEADDR flag and call C<listen>. 692SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name
693implies, this function can also bind on UNIX domain sockets.
447 694
448C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it 695For internet sockets, C<$host> must be an IPv4 or IPv6 address (or
449binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the 696C<undef>, in which case it binds either to C<0> or to C<::>, depending on
450preferred protocol). 697whether IPv4 or IPv6 is the preferred protocol).
451 698
452To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6 699To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
453wildcard address, use C<::>. 700wildcard address, use C<::>.
454 701
455The port is specified by C<$port>, which must be either a service name or 702The port is specified by C<$service>, which must be either a service name or
456a numeric port number (or C<0> or C<undef>, in which case an ephemeral 703a numeric port number (or C<0> or C<undef>, in which case an ephemeral
457port will be used). 704port will be used).
705
706For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be
707the absolute pathname of the socket. This function will try to C<unlink>
708the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,
709below.
458 710
459For each new connection that could be C<accept>ed, call the C<< 711For each new connection that could be C<accept>ed, call the C<<
460$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking 712$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
461mode) as first and the peer host and port as second and third arguments 713mode) as first and the peer host and port as second and third arguments
462(see C<tcp_connect> for details). 714(see C<tcp_connect> for details).
… …
489 }; 741 };
490 742
491=cut 743=cut
492 744
493sub tcp_server($$$;$) { 745sub tcp_server($$$;$) {
494 my ($host, $port, $accept, $prepare) = @_; 746 my ($host, $service, $accept, $prepare) = @_;
495 747
496 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6 748 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
497 ? "::" : "0" 749 ? "::" : "0"
498 unless defined $host; 750 unless defined $host;
499 751
500 my $ipn = parse_ip $host 752 my $ipn = parse_address $host
501 or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address"; 753 or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address";
502 754
503 my $domain = 4 == length $ipn ? AF_INET : AF_INET6; 755 my $af = address_family $ipn;
504 756
505 my %state; 757 my %state;
506 758
759 # win32 perl is too stupid to get this right :/
760 Carp::croak "tcp_server/socket: address family not supported"
761 if AnyEvent::WIN32 && $af == AF_UNIX;
762
507 socket $state{fh}, $domain, SOCK_STREAM, 0 763 socket $state{fh}, $af, SOCK_STREAM, 0
508 or Carp::croak "socket: $!"; 764 or Carp::croak "tcp_server/socket: $!";
509 765
766 if ($af == AF_INET || $af == AF_INET6) {
510 setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1 767 setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
511 or Carp::croak "so_reuseaddr: $!"; 768 or Carp::croak "tcp_server/so_reuseaddr: $!"
769 unless !AnyEvent::WIN32; # work around windows bug
512 770
771 unless ($service =~ /^\d*$/) {
772 $service = (getservbyname $service, "tcp")[2]
773 or Carp::croak "$service: service unknown"
774 }
775 } elsif ($af == AF_UNIX) {
776 unlink $service;
777 }
778
513 bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn 779 bind $state{fh}, pack_sockaddr $service, $ipn
514 or Carp::croak "bind: $!"; 780 or Carp::croak "bind: $!";
515 781
516 fh_nonblocking $state{fh}, 1; 782 fh_nonblocking $state{fh}, 1;
517 783
518 my $len; 784 my $len;
519 785
520 if ($prepare) { 786 if ($prepare) {
521 my ($port, $host) = unpack_sockaddr getsockname $state{fh}; 787 my ($service, $host) = unpack_sockaddr getsockname $state{fh};
522 $len = $prepare && $prepare->($state{fh}, format_ip $host, $port); 788 $len = $prepare && $prepare->($state{fh}, format_address $host, $service);
523 } 789 }
524 790
525 $len ||= 128; 791 $len ||= 128;
526 792
527 listen $state{fh}, $len 793 listen $state{fh}, $len
… …
529 795
530 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub { 796 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
531 # this closure keeps $state alive 797 # this closure keeps $state alive
532 while (my $peer = accept my $fh, $state{fh}) { 798 while (my $peer = accept my $fh, $state{fh}) {
533 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not 799 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
534 my ($port, $host) = unpack_sockaddr $peer; 800 my ($service, $host) = unpack_sockaddr $peer;
535 $accept->($fh, format_ip $host, $port); 801 $accept->($fh, format_address $host, $service);
536 } 802 }
537 }); 803 });
538 804
539 defined wantarray 805 defined wantarray
540 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency 806 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency

Diff Legend

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