--- AnyEvent/lib/AnyEvent/Socket.pm 2008/05/26 05:09:53 1.28 +++ AnyEvent/lib/AnyEvent/Socket.pm 2008/08/20 12:37:21 1.59 @@ -4,21 +4,21 @@ =head1 SYNOPSIS - use AnyEvent::Socket; - - tcp_connect "gameserver.deliantra.net", 13327, sub { - my ($fh) = @_ - or die "gameserver.deliantra.net connect failed: $!"; - - # enjoy your filehandle - }; - - # a simple tcp server - tcp_server undef, 8888, sub { - my ($fh, $host, $port) = @_; - - syswrite $fh, "The internet is full, $host:$port. Go away!\015\012"; - }; + use AnyEvent::Socket; + + tcp_connect "gameserver.deliantra.net", 13327, sub { + my ($fh) = @_ + or die "gameserver.deliantra.net connect failed: $!"; + + # enjoy your filehandle + }; + + # a simple tcp server + tcp_server undef, 8888, sub { + my ($fh, $host, $port) = @_; + + syswrite $fh, "The internet is full, $host:$port. Go away!\015\012"; + }; =head1 DESCRIPTION @@ -40,17 +40,26 @@ use Carp (); use Errno (); -use Socket qw(AF_INET SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR); +use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR); -use AnyEvent qw(WIN32); +use AnyEvent (); use AnyEvent::Util qw(guard fh_nonblocking AF_INET6); use AnyEvent::DNS (); use base 'Exporter'; -our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect); +our @EXPORT = qw( + parse_hostport + parse_ipv4 parse_ipv6 + parse_ip parse_address + format_ip format_address + address_family + inet_aton + tcp_server + tcp_connect +); -our $VERSION = '1.0'; +our $VERSION = 4.231; =item $ipn = parse_ipv4 $dotted_quad @@ -72,7 +81,7 @@ return undef if grep $_ >= 256, @_[0 .. @_ - 2]; # check trailing part against range - return undef if $_[-1] >= 1 << (8 * (4 - $#_)); + return undef if $_[-1] >= 2 ** (8 * (4 - $#_)); pack "N", (pop) + ($_[0] << 24) @@ -130,47 +139,188 @@ pack "n*", map hex, @h, @t } -=item $ipn = parse_ip $text +sub parse_unix($) { + $_[0] eq "unix/" + ? pack "S", AF_UNIX + : undef + +} + +=item $ipn = parse_address $text -Combines C and C in one function. +Combines C and C in one function. The address +here refers to the host address (not socket address) in network form +(binary). + +If the C<$text> is C, then this function returns a special token +recognised by the other functions in this module to mean "UNIX domain +socket". + +=item $text = AnyEvent::Socket::aton $ipn + +Same as C, but not exported (think C but +I name resolution). =cut -sub parse_ip($) { - &parse_ipv4 || &parse_ipv6 +sub parse_address($) { + &parse_ipv4 || &parse_ipv6 || &parse_unix } -=item $text = format_ip $ipn +*aton = \&parse_address; + +=item ($host, $service) = parse_hostport $string[, $default_service] + +Splitting a string of the form C is a common +problem. Unfortunately, just splitting on the colon makes it hard to +specify IPv6 addresses and doesn't support the less common but well +standardised C<[ip literal]> syntax. + +This function tries to do this job in a better way, it supports the +following formats, where C can be a numerical port number of a +service name, or a C string, and the C< port> and C<:port> +parts are optional. Also, everywhere where an IP address is supported +a hostname or unix domain socket address is also supported (see +C). + + hostname:port e.g. "www.linux.org", "www.x.de:443", "www.x.de:https=443" + ipv4:port e.g. "198.182.196.56", "127.1:22" + ipv6 e.g. "::1", "affe::1" + [ipv4or6]:port e.g. "[::1]", "[10.0.1]:80" + [ipv4or6] port e.g. "[127.0.0.1]", "[www.x.org] 17" + ipv4or6 port e.g. "::1 443", "10.0.0.1 smtp" + +It also supports defaulting the service name in a simple way by using +C<$default_service> if no service was detected. If neither a service was +detected nor a default was specified, then this function returns the +empty list. The same happens when a parse error weas detected, such as a +hostname with a colon in it (the function is rather conservative, though). + +Example: + + print join ",", parse_hostport "localhost:443"; + # => "localhost,443" + + print join ",", parse_hostport "localhost", "https"; + # => "localhost,https" -Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets) -and converts it into textual form. + print join ",", parse_hostport "[::1]"; + # => "," (empty list) + +=cut + +sub parse_hostport($;$) { + my ($host, $port); + + for ("$_[0]") { # work on a copy, just in case, and also reset pos + + # parse host, special cases: "ipv6" or "ipv6 port" + unless ( + ($host) = /^\s* ([0-9a-fA-F:]*:[0-9a-fA-F:]*:[0-9a-fA-F\.:]*)/xgc + and parse_ipv6 $host + ) { + /^\s*/xgc; + + if (/^ \[ ([^\[\]]+) \]/xgc) { + $host = $1; + } elsif (/^ ([^\[\]:\ ]+) /xgc) { + $host = $1; + } else { + return; + } + } + + # parse port + if (/\G (?:\s+|:) ([^:[:space:]]+) \s*$/xgc) { + $port = $1; + } elsif (/\G\s*$/gc && length $_[1]) { + $port = $_[1]; + } else { + return; + } + } + + # hostnames must not contain :'s + return if $host =~ /:/ && !parse_ipv6 $host; + + ($host, $port) +} + +=item $sa_family = address_family $ipn + +Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :) +of the given host address in network format. + +=cut + +sub address_family($) { + 4 == length $_[0] + ? AF_INET + : 16 == length $_[0] + ? AF_INET6 + : unpack "S", $_[0] +} + +=item $text = format_address $ipn + +Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16 +octets for IPv6) and convert it into textual form. + +Returns C for UNIX domain sockets. This function works similarly to C, except it automatically detects the address type. +Returns C if it cannot detect the type. + +=item $text = AnyEvent::Socket::ntoa $ipn + +Same as format_address, but not exported (think C). + =cut -sub format_ip; -sub format_ip($) { - if (4 == length $_[0]) { +sub format_address; +sub format_address($) { + my $af = address_family $_[0]; + if ($af == AF_INET) { return join ".", unpack "C4", $_[0] - } elsif (16 == length $_[0]) { - if (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { + } elsif ($af == AF_INET6) { + if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) { + return "::"; + } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) { + return "::1"; + } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) { + # v4compatible + return "::" . format_address substr $_[0], 12; + } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { # v4mapped - return "::ffff:" . format_ip substr $_[0], 12; + return "::ffff:" . format_address substr $_[0], 12; + } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) { + # v4translated + return "::ffff:0:" . format_address substr $_[0], 12; } else { my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; + # this is rather sucky, I admit $ip =~ s/^0:(?:0:)*(0$)?/::/ - or $ip =~ s/(:0)+$/::/ - or $ip =~ s/(:0)+/:/; + or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/ + or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/ + or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/ + or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/ + or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/ + or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/ + or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/; return $ip } + } elsif ($af == AF_UNIX) { + return "unix/" } else { return undef } } +*ntoa = \&format_address; + =item inet_aton $name_or_address, $cb->(@addresses) Works similarly to its Socket counterpart, except that it uses a @@ -179,7 +329,7 @@ for IPv6). Unlike the L function of the same name, you can get multiple IPv4 -and IPv6 addresses as result. +and IPv6 addresses as result (and maybe even other adrdess types). =cut @@ -207,62 +357,255 @@ } } -=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host - -Pack the given port/host combination into a binary sockaddr structure. Handles -both IPv4 and IPv6 host addresses. +# check for broken platforms with extra field in sockaddr structure +# kind of a rfc vs. bsd issue, as usual (ok, normally it's a +# unix vs. bsd issue, a iso C vs. bsd issue or simply a +# correctness vs. bsd issue. +my $pack_family = (0x55 == Socket::sockaddr_family "\x55\x55") + ? "xC" : "S"; + +=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host + +Pack the given port/host combination into a binary sockaddr +structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX +domain sockets (C<$host> == C and C<$service> == absolute +pathname). =cut sub pack_sockaddr($$) { - if (4 == length $_[1]) { + my $af = address_family $_[1]; + + if ($af == AF_INET) { Socket::pack_sockaddr_in $_[0], $_[1] - } elsif (16 == length $_[1]) { - pack "SnL a16 L", + } elsif ($af == AF_INET6) { + pack "$pack_family nL a16 L", AF_INET6, $_[0], # port 0, # flowinfo $_[1], # addr 0 # scope id + } elsif ($af == AF_UNIX) { + Socket::pack_sockaddr_un $_[0] } else { Carp::croak "pack_sockaddr: invalid host"; } } -=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa +=item ($service, $host) = AnyEvent::Socket::unpack_sockaddr $sa Unpack the given binary sockaddr structure (as used by bind, getpeername -etc.) into a C<$port, $host> combination. +etc.) into a C<$service, $host> combination. + +For IPv4 and IPv6, C<$service> is the port number and C<$host> the host +address in network format (binary). -Handles both IPv4 and IPv6 sockaddr structures. +For UNIX domain sockets, C<$service> is the absolute pathname and C<$host> +is a special token that is understood by the other functions in this +module (C converts it to C). =cut sub unpack_sockaddr($) { - my $af = unpack "S", $_[0]; + my $af = Socket::sockaddr_family $_[0]; if ($af == AF_INET) { Socket::unpack_sockaddr_in $_[0] } elsif ($af == AF_INET6) { unpack "x2 n x4 a16", $_[0] + } elsif ($af == AF_UNIX) { + ((Socket::unpack_sockaddr_un $_[0]), pack "S", AF_UNIX) } else { Carp::croak "unpack_sockaddr: unsupported protocol family $af"; } } -sub _tcp_port($) { - $_[0] =~ /^(\d*)$/ and return $1*1; +=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...) - (getservbyname $_[0], "tcp")[2] - or Carp::croak "$_[0]: service unknown" +Tries to resolve the given nodename and service name into protocol families +and sockaddr structures usable to connect to this node and service in a +protocol-independent way. It works remotely similar to the getaddrinfo +posix function. + +For internet addresses, C<$node> is either an IPv4 or IPv6 address or an +internet hostname, and C<$service> is either a service name (port name +from F) or a numerical port number. If both C<$node> and +C<$service> are names, then SRV records will be consulted to find the real +service, otherwise they will be used as-is. If you know that the service +name is not in your services database, then you can specify the service in +the format C (e.g. C). + +For UNIX domain sockets, C<$node> must be the string C and +C<$service> must be the absolute pathname of the socket. In this case, +C<$proto> will be ignored. + +C<$proto> must be a protocol name, currently C, C or +C. The default is currently C, but in the future, this function +might try to use other protocols such as C, depending on the socket +type and any SRV records it might find. + +C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use +only IPv4) or C<6> (use only IPv6). This setting might be influenced by +C<$ENV{PERL_ANYEVENT_PROTOCOLS}>. + +C<$type> must be C, C or C (or +C in which case it gets automatically chosen). + +The callback will receive zero or more array references that contain +C<$family, $type, $proto> for use in C and a binary +C<$sockaddr> for use in C (or C). + +The application should try these in the order given. + +Example: + + resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... }; + +=cut + +# microsoft can't even get getprotobyname working (the etc/protocols file +# gets lost fairly often on windows), so we have to hardcode some common +# protocol numbers ourselves. +our %PROTO_BYNAME; + +$PROTO_BYNAME{tcp} = &Socket::IPPROTO_TCP if defined &Socket::IPPROTO_TCP; +$PROTO_BYNAME{udp} = &Socket::IPPROTO_UDP if defined &Socket::IPPROTO_UDP; +$PROTO_BYNAME{icmp} = &Socket::IPPROTO_ICMP if defined &Socket::IPPROTO_ICMP; + +sub resolve_sockaddr($$$$$$) { + my ($node, $service, $proto, $family, $type, $cb) = @_; + + if ($node eq "unix/") { + return $cb->() if $family || !/^\//; # no can do + + return $cb->([AF_UNIX, $type, 0, Socket::pack_sockaddr_un $service]); + } + + unless (AF_INET6) { + $family != 6 + or return $cb->(); + + $family = 4; + } + + $cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4}; + $cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6}; + + $family ||= 4 unless $AnyEvent::PROTOCOL{ipv6}; + $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4}; + + $proto ||= "tcp"; + $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM; + + my $proton = $PROTO_BYNAME{lc $proto} || (getprotobyname $proto)[2] + or Carp::croak "$proto: protocol unknown"; + + my $port; + + if ($service =~ /^(\S+)=(\d+)$/) { + ($service, $port) = ($1, $2); + } elsif ($service =~ /^\d+$/) { + ($service, $port) = (undef, $service); + } else { + $port = (getservbyname $service, $proto)[2] + or Carp::croak "$service/$proto: service unknown"; + } + + my @target = [$node, $port]; + + # resolve a records / provide sockaddr structures + my $resolve = sub { + my @res; + my $cv = AnyEvent->condvar (cb => sub { + $cb->( + map $_->[2], + sort { + $AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]} + or $a->[0] <=> $b->[0] + } + @res + ) + }); + + $cv->begin; + for my $idx (0 .. $#target) { + my ($node, $port) = @{ $target[$idx] }; + + if (my $noden = parse_address $node) { + my $af = address_family $noden; + + if ($af == AF_INET && $family != 6) { + push @res, [$idx, "ipv4", [AF_INET, $type, $proton, + pack_sockaddr $port, $noden]] + } + + if ($af == AF_INET6 && $family != 4) { + push @res, [$idx, "ipv6", [AF_INET6, $type, $proton, + pack_sockaddr $port, $noden]] + } + } else { + # ipv4 + if ($family != 6) { + $cv->begin; + AnyEvent::DNS::a $node, sub { + push @res, [$idx, "ipv4", [AF_INET, $type, $proton, + pack_sockaddr $port, parse_ipv4 $_]] + for @_; + $cv->end; + }; + } + + # ipv6 + if ($family != 4) { + $cv->begin; + AnyEvent::DNS::aaaa $node, sub { + push @res, [$idx, "ipv6", [AF_INET6, $type, $proton, + pack_sockaddr $port, parse_ipv6 $_]] + for @_; + $cv->end; + }; + } + } + } + $cv->end; + }; + + # try srv records, if applicable + if ($node eq "localhost") { + @target = (["127.0.0.1", $port], ["::1", $port]); + &$resolve; + } elsif (defined $service && !parse_address $node) { + AnyEvent::DNS::srv $service, $proto, $node, sub { + my (@srv) = @_; + + # no srv records, continue traditionally + @srv + or return &$resolve; + + # the only srv record has "." ("" here) => abort + $srv[0][2] ne "" || $#srv + or return $cb->(); + + # use srv records then + @target = map ["$_->[3].", $_->[2]], + grep $_->[3] ne ".", + @srv; + + &$resolve; + }; + } else { + &$resolve; + } } =item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb] This is a convenience function that creates a TCP socket and makes a 100% -non-blocking connect to the given C<$host> (which can be a hostname or a -textual IP address) and C<$service> (which can be a numeric port number or -a service name, or a C string). +non-blocking connect to the given C<$host> (which can be a hostname or +a textual IP address, or the string C for UNIX domain sockets) +and C<$service> (which can be a numeric port number or a service name, +or a C string, or the pathname to a UNIX domain +socket). If both C<$host> and C<$port> are names, then this function will use SRV records to locate the real target(s). @@ -315,11 +658,11 @@ Simple Example: connect to localhost on port 22. - tcp_connect localhost => 22, sub { - my $fh = shift - or die "unable to connect: $!"; - # do something - }; + tcp_connect localhost => 22, sub { + my $fh = shift + or die "unable to connect: $!"; + # do something + }; Complex Example: connect to www.google.com on port 80 and make a simple GET request without much error handling. Also limit the connection timeout @@ -359,17 +702,24 @@ 15 }; +Example: connect to a UNIX domain socket. + + tcp_connect "unix/", "/tmp/.X11-unix/X0", sub { + ... + } + =cut sub tcp_connect($$$;$) { my ($host, $port, $connect, $prepare) = @_; # see http://cr.yp.to/docs/connect.html for some background + # also http://advogato.org/article/672.html my %state = ( fh => undef ); - # name resolution - AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub { + # name/service to type/sockaddr resolution + resolve_sockaddr $host, $port, 0, 0, 0, sub { my @target = @_; $state{next} = sub { @@ -391,7 +741,7 @@ my $timeout = $prepare && $prepare->($state{fh}); - $timeout ||= 30 if WIN32; + $timeout ||= 30 if AnyEvent::WIN32; $state{to} = AnyEvent->timer (after => $timeout, cb => sub { $! = &Errno::ETIMEDOUT; @@ -412,7 +762,7 @@ %state = (); }; - $connect->($state{fh}, format_ip $host, $port, sub { + $connect->($state{fh}, format_address $host, $port, sub { $guard->cancel; $state{next}(); }); @@ -426,11 +776,14 @@ # now connect if (connect $state{fh}, $sockaddr) { $connected->(); - } elsif ($! == &Errno::EINPROGRESS || $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX + } elsif ($! == &Errno::EINPROGRESS # POSIX + || $! == &Errno::EWOULDBLOCK + # WSAEINPROGRESS intentionally not checked - it means something else entirely + || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt + || $! == AnyEvent::Util::WSAEWOULDBLOCK) { $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected); } else { - %state = (); - $connect->(); + $state{next}(); } }; @@ -441,22 +794,29 @@ defined wantarray && guard { %state = () } } -=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb] - -Create and bind a TCP socket to the given host, and port, set the -SO_REUSEADDR flag and call C. +=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb] -C<$host> must be an IPv4 or IPv6 address (or C, in which case it -binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the -preferred protocol). +Create and bind a stream socket to the given host, and port, set the +SO_REUSEADDR flag (if applicable) and call C. Unlike the name +implies, this function can also bind on UNIX domain sockets. + +For internet sockets, C<$host> must be an IPv4 or IPv6 address (or +C, in which case it binds either to C<0> or to C<::>, depending +on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in +future versions, as applicable). To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6 wildcard address, use C<::>. -The port is specified by C<$port>, which must be either a service name or +The port is specified by C<$service>, which must be either a service name or a numeric port number (or C<0> or C, in which case an ephemeral port will be used). +For UNIX domain sockets, C<$host> must be C and C<$service> must be +the absolute pathname of the socket. This function will try to C +the socket before it tries to bind to it. See SECURITY CONSIDERATIONS, +below. + For each new connection that could be Ced, call the C<< $accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking mode) as first and the peer host and port as second and third arguments @@ -477,6 +837,13 @@ It should return the length of the listen queue (or C<0> for the default). +Note to IPv6 users: RFC-compliant behaviour for IPv6 sockets listening on +C<::> is to bind to both IPv6 and IPv4 addresses by default on dual-stack +hosts. Unfortunately, only GNU/Linux seems to implement this properly, so +if you want both IPv4 and IPv6 listening sockets you should create the +IPv6 socket first and then attempt to bind on the IPv4 socket, but ignore +any C errors. + Example: bind on some TCP port on the local machine and tell each client to go away. @@ -492,26 +859,40 @@ =cut sub tcp_server($$$;$) { - my ($host, $port, $accept, $prepare) = @_; + my ($host, $service, $accept, $prepare) = @_; $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6 ? "::" : "0" unless defined $host; - my $ipn = parse_ip $host - or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address"; + my $ipn = parse_address $host + or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address"; - my $domain = 4 == length $ipn ? AF_INET : AF_INET6; + my $af = address_family $ipn; my %state; - socket $state{fh}, $domain, SOCK_STREAM, 0 - or Carp::croak "socket: $!"; - - setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1 - or Carp::croak "so_reuseaddr: $!"; + # win32 perl is too stupid to get this right :/ + Carp::croak "tcp_server/socket: address family not supported" + if AnyEvent::WIN32 && $af == AF_UNIX; + + socket $state{fh}, $af, SOCK_STREAM, 0 + or Carp::croak "tcp_server/socket: $!"; + + if ($af == AF_INET || $af == AF_INET6) { + setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1 + or Carp::croak "tcp_server/so_reuseaddr: $!" + unless AnyEvent::WIN32; # work around windows bug + + unless ($service =~ /^\d*$/) { + $service = (getservbyname $service, "tcp")[2] + or Carp::croak "$service: service unknown" + } + } elsif ($af == AF_UNIX) { + unlink $service; + } - bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn + bind $state{fh}, pack_sockaddr $service, $ipn or Carp::croak "bind: $!"; fh_nonblocking $state{fh}, 1; @@ -519,8 +900,8 @@ my $len; if ($prepare) { - my ($port, $host) = unpack_sockaddr getsockname $state{fh}; - $len = $prepare && $prepare->($state{fh}, format_ip $host, $port); + my ($service, $host) = unpack_sockaddr getsockname $state{fh}; + $len = $prepare && $prepare->($state{fh}, format_address $host, $service); } $len ||= 128; @@ -532,8 +913,9 @@ # this closure keeps $state alive while (my $peer = accept my $fh, $state{fh}) { fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not - my ($port, $host) = unpack_sockaddr $peer; - $accept->($fh, format_ip $host, $port); + + my ($service, $host) = unpack_sockaddr $peer; + $accept->($fh, format_address $host, $service); } }); @@ -546,6 +928,15 @@ =back +=head1 SECURITY CONSIDERATIONS + +This module is quite powerful, with with power comes the ability to abuse +as well: If you accept "hostnames" and ports from untrusted sources, +then note that this can be abused to delete files (host=C). This +is not really a problem with this module, however, as blindly accepting +any address and protocol and trying to bind a server or connect to it is +harmful in general. + =head1 AUTHOR Marc Lehmann