1 2package Net::SSLGlue::FTP; 3 4use strict; 5use warnings; 6use Carp 'croak'; 7use IO::Socket::SSL '$SSL_ERROR'; 8use Net::SSLGlue::Socket; 9use Socket 'AF_INET'; 10 11our $VERSION = 1.002; 12 13BEGIN { 14 require Net::FTP; 15 if (defined &Net::FTP::starttls) { 16 warn "using SSL support of Net::FTP $Net::FTP::VERSION instead of SSLGlue"; 17 goto DONE; 18 } 19 20 $Net::FTP::VERSION eq '2.77' 21 or warn "Not tested with Net::FTP version $Net::FTP::VERSION"; 22 23 require Net::FTP::dataconn; 24 for my $class (qw(Net::FTP Net::FTP::dataconn)) { 25 no strict 'refs'; 26 my $fixed; 27 for( @{ "${class}::ISA" } ) { 28 $_ eq 'IO::Socket::INET' or next; 29 $_ = 'Net::SSLGlue::Socket'; 30 $fixed = 1; 31 last; 32 } 33 die "cannot replace IO::Socket::INET with Net::SSLGlue::Socket in ${class}::ISA" 34 if ! $fixed; 35 } 36 37 # redefine Net::FTP::new so that it understands SSL => 1 and connects directly 38 # with SSL to the server 39 no warnings 'redefine'; 40 my $onew = Net::FTP->can('new'); 41 *Net::FTP::new = sub { 42 my $class = shift; 43 my %args = @_%2 ? ( Host => shift(), @_ ): @_; 44 my %sslargs = map { $_ => delete $args{$_} } 45 grep { m{^SSL_} } keys %args; 46 47 my $self; 48 if ( $args{SSL} ) { 49 # go immediatly to SSL 50 # Net::FTP::new gives only specific args to socket class 51 $args{Port} ||= 990; 52 local %Net::SSLGlue::Socket::ARGS = ( SSL => 1, %sslargs ); 53 $self = $onew->($class,%args) or return; 54 ${*$self}{net_ftp_tlstype} = 'P'; 55 } else { 56 $self = $onew->($class,%args) or return; 57 } 58 ${*$self}{net_ftp_tlsargs} = \%sslargs; 59 return $self; 60 }; 61 62 # add starttls method to upgrade connection to SSL: AUTH TLS 63 *Net::FTP::starttls = sub { 64 my $self = shift; 65 $self->is_ssl and croak("called starttls within SSL session"); 66 $self->_AUTH('TLS') == &Net::FTP::CMD_OK or return; 67 68 my $host = $self->host; 69 # for name verification strip port from domain:port, ipv4:port, [ipv6]:port 70 $host =~s{(?<!:):\d+$}{}; 71 72 my %args = ( 73 SSL_verify_mode => 1, 74 SSL_verifycn_scheme => 'ftp', 75 SSL_verifycn_name => $host, 76 # reuse SSL session of control connection in data connections 77 SSL_session_cache => Net::SSLGlue::FTP::SingleSessionCache->new, 78 %{ ${*$self}{net_ftp_tlsargs}}, 79 @_ 80 ); 81 82 $self->start_SSL(%args) or return; 83 ${*$self}{net_ftp_tlsargs} = \%args; 84 $self->prot('P'); 85 return 1; 86 }; 87 88 # add prot method to set protection level (PROT C|P) 89 *Net::FTP::prot = sub { 90 my ($self,$type) = @_; 91 $type eq 'C' or $type eq 'P' or croak("type must by C or P"); 92 $self->_PBSZ(0) or return; 93 $self->_PROT($type) or return; 94 ${*$self}{net_ftp_tlstype} = $type; 95 return 1; 96 }; 97 98 # add stoptls method to downgrade connection from SSL: CCC 99 *Net::FTP::stoptls = sub { 100 my $self = shift; 101 $self->is_ssl or croak("called stoptls outside SSL session"); 102 $self->_CCC() or return; 103 $self->stop_SSL(); 104 return 1; 105 }; 106 107 # add EPSV for new style passive mode (incl. IPv6) 108 *Net::FTP::epsv = sub { 109 my $self = shift; 110 @_ and croak 'usage: $ftp->epsv()'; 111 delete ${*$self}{net_ftp_intern_port}; 112 113 $self->_EPSV && $self->message =~ m{\(([\x33-\x7e])\1\1(\d+)\1\)} 114 ? ${*$self}{'net_ftp_pasv'} = [ $self->peerhost, $2 ] 115 : undef; 116 }; 117 118 # redefine PASV so that it uses EPSV on IPv6 119 # also net_ftp_pasv contains now the parsed [ip,port] 120 *Net::FTP::pasv = sub { 121 my $self = shift; 122 @_ and croak 'usage: $ftp->port()'; 123 return $self->epsv if $self->sockdomain != AF_INET; 124 delete ${*$self}{net_ftp_intern_port}; 125 126 if ( $self->_PASV && 127 $self->message =~ m{(\d+,\d+,\d+,\d+),(\d+),(\d+)} ) { 128 my $port = 256 * $2 + $3; 129 ( my $ip = $1 ) =~s{,}{.}g; 130 return ${*$self}{'net_ftp_pasv'} = [ $ip,$port ]; 131 } 132 return; 133 }; 134 135 # add EPRT for new style passive mode (incl. IPv6) 136 *Net::FTP::eprt = sub { 137 @_ == 1 || @_ == 2 or croak 'usage: $self->eprt([PORT])'; 138 return _eprt('EPRT',@_); 139 }; 140 141 # redefine PORT to use EPRT for IPv6 142 *Net::FTP::port = sub { 143 @_ == 1 || @_ == 2 or croak 'usage: $self->port([PORT])'; 144 return _eprt('PORT',@_); 145 }; 146 147 sub _eprt { 148 my ($cmd,$self,$port) = @_; 149 delete ${*$self}{net_ftp_intern_port}; 150 unless ($port) { 151 my $listen = ${*$self}{net_ftp_listen} ||= Net::SSLGlue::Socket->new( 152 Listen => 1, 153 Timeout => $self->timeout, 154 LocalAddr => $self->sockhost, 155 ); 156 ${*$self}{net_ftp_intern_port} = 1; 157 my $fam = ($listen->sockdomain == AF_INET) ? 1:2; 158 if ( $cmd eq 'EPRT' || $fam == 2 ) { 159 $port = "|$fam|".$listen->sockhost."|".$listen->sockport."|"; 160 $cmd = 'EPRT'; 161 } else { 162 my $p = $listen->sockport; 163 $port = join(',',split(m{\.},$listen->sockhost),$p >> 8,$p & 0xff); 164 } 165 } 166 my $ok = $cmd eq 'EPRT' ? $self->_EPRT($port) : $self->_PORT($port); 167 ${*$self}{net_ftp_port} = $port if $ok; 168 return $ok; 169 } 170 171 172 173 for my $cmd (qw(PBSZ PROT CCC EPRT EPSV)) { 174 no strict 'refs'; 175 *{"Net::FTP::_$cmd"} = sub { 176 shift->command("$cmd @_")->response() == &Net::FTP::CMD_OK 177 } 178 } 179 180 181 # redefine _dataconn to 182 # - support IPv6 183 # - upgrade data connection to SSL if PROT P 184 *Net::FTP::_dataconn = sub { 185 my $self = shift; 186 my $pkg = "Net::FTP::" . $self->type; 187 eval "require $pkg"; 188 $pkg =~ s/ /_/g; 189 delete ${*$self}{net_ftp_dataconn}; 190 191 my $conn; 192 if ( my $pasv = ${*$self}{net_ftp_pasv} ) { 193 $conn = $pkg->new( 194 PeerAddr => $pasv->[0], 195 PeerPort => $pasv->[1], 196 LocalAddr => ${*$self}{net_ftp_localaddr}, 197 ) or return; 198 } elsif (my $listen = delete ${*$self}{net_ftp_listen}) { 199 $conn = $listen->accept($pkg) or return; 200 close($listen); 201 } 202 203 if (( ${*$self}{net_ftp_tlstype} || '') eq 'P' 204 && ! $conn->start_SSL( $self->is_ssl ? ( 205 SSL_reuse_ctx => $self, 206 SSL_verifycn_name => ${*$self}{net_ftp_tlsargs}->{SSL_verifycn_name} 207 ):( 208 %{${*$self}{net_ftp_tlsargs}} 209 ) 210 )) { 211 croak("failed to ssl upgrade dataconn: $SSL_ERROR"); 212 return; 213 } 214 215 $conn->timeout($self->timeout); 216 ${*$self}{net_ftp_dataconn} = $conn; 217 ${*$conn} = ""; 218 ${*$conn}{net_ftp_cmd} = $self; 219 ${*$conn}{net_ftp_blksize} = ${*$self}{net_ftp_blksize}; 220 return $conn; 221 }; 222 223 DONE: 224 1; 225} 226 227{ 228 # Session Cache with single entry 229 # used to make sure that we reuse same session for control channel and data 230 package Net::SSLGlue::FTP::SingleSessionCache; 231 sub new { my $x; return bless \$x,shift } 232 sub add_session { 233 my ($self,$key,$session) = @_; 234 Net::SSLeay::SESSION_free($$self) if $$self; 235 $$self = $session; 236 } 237 sub get_session { 238 my $self = shift; 239 return $$self 240 } 241 sub DESTROY { 242 my $self = shift; 243 Net::SSLeay::SESSION_free($$self) if $$self; 244 } 245} 246 2471; 248 249=head1 NAME 250 251Net::SSLGlue::FTP - extend Net::FTP for FTPS (SSL) and IPv6 252 253=head1 SYNOPSIS 254 255 use Net::SSLGlue::FTP; 256 # SSL right from start 257 my $ftps = Net::FTP->new( $host, 258 SSL => 1, 259 SSL_ca_path => ... 260 ); 261 262 # SSL through upgrade of plain connection 263 my $ftp = Net::FTP->new( $host ); 264 $ftp->starttls( SSL_ca_path => ... ); 265 266 # change protection mode to unencrypted|encrypted 267 $ftp->prot('C'); # clear 268 $ftp->prot('P'); # protected 269 270=head1 DESCRIPTION 271 272L<Net::SSLGlue::FTP> extends L<Net::FTP> so one can either start directly with 273SSL or switch later to SSL using starttls method (AUTH TLS command). 274If IO::Socket::IP or IO::Socket::INET6 are installed it will also transparently 275use IPv6. 276 277By default it will take care to verify the certificate according to the rules 278for FTP implemented in L<IO::Socket::SSL>. 279 280=head1 METHODS 281 282=over 4 283 284=item new 285 286The method C<new> of L<Net::FTP> is now able to start directly with SSL when 287the argument C<<SSL => 1>> is given. One can give the usual C<SSL_*> parameter 288of L<IO::Socket::SSL> to C<Net::FTP::new>. 289 290=item starttls 291 292If the connection is not yet SSLified it will issue the "AUTH TLS" command and 293change the object, so that SSL will now be used. 294 295=item peer_certificate ... 296 297Once the SSL connection is established you can use this method to get 298information about the certificate. See the L<IO::Socket::SSL> documentation. 299 300=back 301 302All of these methods can take the C<SSL_*> parameter from L<IO::Socket::SSL> to 303change the behavior of the SSL connection. The following parameters are 304especially useful: 305 306=over 4 307 308=item SSL_ca_path, SSL_ca_file 309 310Specifies the path or a file where the CAs used for checking the certificates 311are located. This is typically L</etc/ssl/certs> on UNIX systems. 312 313=item SSL_verify_mode 314 315If set to 0, verification of the certificate will be disabled. By default 316it is set to 1 which means that the peer certificate is checked. 317 318=item SSL_verifycn_name 319 320Usually the name given as the hostname in the constructor is used to verify the 321identity of the certificate. If you want to check the certificate against 322another name you can specify it with this parameter. 323 324=back 325 326=head1 SEE ALSO 327 328IO::Socket::SSL, Net::FTP, Net::SSLGlue::Socket 329 330=head1 COPYRIGHT 331 332This module is copyright (c) 2013, Steffen Ullrich. 333All Rights Reserved. 334This module is free software. It may be used, redistributed and/or modified 335under the same terms as Perl itself. 336