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.40 by root, Thu May 29 00:30:15 2008 UTC vs.
Revision 1.63 by root, Wed Oct 1 07:40:39 2008 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
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 = '1.0'; 62our $VERSION = 4.3;
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.
… …
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.
192 275
276=item $text = AnyEvent::Socket::ntoa $ipn
277
278Same as format_address, but not exported (think C<inet_ntoa>).
279
193=cut 280=cut
194 281
195sub format_address; 282sub format_address;
196sub format_address($) { 283sub format_address($) {
197 my $af = address_family $_[0]; 284 my $af = address_family $_[0];
198 if ($af == AF_INET) { 285 if ($af == AF_INET) {
199 return join ".", unpack "C4", $_[0] 286 return join ".", unpack "C4", $_[0]
200 } elsif ($af == AF_INET6) { 287 } 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";
201 if (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) { 292 } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
202 # v4compatible 293 # v4compatible
203 return "::" . format_address substr $_[0], 12; 294 return "::" . format_address substr $_[0], 12;
204 } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { 295 } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
205 # v4mapped 296 # v4mapped
206 return "::ffff:" . format_address substr $_[0], 12; 297 return "::ffff:" . format_address substr $_[0], 12;
… …
208 # v4translated 299 # v4translated
209 return "::ffff:0:" . format_address substr $_[0], 12; 300 return "::ffff:0:" . format_address substr $_[0], 12;
210 } else { 301 } else {
211 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; 302 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
212 303
304 # this is rather sucky, I admit
213 $ip =~ s/^0:(?:0:)*(0$)?/::/ 305 $ip =~ s/^0:(?:0:)*(0$)?/::/
214 or $ip =~ s/(:0)+$/::/ 306 or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/
215 or $ip =~ s/(:0)+/:/; 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}/:/;
216 return $ip 313 return $ip
217 } 314 }
218 } elsif ($af == AF_UNIX) { 315 } elsif ($af == AF_UNIX) {
219 return "unix/" 316 return "unix/"
220 } else { 317 } else {
221 return undef 318 return undef
222 } 319 }
223} 320}
224 321
225*format_ip = \&format_address; 322*ntoa = \&format_address;
226 323
227=item inet_aton $name_or_address, $cb->(@addresses) 324=item inet_aton $name_or_address, $cb->(@addresses)
228 325
229Works similarly to its Socket counterpart, except that it uses a 326Works similarly to its Socket counterpart, except that it uses a
230callback. 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
… …
364 461
365 resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... }; 462 resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
366 463
367=cut 464=cut
368 465
466# microsoft can't even get getprotobyname working (the etc/protocols file
467# gets lost fairly often on windows), so we have to hardcode some common
468# protocol numbers ourselves.
469our %PROTO_BYNAME;
470
471$PROTO_BYNAME{tcp} = &Socket::IPPROTO_TCP if defined &Socket::IPPROTO_TCP;
472$PROTO_BYNAME{udp} = &Socket::IPPROTO_UDP if defined &Socket::IPPROTO_UDP;
473$PROTO_BYNAME{icmp} = &Socket::IPPROTO_ICMP if defined &Socket::IPPROTO_ICMP;
474
369sub resolve_sockaddr($$$$$$) { 475sub resolve_sockaddr($$$$$$) {
370 my ($node, $service, $proto, $family, $type, $cb) = @_; 476 my ($node, $service, $proto, $family, $type, $cb) = @_;
371 477
372 if ($node eq "unix/") { 478 if ($node eq "unix/") {
373 return $cb->() if $family || !/^\//; # no can do 479 return $cb->() if $family || !/^\//; # no can do
… …
389 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4}; 495 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4};
390 496
391 $proto ||= "tcp"; 497 $proto ||= "tcp";
392 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM; 498 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
393 499
394 my $proton = (getprotobyname $proto)[2] 500 my $proton = $PROTO_BYNAME{lc $proto} || (getprotobyname $proto)[2]
395 or Carp::croak "$proto: protocol unknown"; 501 or Carp::croak "$proto: protocol unknown";
396 502
397 my $port; 503 my $port;
398 504
399 if ($service =~ /^(\S+)=(\d+)$/) { 505 if ($service =~ /^(\S+)=(\d+)$/) {
… …
474 580
475 # no srv records, continue traditionally 581 # no srv records, continue traditionally
476 @srv 582 @srv
477 or return &$resolve; 583 or return &$resolve;
478 584
479 # only srv record has "." => abort 585 # the only srv record has "." ("" here) => abort
480 $srv[0][2] ne "." || $#srv 586 $srv[0][2] ne "" || $#srv
481 or return $cb->(); 587 or return $cb->();
482 588
483 # use srv records then 589 # use srv records then
484 @target = map ["$_->[3].", $_->[2]], 590 @target = map ["$_->[3].", $_->[2]],
485 grep $_->[3] ne ".", 591 grep $_->[3] ne ".",
… …
550lessen the impact of this windows bug, a default timeout of 30 seconds 656lessen the impact of this windows bug, a default timeout of 30 seconds
551will be imposed on windows. Cygwin is not affected. 657will be imposed on windows. Cygwin is not affected.
552 658
553Simple Example: connect to localhost on port 22. 659Simple Example: connect to localhost on port 22.
554 660
555 tcp_connect localhost => 22, sub { 661 tcp_connect localhost => 22, sub {
556 my $fh = shift 662 my $fh = shift
557 or die "unable to connect: $!"; 663 or die "unable to connect: $!";
558 # do something 664 # do something
559 }; 665 };
560 666
561Complex Example: connect to www.google.com on port 80 and make a simple 667Complex Example: connect to www.google.com on port 80 and make a simple
562GET request without much error handling. Also limit the connection timeout 668GET request without much error handling. Also limit the connection timeout
563to 15 seconds. 669to 15 seconds.
564 670

Diff Legend

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