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.63 by root, Wed Oct 1 07:40:39 2008 UTC vs.
Revision 1.83 by root, Mon Jun 29 21:00:32 2009 UTC

… …
57 inet_aton 57 inet_aton
58 tcp_server 58 tcp_server
59 tcp_connect 59 tcp_connect
60); 60);
61 61
62our $VERSION = 4.3; 62our $VERSION = 4.45;
63 63
64=item $ipn = parse_ipv4 $dotted_quad 64=item $ipn = parse_ipv4 $dotted_quad
65 65
66Tries to parse the given dotted quad IPv4 address and return it in 66Tries to parse the given dotted quad IPv4 address and return it in
67octet form (or undef when it isn't in a parsable format). Supports all 67octet form (or undef when it isn't in a parsable format). Supports all
… …
144 ? pack "S", AF_UNIX 144 ? pack "S", AF_UNIX
145 : undef 145 : undef
146 146
147} 147}
148 148
149=item $ipn = parse_address $text 149=item $ipn = parse_address $ip
150 150
151Combines C<parse_ipv4> and C<parse_ipv6> in one function. The address 151Combines C<parse_ipv4> and C<parse_ipv6> in one function. The address
152here refers to the host address (not socket address) in network form 152here refers to the host address (not socket address) in network form
153(binary). 153(binary).
154 154
155If the C<$text> is C<unix/>, then this function returns a special token 155If the C<$text> is C<unix/>, then this function returns a special token
156recognised by the other functions in this module to mean "UNIX domain 156recognised by the other functions in this module to mean "UNIX domain
157socket". 157socket".
158 158
159If the C<$text> to parse is a mapped IPv4 in IPv6 address (:ffff::<ipv4>),
160then it will be treated as an IPv4 address. If you don't want that, you
161have to call C<parse_ipv4> and/or C<parse_ipv6> manually.
162
159=item $text = AnyEvent::Socket::aton $ipn 163=item $ipn = AnyEvent::Socket::aton $ip
160 164
161Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but 165Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but
162I<without> name resolution). 166I<without> name resolution).
163 167
164=cut 168=cut
165 169
166sub parse_address($) { 170sub parse_address($) {
167 &parse_ipv4 || &parse_ipv6 || &parse_unix 171 for (&parse_ipv6) {
172 if ($_) {
173 s/^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff//;
174 return $_;
175 } else {
176 return &parse_ipv4 || &parse_unix
177 }
178 }
168} 179}
169 180
170*aton = \&parse_address; 181*aton = \&parse_address;
171 182
172=item ($host, $service) = parse_hostport $string[, $default_service] 183=item ($host, $service) = parse_hostport $string[, $default_service]
… …
259 : 16 == length $_[0] 270 : 16 == length $_[0]
260 ? AF_INET6 271 ? AF_INET6
261 : unpack "S", $_[0] 272 : unpack "S", $_[0]
262} 273}
263 274
275=item $text = format_ipv4 $ipn
276
277Expects a four octet string representing a binary IPv4 address and returns
278its textual format. Rarely used, see C<format_address> for a nicer
279interface.
280
281=item $text = format_ipv6 $ipn
282
283Expects a sixteen octet string representing a binary IPv6 address and
284returns its textual format. Rarely used, see C<format_address> for a
285nicer interface.
286
264=item $text = format_address $ipn 287=item $text = format_address $ipn
265 288
266Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16 289Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16
267octets for IPv6) and convert it into textual form. 290octets for IPv6) and convert it into textual form.
268 291
… …
271This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>, 294This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>,
272except it automatically detects the address type. 295except it automatically detects the address type.
273 296
274Returns C<undef> if it cannot detect the type. 297Returns C<undef> if it cannot detect the type.
275 298
299If the C<$ipn> is a mapped IPv4 in IPv6 address (:ffff::<ipv4>), then just
300the contained IPv4 address will be returned. If you do not want that, you
301have to call C<format_ipv6> manually.
302
276=item $text = AnyEvent::Socket::ntoa $ipn 303=item $text = AnyEvent::Socket::ntoa $ipn
277 304
278Same as format_address, but not exported (think C<inet_ntoa>). 305Same as format_address, but not exported (think C<inet_ntoa>).
279 306
280=cut 307=cut
281 308
282sub format_address; 309sub format_ipv4($) {
310 join ".", unpack "C4", $_[0]
311}
312
313sub format_ipv6($) {
314 if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {
315 return "::";
316 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {
317 return "::1";
318 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
319 # v4compatible
320 return "::" . format_ipv4 substr $_[0], 12;
321 } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
322 # v4mapped
323 return "::ffff:" . format_ipv4 substr $_[0], 12;
324 } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
325 # v4translated
326 return "::ffff:0:" . format_ipv4 substr $_[0], 12;
327 } else {
328 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
329
330 # this is rather sucky, I admit
331 $ip =~ s/^0:(?:0:)*(0$)?/::/
332 or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/
333 or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/
334 or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/
335 or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/
336 or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/
337 or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/
338 or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/;
339 return $ip
340 }
341}
342
283sub format_address($) { 343sub format_address($) {
284 my $af = address_family $_[0]; 344 my $af = address_family $_[0];
285 if ($af == AF_INET) { 345 if ($af == AF_INET) {
286 return join ".", unpack "C4", $_[0] 346 return &format_ipv4;
287 } elsif ($af == AF_INET6) { 347 } elsif ($af == AF_INET6) {
288 if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {
289 return "::";
290 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {
291 return "::1";
292 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
293 # v4compatible
294 return "::" . format_address substr $_[0], 12;
295 } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { 348 return (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12)
296 # v4mapped 349 ? format_ipv4 substr $_[0], 12
297 return "::ffff:" . format_address substr $_[0], 12; 350 : &format_ipv6;
298 } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
299 # v4translated
300 return "::ffff:0:" . format_address substr $_[0], 12;
301 } else {
302 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
303
304 # this is rather sucky, I admit
305 $ip =~ s/^0:(?:0:)*(0$)?/::/
306 or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/
307 or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/
308 or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/
309 or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/
310 or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/
311 or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/
312 or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/;
313 return $ip
314 }
315 } elsif ($af == AF_UNIX) { 351 } elsif ($af == AF_UNIX) {
316 return "unix/" 352 return "unix/"
317 } else { 353 } else {
318 return undef 354 return undef
319 } 355 }
… …
443C<sctp>. The default is currently C<tcp>, but in the future, this function 479C<sctp>. The default is currently C<tcp>, but in the future, this function
444might try to use other protocols such as C<sctp>, depending on the socket 480might try to use other protocols such as C<sctp>, depending on the socket
445type and any SRV records it might find. 481type and any SRV records it might find.
446 482
447C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use 483C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
448only IPv4) or C<6> (use only IPv6). This setting might be influenced by 484only IPv4) or C<6> (use only IPv6). The default is influenced by
449C<$ENV{PERL_ANYEVENT_PROTOCOLS}>. 485C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
450 486
451C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or 487C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
452C<undef> in which case it gets automatically chosen). 488C<undef> in which case it gets automatically chosen to be C<SOCK_STREAM>
489unless C<$proto> is C<udp>).
453 490
454The callback will receive zero or more array references that contain 491The callback will receive zero or more array references that contain
455C<$family, $type, $proto> for use in C<socket> and a binary 492C<$family, $type, $proto> for use in C<socket> and a binary
456C<$sockaddr> for use in C<connect> (or C<bind>). 493C<$sockaddr> for use in C<connect> (or C<bind>).
457 494
… …
474 511
475sub resolve_sockaddr($$$$$$) { 512sub resolve_sockaddr($$$$$$) {
476 my ($node, $service, $proto, $family, $type, $cb) = @_; 513 my ($node, $service, $proto, $family, $type, $cb) = @_;
477 514
478 if ($node eq "unix/") { 515 if ($node eq "unix/") {
479 return $cb->() if $family || !/^\//; # no can do 516 return $cb->() if $family || $service !~ /^\//; # no can do
480 517
481 return $cb->([AF_UNIX, $type, 0, Socket::pack_sockaddr_un $service]); 518 return $cb->([AF_UNIX, defined $type ? $type : SOCK_STREAM, 0, Socket::pack_sockaddr_un $service]);
482 } 519 }
483 520
484 unless (AF_INET6) { 521 unless (AF_INET6) {
485 $family != 6 522 $family != 6
486 or return $cb->(); 523 or return $cb->();
… …
717 # also http://advogato.org/article/672.html 754 # also http://advogato.org/article/672.html
718 755
719 my %state = ( fh => undef ); 756 my %state = ( fh => undef );
720 757
721 # name/service to type/sockaddr resolution 758 # name/service to type/sockaddr resolution
722 resolve_sockaddr $host, $port, 0, 0, 0, sub { 759 resolve_sockaddr $host, $port, 0, 0, undef, sub {
723 my @target = @_; 760 my @target = @_;
724 761
725 $state{next} = sub { 762 $state{next} = sub {
726 return unless exists $state{fh}; 763 return unless exists $state{fh};
727 764
… …
748 $state{next}(); 785 $state{next}();
749 }) if $timeout; 786 }) if $timeout;
750 787
751 # called when the connect was successful, which, 788 # called when the connect was successful, which,
752 # in theory, could be the case immediately (but never is in practise) 789 # in theory, could be the case immediately (but never is in practise)
753 my $connected = sub { 790 $state{connected} = sub {
754 delete $state{ww}; 791 delete $state{ww};
755 delete $state{to}; 792 delete $state{to};
756 793
757 # we are connected, or maybe there was an error 794 # we are connected, or maybe there was an error
758 if (my $sin = getpeername $state{fh}) { 795 if (my $sin = getpeername $state{fh}) {
759 my ($port, $host) = unpack_sockaddr $sin; 796 my ($port, $host) = unpack_sockaddr $sin;
760 797
761 my $guard = guard { 798 my $guard = guard { %state = () };
762 %state = ();
763 };
764 799
765 $connect->($state{fh}, format_address $host, $port, sub { 800 $connect->(delete $state{fh}, format_address $host, $port, sub {
766 $guard->cancel; 801 $guard->cancel;
767 $state{next}(); 802 $state{next}();
768 }); 803 });
769 } else { 804 } else {
770 # dummy read to fetch real error code 805 # dummy read to fetch real error code
… …
773 } 808 }
774 }; 809 };
775 810
776 # now connect 811 # now connect
777 if (connect $state{fh}, $sockaddr) { 812 if (connect $state{fh}, $sockaddr) {
778 $connected->(); 813 $state{connected}->();
779 } elsif ($! == &Errno::EINPROGRESS # POSIX 814 } elsif ($! == &Errno::EINPROGRESS # POSIX
780 || $! == &Errno::EWOULDBLOCK 815 || $! == &Errno::EWOULDBLOCK
781 # WSAEINPROGRESS intentionally not checked - it means something else entirely 816 # WSAEINPROGRESS intentionally not checked - it means something else entirely
782 || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt 817 || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
783 || $! == AnyEvent::Util::WSAEWOULDBLOCK) { 818 || $! == AnyEvent::Util::WSAEWOULDBLOCK) {
784 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected); 819 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $state{connected});
785 } else { 820 } else {
786 $state{next}(); 821 $state{next}();
787 } 822 }
788 }; 823 };
789 824
… …
854 }, sub { 889 }, sub {
855 my ($fh, $thishost, $thisport) = @_; 890 my ($fh, $thishost, $thisport) = @_;
856 warn "bound to $thishost, port $thisport\n"; 891 warn "bound to $thishost, port $thisport\n";
857 }; 892 };
858 893
894Example: bind a server on a unix domain socket.
895
896 tcp_server "unix/", "/tmp/mydir/mysocket", sub {
897 my ($fh) = @_;
898 };
899
859=cut 900=cut
860 901
861sub tcp_server($$$;$) { 902sub tcp_server($$$;$) {
862 my ($host, $service, $accept, $prepare) = @_; 903 my ($host, $service, $accept, $prepare) = @_;
863 904

Diff Legend

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