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.37 by root, Wed May 28 21:52:20 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
… …
302timeout is to be used). 537timeout is to be used).
303 538
304Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP 539Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP
305socket (although only IPv4 is currently supported by this module). 540socket (although only IPv4 is currently supported by this module).
306 541
307Note to Microsoft Windows users: Windows (of course) doesn't correctly 542Note to the poor Microsoft Windows users: Windows (of course) doesn't
308signal connection errors at all, so unless your event library works around 543correctly signal connection errors, so unless your event library works
309this failed connections will simply hang and time-out. The only event 544around this, failed connections will simply hang. The only event libraries
310library that handles this condition correctly is L<EV>, so this is highly 545that handle this condition correctly are L<EV> and L<Glib>. Additionally,
546AnyEvent works around this bug with L<Event> and in its pure-perl
547backend. All other libraries cannot correctly handle this condition. To
311recommended. To lessen the impact of this windows bug, a default timeout 548lessen the impact of this windows bug, a default timeout of 30 seconds
312of 30 seconds will be imposed on windows. Cygwin is not affected. 549will be imposed on windows. Cygwin is not affected.
313 550
314Simple Example: connect to localhost on port 22. 551Simple Example: connect to localhost on port 22.
315 552
316 tcp_connect localhost => 22, sub { 553 tcp_connect localhost => 22, sub {
317 my $fh = shift 554 my $fh = shift
… …
355 # could call $fh->bind etc. here 592 # could call $fh->bind etc. here
356 593
357 15 594 15
358 }; 595 };
359 596
597Example: connect to a UNIX domain socket.
598
599 tcp_connect "unix/", "/tmp/.X11-unix/X0", sub {
600 ...
601 }
602
360=cut 603=cut
361 604
362sub tcp_connect($$$;$) { 605sub tcp_connect($$$;$) {
363 my ($host, $port, $connect, $prepare) = @_; 606 my ($host, $port, $connect, $prepare) = @_;
364 607
365 # 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
366 610
367 my %state = ( fh => undef ); 611 my %state = ( fh => undef );
368 612
369 # name resolution 613 # name/service to type/sockaddr resolution
370 AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub { 614 resolve_sockaddr $host, $port, 0, 0, 0, sub {
371 my @target = @_; 615 my @target = @_;
372 616
373 $state{next} = sub { 617 $state{next} = sub {
374 return unless exists $state{fh}; 618 return unless exists $state{fh};
375 619
… …
387 631
388 fh_nonblocking $state{fh}, 1; 632 fh_nonblocking $state{fh}, 1;
389 633
390 my $timeout = $prepare && $prepare->($state{fh}); 634 my $timeout = $prepare && $prepare->($state{fh});
391 635
392 $timeout ||= 30 if $^O =~ /mswin32/i; 636 $timeout ||= 30 if AnyEvent::WIN32;
393 637
394 $state{to} = AnyEvent->timer (after => $timeout, cb => sub { 638 $state{to} = AnyEvent->timer (after => $timeout, cb => sub {
395 $! = &Errno::ETIMEDOUT; 639 $! = &Errno::ETIMEDOUT;
396 $state{next}(); 640 $state{next}();
397 }) if $timeout; 641 }) if $timeout;
… …
408 652
409 my $guard = guard { 653 my $guard = guard {
410 %state = (); 654 %state = ();
411 }; 655 };
412 656
413 $connect->($state{fh}, format_ip $host, $port, sub { 657 $connect->($state{fh}, format_address $host, $port, sub {
414 $guard->cancel; 658 $guard->cancel;
415 $state{next}(); 659 $state{next}();
416 }); 660 });
417 } else { 661 } else {
418 # dummy read to fetch real error code 662 # dummy read to fetch real error code
… …
422 }; 666 };
423 667
424 # now connect 668 # now connect
425 if (connect $state{fh}, $sockaddr) { 669 if (connect $state{fh}, $sockaddr) {
426 $connected->(); 670 $connected->();
427 } 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) {
428 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected); 676 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
429 } else { 677 } else {
430 %state = (); 678 $state{next}();
431 $connect->();
432 } 679 }
433 }; 680 };
434 681
435 $! = &Errno::ENXIO; 682 $! = &Errno::ENXIO;
436 $state{next}(); 683 $state{next}();
437 }; 684 };
438 685
439 defined wantarray && guard { %state = () } 686 defined wantarray && guard { %state = () }
440} 687}
441 688
442=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb] 689=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]
443 690
444Create 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
445SO_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.
446 694
447C<$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
448binds 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
449preferred protocol). 697whether IPv4 or IPv6 is the preferred protocol).
450 698
451To 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
452wildcard address, use C<::>. 700wildcard address, use C<::>.
453 701
454The 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
455a 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
456port 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.
457 710
458For 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<<
459$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
460mode) 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
461(see C<tcp_connect> for details). 714(see C<tcp_connect> for details).
… …
488 }; 741 };
489 742
490=cut 743=cut
491 744
492sub tcp_server($$$;$) { 745sub tcp_server($$$;$) {
493 my ($host, $port, $accept, $prepare) = @_; 746 my ($host, $service, $accept, $prepare) = @_;
494 747
495 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6 748 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
496 ? "::" : "0" 749 ? "::" : "0"
497 unless defined $host; 750 unless defined $host;
498 751
499 my $ipn = parse_ip $host 752 my $ipn = parse_address $host
500 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";
501 754
502 my $domain = 4 == length $ipn ? AF_INET : AF_INET6; 755 my $af = address_family $ipn;
503 756
504 my %state; 757 my %state;
505 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
506 socket $state{fh}, $domain, SOCK_STREAM, 0 763 socket $state{fh}, $af, SOCK_STREAM, 0
507 or Carp::croak "socket: $!"; 764 or Carp::croak "tcp_server/socket: $!";
508 765
766 if ($af == AF_INET || $af == AF_INET6) {
509 setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1 767 setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
510 or Carp::croak "so_reuseaddr: $!"; 768 or Carp::croak "tcp_server/so_reuseaddr: $!"
769 unless AnyEvent::WIN32; # work around windows bug
511 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
512 bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn 779 bind $state{fh}, pack_sockaddr $service, $ipn
513 or Carp::croak "bind: $!"; 780 or Carp::croak "bind: $!";
514 781
515 fh_nonblocking $state{fh}, 1; 782 fh_nonblocking $state{fh}, 1;
516 783
517 my $len; 784 my $len;
518 785
519 if ($prepare) { 786 if ($prepare) {
520 my ($port, $host) = unpack_sockaddr getsockname $state{fh}; 787 my ($service, $host) = unpack_sockaddr getsockname $state{fh};
521 $len = $prepare && $prepare->($state{fh}, format_ip $host, $port); 788 $len = $prepare && $prepare->($state{fh}, format_address $host, $service);
522 } 789 }
523 790
524 $len ||= 128; 791 $len ||= 128;
525 792
526 listen $state{fh}, $len 793 listen $state{fh}, $len
… …
528 795
529 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub { 796 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
530 # this closure keeps $state alive 797 # this closure keeps $state alive
531 while (my $peer = accept my $fh, $state{fh}) { 798 while (my $peer = accept my $fh, $state{fh}) {
532 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
800
533 my ($port, $host) = unpack_sockaddr $peer; 801 my ($service, $host) = unpack_sockaddr $peer;
534 $accept->($fh, format_ip $host, $port); 802 $accept->($fh, format_address $host, $service);
535 } 803 }
536 }); 804 });
537 805
538 defined wantarray 806 defined wantarray
539 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency 807 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency

Diff Legend

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