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.44 by root, Fri May 30 21:38:46 2008 UTC vs.
Revision 1.89 by root, Wed Jul 15 13:42:13 2009 UTC

… …
2 2
3AnyEvent::Socket - useful IPv4 and IPv6 stuff. 3AnyEvent::Socket - useful IPv4 and IPv6 stuff.
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use AnyEvent::Socket; 7 use AnyEvent::Socket;
8 8
9 tcp_connect "gameserver.deliantra.net", 13327, sub { 9 tcp_connect "gameserver.deliantra.net", 13327, sub {
10 my ($fh) = @_ 10 my ($fh) = @_
11 or die "gameserver.deliantra.net connect failed: $!"; 11 or die "gameserver.deliantra.net connect failed: $!";
12 12
13 # enjoy your filehandle 13 # enjoy your filehandle
14 }; 14 };
15 15
16 # a simple tcp server 16 # a simple tcp server
17 tcp_server undef, 8888, sub { 17 tcp_server undef, 8888, sub {
18 my ($fh, $host, $port) = @_; 18 my ($fh, $host, $port) = @_;
19 19
20 syswrite $fh, "The internet is full, $host:$port. Go away!\015\012"; 20 syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
21 }; 21 };
22 22
23=head1 DESCRIPTION 23=head1 DESCRIPTION
24 24
25This module implements various utility functions for handling internet 25This module implements various utility functions for handling internet
26protocol addresses and sockets, in an as transparent and simple way as 26protocol addresses and sockets, in an as transparent and simple way as
… …
47use AnyEvent::DNS (); 47use AnyEvent::DNS ();
48 48
49use base 'Exporter'; 49use base 'Exporter';
50 50
51our @EXPORT = qw( 51our @EXPORT = qw(
52 parse_hostport
52 parse_ipv4 parse_ipv6 53 parse_ipv4 parse_ipv6
53 parse_ip parse_address 54 parse_ip parse_address
55 format_ipv4 format_ipv6
54 format_ip format_address 56 format_ip format_address
55 address_family 57 address_family
56 inet_aton 58 inet_aton
57 tcp_server 59 tcp_server
58 tcp_connect 60 tcp_connect
59); 61);
60 62
61our $VERSION = 4.1; 63our $VERSION = 4.82;
62 64
63=item $ipn = parse_ipv4 $dotted_quad 65=item $ipn = parse_ipv4 $dotted_quad
64 66
65Tries 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
66octet 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
… …
78 80
79 # check leading parts against range 81 # check leading parts against range
80 return undef if grep $_ >= 256, @_[0 .. @_ - 2]; 82 return undef if grep $_ >= 256, @_[0 .. @_ - 2];
81 83
82 # check trailing part against range 84 # check trailing part against range
83 return undef if $_[-1] >= 1 << (8 * (4 - $#_)); 85 return undef if $_[-1] >= 2 ** (8 * (4 - $#_));
84 86
85 pack "N", (pop) 87 pack "N", (pop)
86 + ($_[0] << 24) 88 + ($_[0] << 24)
87 + ($_[1] << 16) 89 + ($_[1] << 16)
88 + ($_[2] << 8); 90 + ($_[2] << 8);
… …
143 ? pack "S", AF_UNIX 145 ? pack "S", AF_UNIX
144 : undef 146 : undef
145 147
146} 148}
147 149
148=item $ipn = parse_address $text 150=item $ipn = parse_address $ip
149 151
150Combines 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
151here refers to the host address (not socket address) in network form 153here refers to the host address (not socket address) in network form
152(binary). 154(binary).
153 155
154If 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
155recognised by the other functions in this module to mean "UNIX domain 157recognised by the other functions in this module to mean "UNIX domain
156socket". 158socket".
157 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
164=item $ipn = AnyEvent::Socket::aton $ip
165
166Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but
167I<without> name resolution).
168
158=cut 169=cut
159 170
160sub parse_address($) { 171sub parse_address($) {
161 &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 }
162} 180}
163 181
164*parse_ip =\&parse_address; #d# 182*aton = \&parse_address;
183
184=item ($host, $service) = parse_hostport $string[, $default_service]
185
186Splitting a string of the form C<hostname:port> is a common
187problem. Unfortunately, just splitting on the colon makes it hard to
188specify IPv6 addresses and doesn't support the less common but well
189standardised C<[ip literal]> syntax.
190
191This function tries to do this job in a better way, it supports the
192following formats, where C<port> can be a numerical port number of a
193service name, or a C<name=port> string, and the C< port> and C<:port>
194parts are optional. Also, everywhere where an IP address is supported
195a hostname or unix domain socket address is also supported (see
196C<parse_unix>).
197
198 hostname:port e.g. "www.linux.org", "www.x.de:443", "www.x.de:https=443"
199 ipv4:port e.g. "198.182.196.56", "127.1:22"
200 ipv6 e.g. "::1", "affe::1"
201 [ipv4or6]:port e.g. "[::1]", "[10.0.1]:80"
202 [ipv4or6] port e.g. "[127.0.0.1]", "[www.x.org] 17"
203 ipv4or6 port e.g. "::1 443", "10.0.0.1 smtp"
204
205It also supports defaulting the service name in a simple way by using
206C<$default_service> if no service was detected. If neither a service was
207detected nor a default was specified, then this function returns the
208empty list. The same happens when a parse error weas detected, such as a
209hostname with a colon in it (the function is rather conservative, though).
210
211Example:
212
213 print join ",", parse_hostport "localhost:443";
214 # => "localhost,443"
215
216 print join ",", parse_hostport "localhost", "https";
217 # => "localhost,https"
218
219 print join ",", parse_hostport "[::1]";
220 # => "," (empty list)
221
222=cut
223
224sub parse_hostport($;$) {
225 my ($host, $port);
226
227 for ("$_[0]") { # work on a copy, just in case, and also reset pos
228
229 # parse host, special cases: "ipv6" or "ipv6 port"
230 unless (
231 ($host) = /^\s* ([0-9a-fA-F:]*:[0-9a-fA-F:]*:[0-9a-fA-F\.:]*)/xgc
232 and parse_ipv6 $host
233 ) {
234 /^\s*/xgc;
235
236 if (/^ \[ ([^\[\]]+) \]/xgc) {
237 $host = $1;
238 } elsif (/^ ([^\[\]:\ ]+) /xgc) {
239 $host = $1;
240 } else {
241 return;
242 }
243 }
244
245 # parse port
246 if (/\G (?:\s+|:) ([^:[:space:]]+) \s*$/xgc) {
247 $port = $1;
248 } elsif (/\G\s*$/gc && length $_[1]) {
249 $port = $_[1];
250 } else {
251 return;
252 }
253 }
254
255 # hostnames must not contain :'s
256 return if $host =~ /:/ && !parse_ipv6 $host;
257
258 ($host, $port)
259}
165 260
166=item $sa_family = address_family $ipn 261=item $sa_family = address_family $ipn
167 262
168Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :) 263Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)
169of the given host address in network format. 264of the given host address in network format.
… …
176 : 16 == length $_[0] 271 : 16 == length $_[0]
177 ? AF_INET6 272 ? AF_INET6
178 : unpack "S", $_[0] 273 : unpack "S", $_[0]
179} 274}
180 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
181=item $text = format_address $ipn 288=item $text = format_address $ipn
182 289
183Covnvert 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
184octets for IPv6) and convert it into textual form. 291octets for IPv6) and convert it into textual form.
185 292
… …
188This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>, 295This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>,
189except it automatically detects the address type. 296except it automatically detects the address type.
190 297
191Returns C<undef> if it cannot detect the type. 298Returns C<undef> if it cannot detect the type.
192 299
193=cut 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.
194 303
195sub format_address; 304=item $text = AnyEvent::Socket::ntoa $ipn
305
306Same as format_address, but not exported (think C<inet_ntoa>).
307
308=cut
309
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
196sub format_address($) { 344sub format_address($) {
197 my $af = address_family $_[0]; 345 my $af = address_family $_[0];
198 if ($af == AF_INET) { 346 if ($af == AF_INET) {
199 return join ".", unpack "C4", $_[0] 347 return &format_ipv4;
200 } elsif ($af == AF_INET6) { 348 } elsif ($af == AF_INET6) {
201 if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {
202 return "::";
203 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {
204 return "::1";
205 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
206 # v4compatible
207 return "::" . format_address substr $_[0], 12;
208 } 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)
209 # v4mapped 350 ? format_ipv4 substr $_[0], 12
210 return "::ffff:" . format_address substr $_[0], 12; 351 : &format_ipv6;
211 } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
212 # v4translated
213 return "::ffff:0:" . format_address substr $_[0], 12;
214 } else {
215 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
216
217 # this is rather sucky, I admit
218 $ip =~ s/^0:(?:0:)*(0$)?/::/
219 or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/
220 or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/
221 or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/
222 or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/
223 or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/
224 or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/
225 or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/;
226 return $ip
227 }
228 } elsif ($af == AF_UNIX) { 352 } elsif ($af == AF_UNIX) {
229 return "unix/" 353 return "unix/"
230 } else { 354 } else {
231 return undef 355 return undef
232 } 356 }
233} 357}
234 358
235*format_ip = \&format_address; 359*ntoa = \&format_address;
236 360
237=item inet_aton $name_or_address, $cb->(@addresses) 361=item inet_aton $name_or_address, $cb->(@addresses)
238 362
239Works similarly to its Socket counterpart, except that it uses a 363Works similarly to its Socket counterpart, except that it uses a
240callback. Also, if a host has only an IPv6 address, this might be passed 364callback. Also, if a host has only an IPv6 address, this might be passed
… …
356C<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
357might 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
358type and any SRV records it might find. 482type and any SRV records it might find.
359 483
360C<$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
361only 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
362C<$ENV{PERL_ANYEVENT_PROTOCOLS}>. 486C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
363 487
364C<$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
365C<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>).
366 491
367The callback will receive zero or more array references that contain 492The callback will receive zero or more array references that contain
368C<$family, $type, $proto> for use in C<socket> and a binary 493C<$family, $type, $proto> for use in C<socket> and a binary
369C<$sockaddr> for use in C<connect> (or C<bind>). 494C<$sockaddr> for use in C<connect> (or C<bind>).
370 495
… …
374 499
375 resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... }; 500 resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
376 501
377=cut 502=cut
378 503
504# microsoft can't even get getprotobyname working (the etc/protocols file
505# gets lost fairly often on windows), so we have to hardcode some common
506# protocol numbers ourselves.
507our %PROTO_BYNAME;
508
509$PROTO_BYNAME{tcp} = &Socket::IPPROTO_TCP if defined &Socket::IPPROTO_TCP;
510$PROTO_BYNAME{udp} = &Socket::IPPROTO_UDP if defined &Socket::IPPROTO_UDP;
511$PROTO_BYNAME{icmp} = &Socket::IPPROTO_ICMP if defined &Socket::IPPROTO_ICMP;
512
379sub resolve_sockaddr($$$$$$) { 513sub resolve_sockaddr($$$$$$) {
380 my ($node, $service, $proto, $family, $type, $cb) = @_; 514 my ($node, $service, $proto, $family, $type, $cb) = @_;
381 515
382 if ($node eq "unix/") { 516 if ($node eq "unix/") {
383 return $cb->() if $family || !/^\//; # no can do 517 return $cb->() if $family || $service !~ /^\//; # no can do
384 518
385 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]);
386 } 520 }
387 521
388 unless (AF_INET6) { 522 unless (AF_INET6) {
389 $family != 6 523 $family != 6
390 or return $cb->(); 524 or return $cb->();
… …
399 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4}; 533 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4};
400 534
401 $proto ||= "tcp"; 535 $proto ||= "tcp";
402 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM; 536 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
403 537
404 my $proton = (getprotobyname $proto)[2] 538 my $proton = $PROTO_BYNAME{lc $proto} || (getprotobyname $proto)[2]
405 or Carp::croak "$proto: protocol unknown"; 539 or Carp::croak "$proto: protocol unknown";
406 540
407 my $port; 541 my $port;
408 542
409 if ($service =~ /^(\S+)=(\d+)$/) { 543 if ($service =~ /^(\S+)=(\d+)$/) {
… …
560lessen the impact of this windows bug, a default timeout of 30 seconds 694lessen the impact of this windows bug, a default timeout of 30 seconds
561will be imposed on windows. Cygwin is not affected. 695will be imposed on windows. Cygwin is not affected.
562 696
563Simple Example: connect to localhost on port 22. 697Simple Example: connect to localhost on port 22.
564 698
565 tcp_connect localhost => 22, sub { 699 tcp_connect localhost => 22, sub {
566 my $fh = shift 700 my $fh = shift
567 or die "unable to connect: $!"; 701 or die "unable to connect: $!";
568 # do something 702 # do something
569 }; 703 };
570 704
571Complex Example: connect to www.google.com on port 80 and make a simple 705Complex Example: connect to www.google.com on port 80 and make a simple
572GET request without much error handling. Also limit the connection timeout 706GET request without much error handling. Also limit the connection timeout
573to 15 seconds. 707to 15 seconds.
574 708
… …
621 # also http://advogato.org/article/672.html 755 # also http://advogato.org/article/672.html
622 756
623 my %state = ( fh => undef ); 757 my %state = ( fh => undef );
624 758
625 # name/service to type/sockaddr resolution 759 # name/service to type/sockaddr resolution
626 resolve_sockaddr $host, $port, 0, 0, 0, sub { 760 resolve_sockaddr $host, $port, 0, 0, undef, sub {
627 my @target = @_; 761 my @target = @_;
628 762
629 $state{next} = sub { 763 $state{next} = sub {
630 return unless exists $state{fh}; 764 return unless exists $state{fh};
631 765
… …
652 $state{next}(); 786 $state{next}();
653 }) if $timeout; 787 }) if $timeout;
654 788
655 # called when the connect was successful, which, 789 # called when the connect was successful, which,
656 # 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)
657 my $connected = sub { 791 $state{connected} = sub {
658 delete $state{ww};
659 delete $state{to};
660
661 # we are connected, or maybe there was an error 792 # we are connected, or maybe there was an error
662 if (my $sin = getpeername $state{fh}) { 793 if (my $sin = getpeername $state{fh}) {
663 my ($port, $host) = unpack_sockaddr $sin; 794 my ($port, $host) = unpack_sockaddr $sin;
664 795
796 delete $state{ww}; delete $state{to};
797
665 my $guard = guard { 798 my $guard = guard { %state = () };
666 %state = ();
667 };
668 799
669 $connect->($state{fh}, format_address $host, $port, sub { 800 $connect->(delete $state{fh}, format_address $host, $port, sub {
670 $guard->cancel; 801 $guard->cancel;
671 $state{next}(); 802 $state{next}();
672 }); 803 });
673 } else { 804 } else {
674 # dummy read to fetch real error code 805 # dummy read to fetch real error code
675 sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN; 806 sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN;
807
808 return if $! == &Errno::EAGAIN; # skip spurious wake-ups
809
810 delete $state{ww}; delete $state{to};
811
676 $state{next}(); 812 $state{next}();
677 } 813 }
678 }; 814 };
679 815
680 # now connect 816 # now connect
681 if (connect $state{fh}, $sockaddr) { 817 if (connect $state{fh}, $sockaddr) {
682 $connected->(); 818 $state{connected}->();
683 } elsif ($! == &Errno::EINPROGRESS # POSIX 819 } elsif ($! == &Errno::EINPROGRESS # POSIX
684 || $! == &Errno::EWOULDBLOCK 820 || $! == &Errno::EWOULDBLOCK
685 # WSAEINPROGRESS intentionally not checked - it means something else entirely 821 # WSAEINPROGRESS intentionally not checked - it means something else entirely
686 || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt 822 || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
687 || $! == AnyEvent::Util::WSAEWOULDBLOCK) { 823 || $! == AnyEvent::Util::WSAEWOULDBLOCK) {
688 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected); 824 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $state{connected});
825 $state{connected}->();#d#
689 } else { 826 } else {
690 $state{next}(); 827 $state{next}();
691 } 828 }
692 }; 829 };
693 830
… …
758 }, sub { 895 }, sub {
759 my ($fh, $thishost, $thisport) = @_; 896 my ($fh, $thishost, $thisport) = @_;
760 warn "bound to $thishost, port $thisport\n"; 897 warn "bound to $thishost, port $thisport\n";
761 }; 898 };
762 899
900Example: bind a server on a unix domain socket.
901
902 tcp_server "unix/", "/tmp/mydir/mysocket", sub {
903 my ($fh) = @_;
904 };
905
763=cut 906=cut
764 907
765sub tcp_server($$$;$) { 908sub tcp_server($$$;$) {
766 my ($host, $service, $accept, $prepare) = @_; 909 my ($host, $service, $accept, $prepare) = @_;
767 910

Diff Legend

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