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.33 by root, Tue May 27 06:23:15 2008 UTC vs.
Revision 1.40 by root, Thu May 29 00:30:15 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) = @_;
… …
209 262
210# check for broken platforms with extra field in sockaddr structure 263# check for broken platforms with extra field in sockaddr structure
211# kind of a rfc vs. bsd issue, as usual (ok, normally it's a 264# kind of a rfc vs. bsd issue, as usual (ok, normally it's a
212# unix vs. bsd issue, a iso C vs. bsd issue or simply a 265# unix vs. bsd issue, a iso C vs. bsd issue or simply a
213# correctness vs. bsd issue. 266# correctness vs. bsd issue.
214my $pack_family = 0x55 == Socket::sockaddr_family "\x55\x55" 267my $pack_family = (0x55 == Socket::sockaddr_family "\x55\x55")
215 ? "xC" : "S"; 268 ? "xC" : "S";
216 269
217=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host 270=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host
218 271
219Pack the given port/host combination into a binary sockaddr structure. Handles 272Pack the given port/host combination into a binary sockaddr
220both 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).
221 276
222=cut 277=cut
223 278
224sub pack_sockaddr($$) { 279sub pack_sockaddr($$) {
225 if (4 == length $_[1]) { 280 my $af = address_family $_[1];
281
282 if ($af == AF_INET) {
226 Socket::pack_sockaddr_in $_[0], $_[1] 283 Socket::pack_sockaddr_in $_[0], $_[1]
227 } elsif (16 == length $_[1]) { 284 } elsif ($af == AF_INET6) {
228 pack "$pack_family nL a16 L", 285 pack "$pack_family nL a16 L",
229 AF_INET6, 286 AF_INET6,
230 $_[0], # port 287 $_[0], # port
231 0, # flowinfo 288 0, # flowinfo
232 $_[1], # addr 289 $_[1], # addr
233 0 # scope id 290 0 # scope id
291 } elsif ($af == AF_UNIX) {
292 Socket::pack_sockaddr_un $_[0]
234 } else { 293 } else {
235 Carp::croak "pack_sockaddr: invalid host"; 294 Carp::croak "pack_sockaddr: invalid host";
236 } 295 }
237} 296}
238 297
239=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa 298=item ($service, $host) = AnyEvent::Socket::unpack_sockaddr $sa
240 299
241Unpack the given binary sockaddr structure (as used by bind, getpeername 300Unpack the given binary sockaddr structure (as used by bind, getpeername
242etc.) into a C<$port, $host> combination. 301etc.) into a C<$service, $host> combination.
243 302
244Handles 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/>).
245 309
246=cut 310=cut
247 311
248sub unpack_sockaddr($) { 312sub unpack_sockaddr($) {
249 my $af = Socket::sockaddr_family $_[0]; 313 my $af = Socket::sockaddr_family $_[0];
250 314
251 if ($af == AF_INET) { 315 if ($af == AF_INET) {
252 Socket::unpack_sockaddr_in $_[0] 316 Socket::unpack_sockaddr_in $_[0]
253 } elsif ($af == AF_INET6) { 317 } elsif ($af == AF_INET6) {
254 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)
255 } else { 321 } else {
256 Carp::croak "unpack_sockaddr: unsupported protocol family $af"; 322 Carp::croak "unpack_sockaddr: unsupported protocol family $af";
257 } 323 }
258} 324}
259 325
260sub _tcp_port($) { 326=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
261 $_[0] =~ /^(\d*)$/ and return $1*1;
262 327
263 (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]
264 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 my $af = address_family $noden;
430
431 if ($af == AF_INET && $family != 6) {
432 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
433 pack_sockaddr $port, $noden]]
434 }
435
436 if ($af == AF_INET6 && $family != 4) {
437 push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
438 pack_sockaddr $port, $noden]]
439 }
440 } else {
441 # ipv4
442 if ($family != 6) {
443 $cv->begin;
444 AnyEvent::DNS::a $node, sub {
445 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
446 pack_sockaddr $port, parse_ipv4 $_]]
447 for @_;
448 $cv->end;
449 };
450 }
451
452 # ipv6
453 if ($family != 4) {
454 $cv->begin;
455 AnyEvent::DNS::aaaa $node, sub {
456 push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
457 pack_sockaddr $port, parse_ipv6 $_]]
458 for @_;
459 $cv->end;
460 };
461 }
462 }
463 }
464 $cv->end;
465 };
466
467 # try srv records, if applicable
468 if ($node eq "localhost") {
469 @target = (["127.0.0.1", $port], ["::1", $port]);
470 &$resolve;
471 } elsif (defined $service && !parse_address $node) {
472 AnyEvent::DNS::srv $service, $proto, $node, sub {
473 my (@srv) = @_;
474
475 # no srv records, continue traditionally
476 @srv
477 or return &$resolve;
478
479 # only srv record has "." => abort
480 $srv[0][2] ne "." || $#srv
481 or return $cb->();
482
483 # use srv records then
484 @target = map ["$_->[3].", $_->[2]],
485 grep $_->[3] ne ".",
486 @srv;
487
488 &$resolve;
489 };
490 } else {
491 &$resolve;
492 }
265} 493}
266 494
267=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb] 495=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
268 496
269This is a convenience function that creates a TCP socket and makes a 100% 497This is a convenience function that creates a TCP socket and makes a 100%
270non-blocking connect to the given C<$host> (which can be a hostname or a 498non-blocking connect to the given C<$host> (which can be a hostname or
499a textual IP address, or the string C<unix/> for UNIX domain sockets)
271textual IP address) and C<$service> (which can be a numeric port number or 500and C<$service> (which can be a numeric port number or a service name,
272a service name, or a C<servicename=portnumber> string). 501or a C<servicename=portnumber> string, or the pathname to a UNIX domain
502socket).
273 503
274If both C<$host> and C<$port> are names, then this function will use SRV 504If both C<$host> and C<$port> are names, then this function will use SRV
275records to locate the real target(s). 505records to locate the real target(s).
276 506
277In either case, it will create a list of target hosts (e.g. for multihomed 507In either case, it will create a list of target hosts (e.g. for multihomed
… …
364 # could call $fh->bind etc. here 594 # could call $fh->bind etc. here
365 595
366 15 596 15
367 }; 597 };
368 598
599Example: connect to a UNIX domain socket.
600
601 tcp_connect "unix/", "/tmp/.X11-unix/X0", sub {
602 ...
603 }
604
369=cut 605=cut
370 606
371sub tcp_connect($$$;$) { 607sub tcp_connect($$$;$) {
372 my ($host, $port, $connect, $prepare) = @_; 608 my ($host, $port, $connect, $prepare) = @_;
373 609
… …
375 # also http://advogato.org/article/672.html 611 # also http://advogato.org/article/672.html
376 612
377 my %state = ( fh => undef ); 613 my %state = ( fh => undef );
378 614
379 # name/service to type/sockaddr resolution 615 # name/service to type/sockaddr resolution
380 AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub { 616 resolve_sockaddr $host, $port, 0, 0, 0, sub {
381 my @target = @_; 617 my @target = @_;
382 618
383 $state{next} = sub { 619 $state{next} = sub {
384 return unless exists $state{fh}; 620 return unless exists $state{fh};
385 621
… …
418 654
419 my $guard = guard { 655 my $guard = guard {
420 %state = (); 656 %state = ();
421 }; 657 };
422 658
423 $connect->($state{fh}, format_ip $host, $port, sub { 659 $connect->($state{fh}, format_address $host, $port, sub {
424 $guard->cancel; 660 $guard->cancel;
425 $state{next}(); 661 $state{next}();
426 }); 662 });
427 } else { 663 } else {
428 # dummy read to fetch real error code 664 # dummy read to fetch real error code
… …
450 }; 686 };
451 687
452 defined wantarray && guard { %state = () } 688 defined wantarray && guard { %state = () }
453} 689}
454 690
455=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb] 691=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]
456 692
457Create and bind a TCP socket to the given host, and port, set the 693Create and bind a stream socket to the given host, and port, set the
458SO_REUSEADDR flag and call C<listen>. 694SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name
695implies, this function can also bind on UNIX domain sockets.
459 696
460C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it 697For internet sockets, C<$host> must be an IPv4 or IPv6 address (or
461binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the 698C<undef>, in which case it binds either to C<0> or to C<::>, depending
462preferred protocol). 699on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in
700future versions, as applicable).
463 701
464To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6 702To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
465wildcard address, use C<::>. 703wildcard address, use C<::>.
466 704
467The port is specified by C<$port>, which must be either a service name or 705The port is specified by C<$service>, which must be either a service name or
468a numeric port number (or C<0> or C<undef>, in which case an ephemeral 706a numeric port number (or C<0> or C<undef>, in which case an ephemeral
469port will be used). 707port will be used).
708
709For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be
710the absolute pathname of the socket. This function will try to C<unlink>
711the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,
712below.
470 713
471For each new connection that could be C<accept>ed, call the C<< 714For each new connection that could be C<accept>ed, call the C<<
472$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking 715$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
473mode) as first and the peer host and port as second and third arguments 716mode) as first and the peer host and port as second and third arguments
474(see C<tcp_connect> for details). 717(see C<tcp_connect> for details).
… …
486address and port number of the local socket endpoint as second and third 729address and port number of the local socket endpoint as second and third
487arguments. 730arguments.
488 731
489It should return the length of the listen queue (or C<0> for the default). 732It should return the length of the listen queue (or C<0> for the default).
490 733
734Note to IPv6 users: RFC-compliant behaviour for IPv6 sockets listening on
735C<::> is to bind to both IPv6 and IPv4 addresses by default on dual-stack
736hosts. Unfortunately, only GNU/Linux seems to implement this properly, so
737if you want both IPv4 and IPv6 listening sockets you should create the
738IPv6 socket first and then attempt to bind on the IPv4 socket, but ignore
739any C<EADDRINUSE> errors.
740
491Example: bind on some TCP port on the local machine and tell each client 741Example: bind on some TCP port on the local machine and tell each client
492to go away. 742to go away.
493 743
494 tcp_server undef, undef, sub { 744 tcp_server undef, undef, sub {
495 my ($fh, $host, $port) = @_; 745 my ($fh, $host, $port) = @_;
… …
501 }; 751 };
502 752
503=cut 753=cut
504 754
505sub tcp_server($$$;$) { 755sub tcp_server($$$;$) {
506 my ($host, $port, $accept, $prepare) = @_; 756 my ($host, $service, $accept, $prepare) = @_;
507 757
508 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6 758 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
509 ? "::" : "0" 759 ? "::" : "0"
510 unless defined $host; 760 unless defined $host;
511 761
512 my $ipn = parse_ip $host 762 my $ipn = parse_address $host
513 or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address"; 763 or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address";
514 764
515 my $domain = 4 == length $ipn ? AF_INET : AF_INET6; 765 my $af = address_family $ipn;
516 766
517 my %state; 767 my %state;
518 768
769 # win32 perl is too stupid to get this right :/
770 Carp::croak "tcp_server/socket: address family not supported"
771 if AnyEvent::WIN32 && $af == AF_UNIX;
772
519 socket $state{fh}, $domain, SOCK_STREAM, 0 773 socket $state{fh}, $af, SOCK_STREAM, 0
520 or Carp::croak "socket: $!"; 774 or Carp::croak "tcp_server/socket: $!";
521 775
776 if ($af == AF_INET || $af == AF_INET6) {
522 setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1 777 setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
523 or Carp::croak "so_reuseaddr: $!"; 778 or Carp::croak "tcp_server/so_reuseaddr: $!"
779 unless AnyEvent::WIN32; # work around windows bug
524 780
781 unless ($service =~ /^\d*$/) {
782 $service = (getservbyname $service, "tcp")[2]
783 or Carp::croak "$service: service unknown"
784 }
785 } elsif ($af == AF_UNIX) {
786 unlink $service;
787 }
788
525 bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn 789 bind $state{fh}, pack_sockaddr $service, $ipn
526 or Carp::croak "bind: $!"; 790 or Carp::croak "bind: $!";
527 791
528 fh_nonblocking $state{fh}, 1; 792 fh_nonblocking $state{fh}, 1;
529 793
530 my $len; 794 my $len;
531 795
532 if ($prepare) { 796 if ($prepare) {
533 my ($port, $host) = unpack_sockaddr getsockname $state{fh}; 797 my ($service, $host) = unpack_sockaddr getsockname $state{fh};
534 $len = $prepare && $prepare->($state{fh}, format_ip $host, $port); 798 $len = $prepare && $prepare->($state{fh}, format_address $host, $service);
535 } 799 }
536 800
537 $len ||= 128; 801 $len ||= 128;
538 802
539 listen $state{fh}, $len 803 listen $state{fh}, $len
… …
541 805
542 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub { 806 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
543 # this closure keeps $state alive 807 # this closure keeps $state alive
544 while (my $peer = accept my $fh, $state{fh}) { 808 while (my $peer = accept my $fh, $state{fh}) {
545 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not 809 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
810
546 my ($port, $host) = unpack_sockaddr $peer; 811 my ($service, $host) = unpack_sockaddr $peer;
547 $accept->($fh, format_ip $host, $port); 812 $accept->($fh, format_address $host, $service);
548 } 813 }
549 }); 814 });
550 815
551 defined wantarray 816 defined wantarray
552 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency 817 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
… …
555 820
5561; 8211;
557 822
558=back 823=back
559 824
825=head1 SECURITY CONSIDERATIONS
826
827This module is quite powerful, with with power comes the ability to abuse
828as well: If you accept "hostnames" and ports from untrusted sources,
829then note that this can be abused to delete files (host=C<unix/>). This
830is not really a problem with this module, however, as blindly accepting
831any address and protocol and trying to bind a server or connect to it is
832harmful in general.
833
560=head1 AUTHOR 834=head1 AUTHOR
561 835
562 Marc Lehmann <schmorp@schmorp.de> 836 Marc Lehmann <schmorp@schmorp.de>
563 http://home.schmorp.de/ 837 http://home.schmorp.de/
564 838

Diff Legend

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