Index: Fan/FTP/FTP.pm =================================================================== RCS file: /usr/home/ume/ncvs/src/ftpmirror/Fan/FTP/FTP.pm,v retrieving revision 1.1.1.2 retrieving revision 1.6 diff -u -r1.1.1.2 -r1.6 --- Fan/FTP/FTP.pm 2000/03/03 07:35:58 1.1.1.2 +++ Fan/FTP/FTP.pm 2000/03/09 13:32:04 1.6 @@ -60,6 +60,9 @@ use Carp; use Socket; +BEGIN { + eval 'use Socket6' unless (eval '&AF_INET6'); # IPv6 patched Perl +} use Fan::TCP; use AutoLoader 'AUTOLOAD'; @@ -390,7 +393,7 @@ $self->clearerror || return undef; $self->cleardataconn; # always success - my($port, $addr) = $self->sockname; + my ($port, $addr, $family) = $self->sockname; my $acpt = Fan::TCP->new(); unless (defined($acpt)) { @@ -398,20 +401,28 @@ return undef; } - unless ($acpt->do_server(tcp_bindaddr => $addr)) { + unless ($acpt->do_server(tcp_family => $family, + tcp_bindaddr => $addr)) { warn("Fan::TCP->do_server failed"); return undef; } - ($port, $addr) = $acpt->sockname; - unless ($addr =~ tr/./,/ == 3) { - warn("ADDRESS=$addr must have just 3 dots"); - return undef; + ($port, $addr, $family) = $acpt->sockname; + my $command; + if ($family == AF_INET) { + unless ($addr =~ tr/./,/ == 3) { + warn("ADDRESS=$addr must have just 3 dots"); + return undef; + } + $addr .= sprintf(",%d,%d", ($port >> 8) & 0xff, $port & 0xff); + $command = 'PORT'; + } else { + $addr = "|2|$addr|$port|"; + $command = 'EPRT'; } - $addr .= sprintf(",%d,%d", ($port >> 8) & 0xff, $port & 0xff); - unless ($self->putreq("PORT $addr") =~ /^2/) { - warn("PORT command failed\n") if $LOG > 5; + unless ($self->putreq("$command $addr") =~ /^2/) { + warn("$command command failed\n") if $LOG > 5; $self->error($self->{lastmesg}); return undef; } @@ -437,12 +448,20 @@ ;# sub pasv ($) { my $self = shift; - my $a_regexp = '\((\d+),(\d+),(\d+),(\d+),(\d+),(\d+)\)'; $self->clearerror && $self->cleardataconn || return undef; - if ($self->putreq("PASV") !~ /^2/) { + my $family = ($self->sockname)[2]; + my ($a_regexp, $command); + if ($family == AF_INET) { + $a_regexp = '\((\d+),(\d+),(\d+),(\d+),(\d+),(\d+)\)'; + $command = 'PASV'; + } else { + $a_regexp = '\([^\d\s]{3}(\d+)[^\d\s]\)'; + $command = 'EPSV'; + } + if ($self->putreq($command) !~ /^2/) { $self->error($self->{lastmesg}); return undef; } @@ -452,11 +471,18 @@ } my $bindaddr = $self->{ftp_bindaddr}; - my $port = $5 * 256 + $6; - my $addr = join('.', $1, $2, $3, $4); + my ($port, $addr); + if ($family == AF_INET) { + $port = $5 * 256 + $6; + $addr = join('.', $1, $2, $3, $4); + } else { + $port = $1; + $addr = ($self->peername)[1]; + } my $data = Fan::TCP->new(); $data && $data->do_client( + tcp_family => $family, tcp_bindaddr => $bindaddr, tcp_host => $addr, tcp_port => $port Index: Fan/TCP/TCP.pm =================================================================== RCS file: /usr/home/ume/ncvs/src/ftpmirror/Fan/TCP/TCP.pm,v retrieving revision 1.1.1.1 retrieving revision 1.12 diff -u -r1.1.1.1 -r1.12 --- Fan/TCP/TCP.pm 1999/10/24 10:28:15 1.1.1.1 +++ Fan/TCP/TCP.pm 2000/03/09 13:32:06 1.12 @@ -35,15 +35,16 @@ package Fan::TCP; use strict; -use vars qw($VERSION $LOG - $tcp_proto $seq_id $sent_octets $recv_octets); +use vars qw($VERSION $LOG $seq_id $sent_octets $recv_octets); use Carp; use Socket; +BEGIN { + eval 'use Socket6' unless (eval '&AF_INET6'); # IPv6 patched Perl +} use AutoLoader 'AUTOLOAD'; $VERSION = '0.03'; -$tcp_proto = (getprotobyname('tcp'))[2]; ;# BEGIN { @@ -463,27 +464,21 @@ # check local side port #. my $port = $params{tcp_bindport} || $self->{tcp_bindport} || 0; - if ($port !~ /^\d+$/) { - if (!defined($port = getservbyname($port, 'tcp'))) { - my $e = $!.''; - $self->error($e, &FATAL); - carp("$self: getservbyname($port) - $e"); - return undef; - } - } # define local side address if bindaddr is not null string. - my $addr = inet_aton( - $params{tcp_bindaddr} || $self->{tcp_bindaddr} || '0.0.0.0'); - - # parameter for bind. - my $me = sockaddr_in($port, $addr); + my $family = $params{tcp_family} ? $params{tcp_family} : AF_INET; + my $tcp_bindaddr = $params{tcp_bindaddr} || $self->{tcp_bindaddr} || + (($family == AF_INET) ? '0.0.0.0' : '::'); + + my ($socktype, $proto, $me, $canonname); + ($family, $socktype, $proto, $me, $canonname) + = getaddrinfo($tcp_bindaddr, $port, $family, SOCK_STREAM); # local file handle... local *SOCKET; # creating a stream socket. - unless (socket(SOCKET, PF_INET, SOCK_STREAM, $tcp_proto)) { + unless (socket(SOCKET, $family, $socktype, $proto)) { my $e = $!.''; $self->error($e, &FATAL); carp("$self: socket - $e") if $LOG >= 5; @@ -539,41 +534,27 @@ return undef; } - # try to parse port number - if ($port !~ /^\d+$/) { - if (!defined($port = getservbyname($port, 'tcp'))) { - my $e = $!.''; - $self->error($e, &FATAL); - carp("$self: getservbyname($port) - $e"); - return undef; - } - } - - # check server name - my @addr; - if ($host =~ /^(\d+)\.(\d+)\.(\d+).(\d+)$/) { - @addr = (pack('C4', $1, $2, $3, $4)); - } else { - if ((@addr = gethostbyname($host)) < 5) { - carp("$self: gethostbyname - $?"); - my $e = $?.''; - $self->error($e, &FATAL); - carp("$self: gethostbyname - $e"); - return undef; - } - splice(@addr, 0, 4); + # check server name and try to parse port number + my @infos = getaddrinfo($host, $port, AF_UNSPEC, SOCK_STREAM); + if ($#infos < 1) { + carp("$self: getaddrinfo($host, $port) - $?"); + my $e = $?.''; + $self->error($e, &FATAL); + carp("$self: getaddrinfo($host, $port) - $e"); + return undef; } # Perl's bug? once connect fails, we could not any more # connect (connect returns "Invalid Argument"). So we # create/close a socket in each iteration. - for my $i (@addr) { + while ($#infos >= 1) { + my ($family, $socktype, $proto, $peer, $canonname) + = splice(@infos, 0, 5); # open socket stores any error + $params{tcp_family} = $family; $self->open_socket(%params) || return undef; - # target address. - my $peer = sockaddr_in($port, $i); my $result = undef; # do real work. @@ -758,10 +739,13 @@ my $sock = $self->handle; if (defined($sock)) { - my($port, $a) = sockaddr_in(getsockname($sock)); - my $addr = join('.', unpack('C4', $a)); -carp("$self sockname=$addr:$port") if $LOG > 7; - return wantarray ? ($port, $addr) : "$addr:$port"; + my $sa = getsockname($sock); + my $family = (unpack('CC', $sa))[1]; + my ($addr, $port) = getnameinfo($sa, NI_NUMERICHOST | + NI_NUMERICSERV); + carp("$self sockname=$addr|$port|$family") if $LOG > 7; + return wantarray ? ($port, $addr, $family) + : "$addr|$port|$family"; } return wantarray ? () : undef; } @@ -772,10 +756,13 @@ my $sock = $self->handle; if (defined($sock)) { - my($port, $a) = sockaddr_in(getpeername($sock)); - my $addr = join('.', unpack('C4', $a)); -carp("$self sockpeer=$addr:$port") if $LOG > 7; - return wantarray ? ($port, $addr) : "$addr:$port"; + my $sa = getpeername($sock); + my $family = (unpack('CC', $sa))[1]; + my ($addr, $port) = getnameinfo($sa, NI_NUMERICHOST | + NI_NUMERICSERV); + carp("$self sockpeer=$addr|$port|$family") if $LOG > 7; + return wantarray ? ($port, $addr, $family) + : "$addr|$port|$family"; } return wantarray ? () : undef; }