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.48 by root, Thu Jun 5 18:30:08 2008 UTC vs.
Revision 1.74 by root, Sat Apr 11 05:56:36 2009 UTC

… …
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
54 format_ip format_address 55 format_ip format_address
55 address_family 56 address_family
56 inet_aton 57 inet_aton
57 tcp_server 58 tcp_server
58 tcp_connect 59 tcp_connect
59); 60);
60 61
61our $VERSION = 4.14; 62our $VERSION = 4.351;
62 63
63=item $ipn = parse_ipv4 $dotted_quad 64=item $ipn = parse_ipv4 $dotted_quad
64 65
65Tries 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
66octet 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
… …
78 79
79 # check leading parts against range 80 # check leading parts against range
80 return undef if grep $_ >= 256, @_[0 .. @_ - 2]; 81 return undef if grep $_ >= 256, @_[0 .. @_ - 2];
81 82
82 # check trailing part against range 83 # check trailing part against range
83 return undef if $_[-1] >= 1 << (8 * (4 - $#_)); 84 return undef if $_[-1] >= 2 ** (8 * (4 - $#_));
84 85
85 pack "N", (pop) 86 pack "N", (pop)
86 + ($_[0] << 24) 87 + ($_[0] << 24)
87 + ($_[1] << 16) 88 + ($_[1] << 16)
88 + ($_[2] << 8); 89 + ($_[2] << 8);
… …
153 154
154If 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
155recognised by the other functions in this module to mean "UNIX domain 156recognised by the other functions in this module to mean "UNIX domain
156socket". 157socket".
157 158
159=item $text = AnyEvent::Socket::aton $ipn
160
161Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but
162I<without> name resolution).
163
158=cut 164=cut
159 165
160sub parse_address($) { 166sub parse_address($) {
161 &parse_ipv4 || &parse_ipv6 || &parse_unix 167 &parse_ipv4 || &parse_ipv6 || &parse_unix
162} 168}
163 169
164*parse_ip =\&parse_address; #d# 170*aton = \&parse_address;
171
172=item ($host, $service) = parse_hostport $string[, $default_service]
173
174Splitting a string of the form C<hostname:port> is a common
175problem. Unfortunately, just splitting on the colon makes it hard to
176specify IPv6 addresses and doesn't support the less common but well
177standardised C<[ip literal]> syntax.
178
179This function tries to do this job in a better way, it supports the
180following formats, where C<port> can be a numerical port number of a
181service name, or a C<name=port> string, and the C< port> and C<:port>
182parts are optional. Also, everywhere where an IP address is supported
183a hostname or unix domain socket address is also supported (see
184C<parse_unix>).
185
186 hostname:port e.g. "www.linux.org", "www.x.de:443", "www.x.de:https=443"
187 ipv4:port e.g. "198.182.196.56", "127.1:22"
188 ipv6 e.g. "::1", "affe::1"
189 [ipv4or6]:port e.g. "[::1]", "[10.0.1]:80"
190 [ipv4or6] port e.g. "[127.0.0.1]", "[www.x.org] 17"
191 ipv4or6 port e.g. "::1 443", "10.0.0.1 smtp"
192
193It also supports defaulting the service name in a simple way by using
194C<$default_service> if no service was detected. If neither a service was
195detected nor a default was specified, then this function returns the
196empty list. The same happens when a parse error weas detected, such as a
197hostname with a colon in it (the function is rather conservative, though).
198
199Example:
200
201 print join ",", parse_hostport "localhost:443";
202 # => "localhost,443"
203
204 print join ",", parse_hostport "localhost", "https";
205 # => "localhost,https"
206
207 print join ",", parse_hostport "[::1]";
208 # => "," (empty list)
209
210=cut
211
212sub parse_hostport($;$) {
213 my ($host, $port);
214
215 for ("$_[0]") { # work on a copy, just in case, and also reset pos
216
217 # parse host, special cases: "ipv6" or "ipv6 port"
218 unless (
219 ($host) = /^\s* ([0-9a-fA-F:]*:[0-9a-fA-F:]*:[0-9a-fA-F\.:]*)/xgc
220 and parse_ipv6 $host
221 ) {
222 /^\s*/xgc;
223
224 if (/^ \[ ([^\[\]]+) \]/xgc) {
225 $host = $1;
226 } elsif (/^ ([^\[\]:\ ]+) /xgc) {
227 $host = $1;
228 } else {
229 return;
230 }
231 }
232
233 # parse port
234 if (/\G (?:\s+|:) ([^:[:space:]]+) \s*$/xgc) {
235 $port = $1;
236 } elsif (/\G\s*$/gc && length $_[1]) {
237 $port = $_[1];
238 } else {
239 return;
240 }
241 }
242
243 # hostnames must not contain :'s
244 return if $host =~ /:/ && !parse_ipv6 $host;
245
246 ($host, $port)
247}
165 248
166=item $sa_family = address_family $ipn 249=item $sa_family = address_family $ipn
167 250
168Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :) 251Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)
169of the given host address in network format. 252of the given host address in network format.
… …
187 270
188This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>, 271This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>,
189except it automatically detects the address type. 272except it automatically detects the address type.
190 273
191Returns C<undef> if it cannot detect the type. 274Returns C<undef> if it cannot detect the type.
275
276=item $text = AnyEvent::Socket::ntoa $ipn
277
278Same as format_address, but not exported (think C<inet_ntoa>).
192 279
193=cut 280=cut
194 281
195sub format_address; 282sub format_address;
196sub format_address($) { 283sub format_address($) {
… …
230 } else { 317 } else {
231 return undef 318 return undef
232 } 319 }
233} 320}
234 321
235*format_ip = \&format_address; 322*ntoa = \&format_address;
236 323
237=item inet_aton $name_or_address, $cb->(@addresses) 324=item inet_aton $name_or_address, $cb->(@addresses)
238 325
239Works similarly to its Socket counterpart, except that it uses a 326Works similarly to its Socket counterpart, except that it uses a
240callback. Also, if a host has only an IPv6 address, this might be passed 327callback. 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 443C<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 444might try to use other protocols such as C<sctp>, depending on the socket
358type and any SRV records it might find. 445type and any SRV records it might find.
359 446
360C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use 447C<$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 448only IPv4) or C<6> (use only IPv6). The default is influenced by
362C<$ENV{PERL_ANYEVENT_PROTOCOLS}>. 449C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
363 450
364C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or 451C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
365C<undef> in which case it gets automatically chosen). 452C<undef> in which case it gets automatically chosen to be C<SOCK_STREAM>
453unless C<$proto> is C<udp>).
366 454
367The callback will receive zero or more array references that contain 455The callback will receive zero or more array references that contain
368C<$family, $type, $proto> for use in C<socket> and a binary 456C<$family, $type, $proto> for use in C<socket> and a binary
369C<$sockaddr> for use in C<connect> (or C<bind>). 457C<$sockaddr> for use in C<connect> (or C<bind>).
370 458
… …
374 462
375 resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... }; 463 resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
376 464
377=cut 465=cut
378 466
467# microsoft can't even get getprotobyname working (the etc/protocols file
468# gets lost fairly often on windows), so we have to hardcode some common
469# protocol numbers ourselves.
470our %PROTO_BYNAME;
471
472$PROTO_BYNAME{tcp} = &Socket::IPPROTO_TCP if defined &Socket::IPPROTO_TCP;
473$PROTO_BYNAME{udp} = &Socket::IPPROTO_UDP if defined &Socket::IPPROTO_UDP;
474$PROTO_BYNAME{icmp} = &Socket::IPPROTO_ICMP if defined &Socket::IPPROTO_ICMP;
475
379sub resolve_sockaddr($$$$$$) { 476sub resolve_sockaddr($$$$$$) {
380 my ($node, $service, $proto, $family, $type, $cb) = @_; 477 my ($node, $service, $proto, $family, $type, $cb) = @_;
381 478
382 if ($node eq "unix/") { 479 if ($node eq "unix/") {
383 return $cb->() if $family || !/^\//; # no can do 480 return $cb->() if $family || $service !~ /^\//; # no can do
384 481
385 return $cb->([AF_UNIX, $type, 0, Socket::pack_sockaddr_un $service]); 482 return $cb->([AF_UNIX, defined $type ? $type : SOCK_STREAM, 0, Socket::pack_sockaddr_un $service]);
386 } 483 }
387 484
388 unless (AF_INET6) { 485 unless (AF_INET6) {
389 $family != 6 486 $family != 6
390 or return $cb->(); 487 or return $cb->();
… …
399 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4}; 496 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4};
400 497
401 $proto ||= "tcp"; 498 $proto ||= "tcp";
402 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM; 499 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
403 500
404 my $proton = (getprotobyname $proto)[2] 501 my $proton = $PROTO_BYNAME{lc $proto} || (getprotobyname $proto)[2]
405 or Carp::croak "$proto: protocol unknown"; 502 or Carp::croak "$proto: protocol unknown";
406 503
407 my $port; 504 my $port;
408 505
409 if ($service =~ /^(\S+)=(\d+)$/) { 506 if ($service =~ /^(\S+)=(\d+)$/) {
… …
621 # also http://advogato.org/article/672.html 718 # also http://advogato.org/article/672.html
622 719
623 my %state = ( fh => undef ); 720 my %state = ( fh => undef );
624 721
625 # name/service to type/sockaddr resolution 722 # name/service to type/sockaddr resolution
626 resolve_sockaddr $host, $port, 0, 0, 0, sub { 723 resolve_sockaddr $host, $port, 0, 0, undef, sub {
627 my @target = @_; 724 my @target = @_;
628 725
629 $state{next} = sub { 726 $state{next} = sub {
630 return unless exists $state{fh}; 727 return unless exists $state{fh};
631 728
… …
652 $state{next}(); 749 $state{next}();
653 }) if $timeout; 750 }) if $timeout;
654 751
655 # called when the connect was successful, which, 752 # called when the connect was successful, which,
656 # in theory, could be the case immediately (but never is in practise) 753 # in theory, could be the case immediately (but never is in practise)
657 my $connected = sub { 754 $state{connected} = sub {
658 delete $state{ww}; 755 delete $state{ww};
659 delete $state{to}; 756 delete $state{to};
660 757
661 # we are connected, or maybe there was an error 758 # we are connected, or maybe there was an error
662 if (my $sin = getpeername $state{fh}) { 759 if (my $sin = getpeername $state{fh}) {
663 my ($port, $host) = unpack_sockaddr $sin; 760 my ($port, $host) = unpack_sockaddr $sin;
664 761
665 my $guard = guard { 762 my $guard = guard { %state = () };
666 %state = ();
667 };
668 763
669 $connect->($state{fh}, format_address $host, $port, sub { 764 $connect->(delete $state{fh}, format_address $host, $port, sub {
670 $guard->cancel; 765 $guard->cancel;
671 $state{next}(); 766 $state{next}();
672 }); 767 });
673 } else { 768 } else {
674 # dummy read to fetch real error code 769 # dummy read to fetch real error code
… …
677 } 772 }
678 }; 773 };
679 774
680 # now connect 775 # now connect
681 if (connect $state{fh}, $sockaddr) { 776 if (connect $state{fh}, $sockaddr) {
682 $connected->(); 777 $state{connected}->();
683 } elsif ($! == &Errno::EINPROGRESS # POSIX 778 } elsif ($! == &Errno::EINPROGRESS # POSIX
684 || $! == &Errno::EWOULDBLOCK 779 || $! == &Errno::EWOULDBLOCK
685 # WSAEINPROGRESS intentionally not checked - it means something else entirely 780 # WSAEINPROGRESS intentionally not checked - it means something else entirely
686 || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt 781 || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
687 || $! == AnyEvent::Util::WSAEWOULDBLOCK) { 782 || $! == AnyEvent::Util::WSAEWOULDBLOCK) {
688 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected); 783 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $state{connected});
689 } else { 784 } else {
690 $state{next}(); 785 $state{next}();
691 } 786 }
692 }; 787 };
693 788
… …
758 }, sub { 853 }, sub {
759 my ($fh, $thishost, $thisport) = @_; 854 my ($fh, $thishost, $thisport) = @_;
760 warn "bound to $thishost, port $thisport\n"; 855 warn "bound to $thishost, port $thisport\n";
761 }; 856 };
762 857
858Example: bind a server on a unix domain socket.
859
860 tcp_server "unix/", "/tmp/mydir/mysocket", sub {
861 my ($fh) = @_;
862 };
863
763=cut 864=cut
764 865
765sub tcp_server($$$;$) { 866sub tcp_server($$$;$) {
766 my ($host, $service, $accept, $prepare) = @_; 867 my ($host, $service, $accept, $prepare) = @_;
767 868

Diff Legend

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