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.34 by root, Wed May 28 21:07:07 2008 UTC vs.
Revision 1.35 by root, Wed May 28 21:23:41 2008 UTC

… …
315 if ($af == AF_INET) { 315 if ($af == AF_INET) {
316 Socket::unpack_sockaddr_in $_[0] 316 Socket::unpack_sockaddr_in $_[0]
317 } elsif ($af == AF_INET6) { 317 } elsif ($af == AF_INET6) {
318 unpack "x2 n x4 a16", $_[0] 318 unpack "x2 n x4 a16", $_[0]
319 } elsif ($af == AF_UNIX) { 319 } elsif ($af == AF_UNIX) {
320 ((Socket::unpack_sockaddr_un $_[0]), "unix/") 320 ((Socket::unpack_sockaddr_un $_[0]), pack "S", AF_UNIX)
321 } else { 321 } else {
322 Carp::croak "unpack_sockaddr: unsupported protocol family $af"; 322 Carp::croak "unpack_sockaddr: unsupported protocol family $af";
323 } 323 }
324}
325
326sub _tcp_port($) {
327 $_[0] =~ /^(\d*)$/ and return $1*1;
328
329 (getservbyname $_[0], "tcp")[2]
330 or Carp::croak "$_[0]: service unknown"
331} 324}
332 325
333=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...) 326=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
334 327
335Tries to resolve the given nodename and service name into protocol families 328Tries to resolve the given nodename and service name into protocol families
… …
407 ($service, $port) = ($1, $2); 400 ($service, $port) = ($1, $2);
408 } elsif ($service =~ /^\d+$/) { 401 } elsif ($service =~ /^\d+$/) {
409 ($service, $port) = (undef, $service); 402 ($service, $port) = (undef, $service);
410 } else { 403 } else {
411 $port = (getservbyname $service, $proto)[2] 404 $port = (getservbyname $service, $proto)[2]
412 or Carp::croak "$service/$proto: service unknown"; 405 or Carp::croak "$service/$proto: service unknown";
413 } 406 }
414 407
415 my @target = [$node, $port]; 408 my @target = [$node, $port];
416 409
417 # resolve a records / provide sockaddr structures 410 # resolve a records / provide sockaddr structures
… …
691 }; 684 };
692 685
693 defined wantarray && guard { %state = () } 686 defined wantarray && guard { %state = () }
694} 687}
695 688
696=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb] 689=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]
697 690
698Create 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
699SO_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.
700 694
701C<$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
702binds 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
703preferred protocol). 697whether IPv4 or IPv6 is the preferred protocol).
704 698
705To 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
706wildcard address, use C<::>. 700wildcard address, use C<::>.
707 701
708The 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
709a 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
710port 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.
711 710
712For 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<<
713$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
714mode) 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
715(see C<tcp_connect> for details). 714(see C<tcp_connect> for details).
… …
742 }; 741 };
743 742
744=cut 743=cut
745 744
746sub tcp_server($$$;$) { 745sub tcp_server($$$;$) {
747 my ($host, $port, $accept, $prepare) = @_; 746 my ($host, $service, $accept, $prepare) = @_;
748 747
749 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6 748 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
750 ? "::" : "0" 749 ? "::" : "0"
751 unless defined $host; 750 unless defined $host;
752 751
753 my $ipn = parse_address $host 752 my $ipn = parse_address $host
754 or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address"; 753 or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address";
755 754
756 my $domain = 4 == length $ipn ? AF_INET : AF_INET6; 755 my $af = address_family $ipn;
757 756
758 my %state; 757 my %state;
759 758
760 socket $state{fh}, $domain, SOCK_STREAM, 0 759 socket $state{fh}, $af, SOCK_STREAM, 0
761 or Carp::croak "socket: $!"; 760 or Carp::croak "socket: $!";
762 761
762 if ($af == AF_INET || $af == AF_INET6) {
763 setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1 763 setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
764 or Carp::croak "so_reuseaddr: $!"; 764 or Carp::croak "so_reuseaddr: $!"
765 unless !AnyEvent::WIN32; # work around windows bug
765 766
767 unless ($service =~ /^\d*$/) {
768 $service = (getservbyname $service, "tcp")[2]
769 or Carp::croak "$service: service unknown"
770 }
771 } elsif ($af == AF_UNIX) {
772 unlink $service;
773 }
774
766 bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn 775 bind $state{fh}, pack_sockaddr $service, $ipn
767 or Carp::croak "bind: $!"; 776 or Carp::croak "bind: $!";
768 777
769 fh_nonblocking $state{fh}, 1; 778 fh_nonblocking $state{fh}, 1;
770 779
771 my $len; 780 my $len;
772 781
773 if ($prepare) { 782 if ($prepare) {
774 my ($port, $host) = unpack_sockaddr getsockname $state{fh}; 783 my ($service, $host) = unpack_sockaddr getsockname $state{fh};
775 $len = $prepare && $prepare->($state{fh}, format_address $host, $port); 784 $len = $prepare && $prepare->($state{fh}, format_address $host, $service);
776 } 785 }
777 786
778 $len ||= 128; 787 $len ||= 128;
779 788
780 listen $state{fh}, $len 789 listen $state{fh}, $len
… …
782 791
783 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub { 792 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
784 # this closure keeps $state alive 793 # this closure keeps $state alive
785 while (my $peer = accept my $fh, $state{fh}) { 794 while (my $peer = accept my $fh, $state{fh}) {
786 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not 795 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
787 my ($port, $host) = unpack_sockaddr $peer; 796 my ($service, $host) = unpack_sockaddr $peer;
788 $accept->($fh, format_address $host, $port); 797 $accept->($fh, format_address $host, $service);
789 } 798 }
790 }); 799 });
791 800
792 defined wantarray 801 defined wantarray
793 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency 802 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency

Diff Legend

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