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.118 by root, Wed Dec 16 01:22:35 2009 UTC vs.
Revision 1.130 by root, Fri Jan 14 17:43:11 2011 UTC

… …
381sub format_ipv4($) { 381sub format_ipv4($) {
382 join ".", unpack "C4", $_[0] 382 join ".", unpack "C4", $_[0]
383} 383}
384 384
385sub format_ipv6($) { 385sub format_ipv6($) {
386 if ($_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00/) {
386 if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) { 387 if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {
387 return "::"; 388 return "::";
388 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) { 389 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {
389 return "::1"; 390 return "::1";
390 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) { 391 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
391 # v4compatible 392 # v4compatible
392 return "::" . format_ipv4 substr $_[0], 12; 393 return "::" . format_ipv4 substr $_[0], 12;
393 } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { 394 } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
394 # v4mapped 395 # v4mapped
395 return "::ffff:" . format_ipv4 substr $_[0], 12; 396 return "::ffff:" . format_ipv4 substr $_[0], 12;
396 } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) { 397 } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
397 # v4translated 398 # v4translated
398 return "::ffff:0:" . format_ipv4 substr $_[0], 12; 399 return "::ffff:0:" . format_ipv4 substr $_[0], 12;
399 } else { 400 }
401 }
402
400 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; 403 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
401 404
402 # this is rather sucky, I admit 405 # this is admittedly rather sucky
403 $ip =~ s/^0:(?:0:)*(0$)?/::/ 406 $ip =~ s/(?:^|:) 0:0:0:0:0:0:0 (?:$|:)/::/x
404 or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/ 407 or $ip =~ s/(?:^|:) 0:0:0:0:0:0 (?:$|:)/::/x
405 or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/ 408 or $ip =~ s/(?:^|:) 0:0:0:0:0 (?:$|:)/::/x
406 or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/ 409 or $ip =~ s/(?:^|:) 0:0:0:0 (?:$|:)/::/x
407 or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/ 410 or $ip =~ s/(?:^|:) 0:0:0 (?:$|:)/::/x
408 or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/ 411 or $ip =~ s/(?:^|:) 0:0 (?:$|:)/::/x
409 or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/ 412 or $ip =~ s/(?:^|:) 0 (?:$|:)/::/x;
410 or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/; 413
411 return $ip 414 $ip
412 }
413} 415}
414 416
415sub format_address($) { 417sub format_address($) {
416 my $af = address_family $_[0]; 418 if (4 == length $_[0]) {
417 if ($af == AF_INET) {
418 return &format_ipv4; 419 return &format_ipv4;
419 } elsif ($af == AF_INET6) { 420 } elsif (16 == length $_[0]) {
420 return (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) 421 return $_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff(....)$/s
421 ? format_ipv4 substr $_[0], 12 422 ? format_ipv4 $1
422 : &format_ipv6; 423 : &format_ipv6;
423 } elsif ($af == AF_UNIX) { 424 } elsif (AF_UNIX == address_family $_[0]) {
424 return "unix/" 425 return "unix/"
425 } else { 426 } else {
426 return undef 427 return undef
427 } 428 }
428} 429}
… …
652 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4}; 653 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4};
653 654
654 $proto ||= "tcp"; 655 $proto ||= "tcp";
655 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM; 656 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
656 657
657 my $proton = getprotobyname $proto 658 my $proton = AnyEvent::Socket::getprotobyname $proto
658 or Carp::croak "$proto: protocol unknown"; 659 or Carp::croak "$proto: protocol unknown";
659 660
660 my $port; 661 my $port;
661 662
662 if ($service =~ /^(\S+)=(\d+)$/) { 663 if ($service =~ /^(\S+)=(\d+)$/) {
… …
774In either case, it will create a list of target hosts (e.g. for multihomed 775In either case, it will create a list of target hosts (e.g. for multihomed
775hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to 776hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
776each in turn. 777each in turn.
777 778
778After the connection is established, then the C<$connect_cb> will be 779After the connection is established, then the C<$connect_cb> will be
779invoked with the socket file handle (in non-blocking mode) as first and 780invoked with the socket file handle (in non-blocking mode) as first, and
780the peer host (as a textual IP address) and peer port as second and third 781the peer host (as a textual IP address) and peer port as second and third
781arguments, respectively. The fourth argument is a code reference that you 782arguments, respectively. The fourth argument is a code reference that you
782can call if, for some reason, you don't like this connection, which will 783can call if, for some reason, you don't like this connection, which will
783cause C<tcp_connect> to try the next one (or call your callback without 784cause C<tcp_connect> to try the next one (or call your callback without
784any arguments if there are no more connections). In most cases, you can 785any arguments if there are no more connections). In most cases, you can
… …
796 797
797The file handle is perfect for being plugged into L<AnyEvent::Handle>, but 798The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
798can be used as a normal perl file handle as well. 799can be used as a normal perl file handle as well.
799 800
800Unless called in void context, C<tcp_connect> returns a guard object that 801Unless called in void context, C<tcp_connect> returns a guard object that
801will automatically abort connecting when it gets destroyed (it does not do 802will automatically cancel the connection attempt when it gets destroyed
803- in which case the callback will not be invoked. Destroying it does not
802anything to the socket after the connect was successful). 804do anything to the socket after the connect was successful - you cannot
805"uncall" a callback that has been invoked already.
803 806
804Sometimes you need to "prepare" the socket before connecting, for example, 807Sometimes you need to "prepare" the socket before connecting, for example,
805to C<bind> it to some port, or you want a specific connect timeout that 808to C<bind> it to some port, or you want a specific connect timeout that
806is lower than your kernel's default timeout. In this case you can specify 809is lower than your kernel's default timeout. In this case you can specify
807a second callback, C<$prepare_cb>. It will be called with the file handle 810a second callback, C<$prepare_cb>. It will be called with the file handle
… …
893 896
894 $state{next} = sub { 897 $state{next} = sub {
895 return unless exists $state{fh}; 898 return unless exists $state{fh};
896 899
897 my $target = shift @target 900 my $target = shift @target
898 or return (%state = (), _postpone $connect); 901 or return _postpone sub {
902 return unless exists $state{fh};
903 %state = ();
904 $connect->();
905 };
899 906
900 my ($domain, $type, $proto, $sockaddr) = @$target; 907 my ($domain, $type, $proto, $sockaddr) = @$target;
901 908
902 # socket creation 909 # socket creation
903 socket $state{fh}, $domain, $type, $proto 910 socket $state{fh}, $domain, $type, $proto
… …
935 $connect->(delete $state{fh}, format_address $host, $port, sub { 942 $connect->(delete $state{fh}, format_address $host, $port, sub {
936 $guard->cancel; 943 $guard->cancel;
937 $state{next}(); 944 $state{next}();
938 }); 945 });
939 } else { 946 } else {
947 if ($! == Errno::ENOTCONN) {
940 # dummy read to fetch real error code 948 # dummy read to fetch real error code if !cygwin
941 sysread $state{fh}, my $buf, 1 if $! == Errno::ENOTCONN; 949 sysread $state{fh}, my $buf, 1;
950
951 # cygwin 1.5 continously reports "ready' but never delivers
952 # an error with getpeername or sysread.
953 # cygwin 1.7 only reports readyness *once*, but is otherwise
954 # the same, which is actually more broken.
955 # Work around both by using unportable SO_ERROR for cygwin.
956 $! = (unpack "l", getsockopt $state{fh}, Socket::SOL_SOCKET(), Socket::SO_ERROR()) || Errno::EAGAIN
957 if AnyEvent::CYGWIN && $! == Errno::EAGAIN;
958 }
942 959
943 return if $! == Errno::EAGAIN; # skip spurious wake-ups 960 return if $! == Errno::EAGAIN; # skip spurious wake-ups
944 961
945 delete $state{ww}; delete $state{to}; 962 delete $state{ww}; delete $state{to};
946 963
… …
982the socket before it tries to bind to it. See SECURITY CONSIDERATIONS, 999the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,
983below. 1000below.
984 1001
985For each new connection that could be C<accept>ed, call the C<< 1002For each new connection that could be C<accept>ed, call the C<<
986$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking 1003$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
987mode) as first and the peer host and port as second and third arguments 1004mode) as first, and the peer host and port as second and third arguments
988(see C<tcp_connect> for details). 1005(see C<tcp_connect> for details).
989 1006
990Croaks on any errors it can detect before the listen. 1007Croaks on any errors it can detect before the listen.
991 1008
992If called in non-void context, then this function returns a guard object 1009If called in non-void context, then this function returns a guard object
993whose lifetime it tied to the TCP server: If the object gets destroyed, 1010whose lifetime it tied to the TCP server: If the object gets destroyed,
994the server will be stopped (but existing accepted connections will 1011the server will be stopped (but existing accepted connections will
995continue). 1012not be affected).
996 1013
997If you need more control over the listening socket, you can provide a 1014If you need more control over the listening socket, you can provide a
998C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the 1015C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
999C<listen ()> call, with the listen file handle as first argument, and IP 1016C<listen ()> call, with the listen file handle as first argument, and IP
1000address and port number of the local socket endpoint as second and third 1017address and port number of the local socket endpoint as second and third
… …
1093 defined wantarray 1110 defined wantarray
1094 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency 1111 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
1095 : () 1112 : ()
1096} 1113}
1097 1114
1115=item tcp_nodelay $fh, $enable
1116
1117Enables (or disables) the C<TCP_NODELAY> socket option (also known as
1118Nagle's algorithm). Returns false on error, true otherwise.
1119
1120=cut
1121
1122sub tcp_nodelay($$) {
1123 my $onoff = int ! ! $_[1];
1124
1125 setsockopt $_[0], Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), $onoff
1126}
1127
1128=item tcp_congestion $fh, $algorithm
1129
1130Sets the tcp congestion avoidance algorithm (via the C<TCP_CONGESTION>
1131socket option). The default is OS-specific, but is usually
1132C<reno>. Typical other available choices include C<cubic>, C<lp>, C<bic>,
1133C<highspeed>, C<htcp>, C<hybla>, C<illinois>, C<scalable>, C<vegas>,
1134C<veno>, C<westwood> and C<yeah>.
1135
1136=cut
1137
1138sub tcp_congestion($$) {
1139 defined TCP_CONGESTION
1140 ? setsockopt $_[0], Socket::IPPROTO_TCP (), TCP_CONGESTION, "$_[1]"
1141 : undef
1142}
1143
10981; 11441;
1099 1145
1100=back 1146=back
1101 1147
1102=head1 SECURITY CONSIDERATIONS 1148=head1 SECURITY CONSIDERATIONS

Diff Legend

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