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