1Index: Fan/FTP/FTP.pm 2=================================================================== 3RCS file: /usr/home/ume/ncvs/src/ftpmirror/Fan/FTP/FTP.pm,v 4retrieving revision 1.1.1.2 5retrieving revision 1.6 6diff -u -r1.1.1.2 -r1.6 7--- Fan/FTP/FTP.pm 2000/03/03 07:35:58 1.1.1.2 8+++ Fan/FTP/FTP.pm 2000/03/09 13:32:04 1.6 9@@ -60,6 +60,9 @@ 10 11 use Carp; 12 use Socket; 13+BEGIN { 14+ eval 'use Socket6' unless (eval '&AF_INET6'); # IPv6 patched Perl 15+} 16 use Fan::TCP; 17 use AutoLoader 'AUTOLOAD'; 18 19@@ -390,7 +393,7 @@ 20 $self->clearerror || return undef; 21 $self->cleardataconn; # always success 22 23- my($port, $addr) = $self->sockname; 24+ my ($port, $addr, $family) = $self->sockname; 25 26 my $acpt = Fan::TCP->new(); 27 unless (defined($acpt)) { 28@@ -398,20 +401,28 @@ 29 return undef; 30 } 31 32- unless ($acpt->do_server(tcp_bindaddr => $addr)) { 33+ unless ($acpt->do_server(tcp_family => $family, 34+ tcp_bindaddr => $addr)) { 35 warn("Fan::TCP->do_server failed"); 36 return undef; 37 } 38 39- ($port, $addr) = $acpt->sockname; 40- unless ($addr =~ tr/./,/ == 3) { 41- warn("ADDRESS=$addr must have just 3 dots"); 42- return undef; 43+ ($port, $addr, $family) = $acpt->sockname; 44+ my $command; 45+ if ($family == AF_INET) { 46+ unless ($addr =~ tr/./,/ == 3) { 47+ warn("ADDRESS=$addr must have just 3 dots"); 48+ return undef; 49+ } 50+ $addr .= sprintf(",%d,%d", ($port >> 8) & 0xff, $port & 0xff); 51+ $command = 'PORT'; 52+ } else { 53+ $addr = "|2|$addr|$port|"; 54+ $command = 'EPRT'; 55 } 56- $addr .= sprintf(",%d,%d", ($port >> 8) & 0xff, $port & 0xff); 57 58- unless ($self->putreq("PORT $addr") =~ /^2/) { 59- warn("PORT command failed\n") if $LOG > 5; 60+ unless ($self->putreq("$command $addr") =~ /^2/) { 61+ warn("$command command failed\n") if $LOG > 5; 62 $self->error($self->{lastmesg}); 63 return undef; 64 } 65@@ -437,12 +448,20 @@ 66 ;# 67 sub pasv ($) { 68 my $self = shift; 69- my $a_regexp = '\((\d+),(\d+),(\d+),(\d+),(\d+),(\d+)\)'; 70 71 $self->clearerror && 72 $self->cleardataconn || return undef; 73 74- if ($self->putreq("PASV") !~ /^2/) { 75+ my $family = ($self->sockname)[2]; 76+ my ($a_regexp, $command); 77+ if ($family == AF_INET) { 78+ $a_regexp = '\((\d+),(\d+),(\d+),(\d+),(\d+),(\d+)\)'; 79+ $command = 'PASV'; 80+ } else { 81+ $a_regexp = '\([^\d\s]{3}(\d+)[^\d\s]\)'; 82+ $command = 'EPSV'; 83+ } 84+ if ($self->putreq($command) !~ /^2/) { 85 $self->error($self->{lastmesg}); 86 return undef; 87 } 88@@ -452,11 +471,18 @@ 89 } 90 91 my $bindaddr = $self->{ftp_bindaddr}; 92- my $port = $5 * 256 + $6; 93- my $addr = join('.', $1, $2, $3, $4); 94+ my ($port, $addr); 95+ if ($family == AF_INET) { 96+ $port = $5 * 256 + $6; 97+ $addr = join('.', $1, $2, $3, $4); 98+ } else { 99+ $port = $1; 100+ $addr = ($self->peername)[1]; 101+ } 102 my $data = Fan::TCP->new(); 103 104 $data && $data->do_client( 105+ tcp_family => $family, 106 tcp_bindaddr => $bindaddr, 107 tcp_host => $addr, 108 tcp_port => $port 109Index: Fan/TCP/TCP.pm 110=================================================================== 111RCS file: /usr/home/ume/ncvs/src/ftpmirror/Fan/TCP/TCP.pm,v 112retrieving revision 1.1.1.1 113retrieving revision 1.12 114diff -u -r1.1.1.1 -r1.12 115--- Fan/TCP/TCP.pm 1999/10/24 10:28:15 1.1.1.1 116+++ Fan/TCP/TCP.pm 2000/03/09 13:32:06 1.12 117@@ -35,15 +35,16 @@ 118 package Fan::TCP; 119 120 use strict; 121-use vars qw($VERSION $LOG 122- $tcp_proto $seq_id $sent_octets $recv_octets); 123+use vars qw($VERSION $LOG $seq_id $sent_octets $recv_octets); 124 125 use Carp; 126 use Socket; 127+BEGIN { 128+ eval 'use Socket6' unless (eval '&AF_INET6'); # IPv6 patched Perl 129+} 130 use AutoLoader 'AUTOLOAD'; 131 132 $VERSION = '0.03'; 133-$tcp_proto = (getprotobyname('tcp'))[2]; 134 135 ;# 136 BEGIN { 137@@ -463,27 +464,21 @@ 138 139 # check local side port #. 140 my $port = $params{tcp_bindport} || $self->{tcp_bindport} || 0; 141- if ($port !~ /^\d+$/) { 142- if (!defined($port = getservbyname($port, 'tcp'))) { 143- my $e = $!.''; 144- $self->error($e, &FATAL); 145- carp("$self: getservbyname($port) - $e"); 146- return undef; 147- } 148- } 149 150 # define local side address if bindaddr is not null string. 151- my $addr = inet_aton( 152- $params{tcp_bindaddr} || $self->{tcp_bindaddr} || '0.0.0.0'); 153- 154- # parameter for bind. 155- my $me = sockaddr_in($port, $addr); 156+ my $family = $params{tcp_family} ? $params{tcp_family} : AF_INET; 157+ my $tcp_bindaddr = $params{tcp_bindaddr} || $self->{tcp_bindaddr} || 158+ (($family == AF_INET) ? '0.0.0.0' : '::'); 159+ 160+ my ($socktype, $proto, $me, $canonname); 161+ ($family, $socktype, $proto, $me, $canonname) 162+ = getaddrinfo($tcp_bindaddr, $port, $family, SOCK_STREAM); 163 164 # local file handle... 165 local *SOCKET; 166 167 # creating a stream socket. 168- unless (socket(SOCKET, PF_INET, SOCK_STREAM, $tcp_proto)) { 169+ unless (socket(SOCKET, $family, $socktype, $proto)) { 170 my $e = $!.''; 171 $self->error($e, &FATAL); 172 carp("$self: socket - $e") if $LOG >= 5; 173@@ -539,41 +534,27 @@ 174 return undef; 175 } 176 177- # try to parse port number 178- if ($port !~ /^\d+$/) { 179- if (!defined($port = getservbyname($port, 'tcp'))) { 180- my $e = $!.''; 181- $self->error($e, &FATAL); 182- carp("$self: getservbyname($port) - $e"); 183- return undef; 184- } 185- } 186- 187- # check server name 188- my @addr; 189- if ($host =~ /^(\d+)\.(\d+)\.(\d+).(\d+)$/) { 190- @addr = (pack('C4', $1, $2, $3, $4)); 191- } else { 192- if ((@addr = gethostbyname($host)) < 5) { 193- carp("$self: gethostbyname - $?"); 194- my $e = $?.''; 195- $self->error($e, &FATAL); 196- carp("$self: gethostbyname - $e"); 197- return undef; 198- } 199- splice(@addr, 0, 4); 200+ # check server name and try to parse port number 201+ my @infos = getaddrinfo($host, $port, AF_UNSPEC, SOCK_STREAM); 202+ if ($#infos < 1) { 203+ carp("$self: getaddrinfo($host, $port) - $?"); 204+ my $e = $?.''; 205+ $self->error($e, &FATAL); 206+ carp("$self: getaddrinfo($host, $port) - $e"); 207+ return undef; 208 } 209 210 # Perl's bug? once connect fails, we could not any more 211 # connect (connect returns "Invalid Argument"). So we 212 # create/close a socket in each iteration. 213- for my $i (@addr) { 214+ while ($#infos >= 1) { 215+ my ($family, $socktype, $proto, $peer, $canonname) 216+ = splice(@infos, 0, 5); 217 218 # open socket stores any error 219+ $params{tcp_family} = $family; 220 $self->open_socket(%params) || return undef; 221 222- # target address. 223- my $peer = sockaddr_in($port, $i); 224 my $result = undef; 225 226 # do real work. 227@@ -758,10 +739,13 @@ 228 my $sock = $self->handle; 229 230 if (defined($sock)) { 231- my($port, $a) = sockaddr_in(getsockname($sock)); 232- my $addr = join('.', unpack('C4', $a)); 233-carp("$self sockname=$addr:$port") if $LOG > 7; 234- return wantarray ? ($port, $addr) : "$addr:$port"; 235+ my $sa = getsockname($sock); 236+ my $family = (unpack('CC', $sa))[1]; 237+ my ($addr, $port) = getnameinfo($sa, NI_NUMERICHOST | 238+ NI_NUMERICSERV); 239+ carp("$self sockname=$addr|$port|$family") if $LOG > 7; 240+ return wantarray ? ($port, $addr, $family) 241+ : "$addr|$port|$family"; 242 } 243 return wantarray ? () : undef; 244 } 245@@ -772,10 +756,13 @@ 246 my $sock = $self->handle; 247 248 if (defined($sock)) { 249- my($port, $a) = sockaddr_in(getpeername($sock)); 250- my $addr = join('.', unpack('C4', $a)); 251-carp("$self sockpeer=$addr:$port") if $LOG > 7; 252- return wantarray ? ($port, $addr) : "$addr:$port"; 253+ my $sa = getpeername($sock); 254+ my $family = (unpack('CC', $sa))[1]; 255+ my ($addr, $port) = getnameinfo($sa, NI_NUMERICHOST | 256+ NI_NUMERICSERV); 257+ carp("$self sockpeer=$addr|$port|$family") if $LOG > 7; 258+ return wantarray ? ($port, $addr, $family) 259+ : "$addr|$port|$family"; 260 } 261 return wantarray ? () : undef; 262 } 263