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.85 by root, Sun Jul 5 01:38:43 2009 UTC

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

Diff Legend

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