This file is indexed.

/usr/share/perl5/Net/SSLGlue/FTP.pm is in libnet-sslglue-perl 1.052-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
package Net::SSLGlue::FTP;

use strict;
use warnings;
use Carp 'croak';
use IO::Socket::SSL '$SSL_ERROR';
use Net::SSLGlue::Socket;
use Socket 'AF_INET';

our $VERSION = 1.001;

BEGIN {
    for my $class (qw(Net::FTP Net::FTP::dataconn)) {
	eval "require $class" or die "failed to load $class";
	no strict 'refs';
	my $fixed;
	for( @{ "${class}::ISA" } ) {
	    $_ eq 'IO::Socket::INET' or next;
	    $_ = 'Net::SSLGlue::Socket';
	    $fixed = 1;
	    last;
	}
	die "cannot replace IO::Socket::INET with Net::SSLGlue::Socket in ${class}::ISA"
	    if ! $fixed;
    }
    $Net::FTP::VERSION eq '2.77'
	or warn "Not tested with Net::FTP version $Net::FTP::VERSION";
}

# redefine Net::FTP::new so that it understands SSL => 1 and connects directly
# with SSL to the server
{
    no warnings 'redefine';
    my $onew = Net::FTP->can('new');
    *Net::FTP::new = sub {
	my $class = shift;
	my %args = @_%2 ? ( Host => shift(), @_ ): @_;
	my %sslargs = map { $_ => delete $args{$_} }
	    grep { m{^SSL_} } keys %args;

	my $self;
	if ( $args{SSL} ) {
	    # go immediatly to SSL
	    # Net::FTP::new gives only specific args to socket class
	    $args{Port} ||= 990;
	    local %Net::SSLGlue::Socket::ARGS = ( SSL => 1, %sslargs );
	    $self = $onew->($class,%args) or return;
	    ${*$self}{net_ftp_tlstype} = 'P';
	} else {
	    $self = $onew->($class,%args) or return;
	}
	${*$self}{net_ftp_tlsargs} = \%sslargs;
	return $self;
    };
}

# add starttls method to upgrade connection to SSL: AUTH TLS
sub Net::FTP::starttls {
    my $self = shift;
    $self->is_ssl and croak("called starttls within SSL session");
    $self->_AUTH('TLS') == Net::FTP::CMD_OK or return;

    my $host = $self->host;
    # for name verification strip port from domain:port, ipv4:port, [ipv6]:port
    $host =~s{(?<!:):\d+$}{};

    my %args = (
	SSL_verify_mode => 1,
	SSL_verifycn_scheme => 'ftp',
	SSL_verifycn_name => $host,
	# reuse SSL session of control connection in data connections
	SSL_session_cache => Net::SSLGlue::FTP::SingleSessionCache->new,
	%{ ${*$self}{net_ftp_tlsargs}},
	@_
    );

    $self->start_SSL(%args) or return;
    ${*$self}{net_ftp_tlsargs} = \%args;
    $self->prot('P');
    return 1;
}

# add prot method to set protection level (PROT C|P)
sub Net::FTP::prot {
    my ($self,$type) = @_;
    $type eq 'C' or $type eq 'P' or croak("type must by C or P");
    $self->_PBSZ(0) or return;
    $self->_PROT($type) or return;
    ${*$self}{net_ftp_tlstype} = $type;
    return 1;
}

# add stoptls method to downgrade connection from SSL: CCC
sub Net::FTP::stoptls {
    my $self = shift;
    $self->is_ssl or croak("called stoptls outside SSL session");
    $self->_CCC() or return;
    $self->stop_SSL();
    return 1;
}

# add EPSV for new style passive mode (incl. IPv6)
sub Net::FTP::epsv {
    my $self = shift;
    @_ and croak 'usage: $ftp->epsv()';
    delete ${*$self}{net_ftp_intern_port};

    $self->_EPSV && $self->message =~ m{\(([\x33-\x7e])\1\1(\d+)\1\)}
	? ${*$self}{'net_ftp_pasv'} = [ $self->peerhost, $2 ]
	: undef;
}

# redefine PASV so that it uses EPSV on IPv6
# also net_ftp_pasv contains now the parsed [ip,port]
{
    no warnings 'redefine';
    *Net::FTP::pasv = sub {
	my $self = shift;
	@_ and croak 'usage: $ftp->port()';
	return $self->epsv if $self->sockdomain != AF_INET;
	delete ${*$self}{net_ftp_intern_port};

	if ( $self->_PASV &&
	    $self->message =~ m{(\d+,\d+,\d+,\d+),(\d+),(\d+)} ) {
	    my $port = 256 * $2 + $3;
	    ( my $ip = $1 ) =~s{,}{.}g;
	    return ${*$self}{'net_ftp_pasv'} = [ $ip,$port ];
	}
	return;
    };
}

# add EPRT for new style passive mode (incl. IPv6)
sub Net::FTP::eprt {
    @_ == 1 || @_ == 2 or croak 'usage: $self->eprt([PORT])';
    return _eprt('EPRT',@_);
}

# redefine PORT to use EPRT for IPv6
{
    no warnings 'redefine';
    *Net::FTP::port = sub {
	@_ == 1 || @_ == 2 or croak 'usage: $self->port([PORT])';
	return _eprt('PORT',@_);
    };
}

sub _eprt {
    my ($cmd,$self,$port) = @_;
    delete ${*$self}{net_ftp_intern_port};
    unless ($port) {
	my $listen = ${*$self}{net_ftp_listen} ||= Net::SSLGlue::Socket->new(
	    Listen    => 1,
	    Timeout   => $self->timeout,
	    LocalAddr => $self->sockhost,
	);
	${*$self}{net_ftp_intern_port} = 1;
	my $fam = ($listen->sockdomain == AF_INET) ? 1:2;
	if ( $cmd eq 'EPRT' || $fam == 2 ) {
	    $port = "|$fam|".$listen->sockhost."|".$listen->sockport."|";
	    $cmd = 'EPRT';
	} else {
	    my $p = $listen->sockport;
	    $port = join(',',split(m{\.},$listen->sockhost),$p >> 8,$p & 0xff);
	}
    }
    my $ok = $cmd eq 'EPRT' ? $self->_EPRT($port) : $self->_PORT($port);
    ${*$self}{net_ftp_port} = $port if $ok;
    return $ok;
}



for my $cmd (qw(PBSZ PROT CCC EPRT EPSV)) {
    no strict 'refs';
    *{"Net::FTP::_$cmd"} = sub {
	shift->command("$cmd @_")->response() == Net::FTP::CMD_OK
    }
}

# redefine _dataconn to
# - support IPv6
# - upgrade data connection to SSL if PROT P
{

    no warnings 'redefine';
    *Net::FTP::_dataconn = sub {
	my $self = shift;
	my $pkg = "Net::FTP::" . $self->type;
	eval "require $pkg";
	$pkg =~ s/ /_/g;
	delete ${*$self}{net_ftp_dataconn};

	my $conn;
	if ( my $pasv = ${*$self}{net_ftp_pasv} ) {
	    $conn = $pkg->new(
		PeerAddr  => $pasv->[0],
		PeerPort  => $pasv->[1],
		LocalAddr => ${*$self}{net_ftp_localaddr},
	    ) or return;
	} elsif (my $listen =  delete ${*$self}{net_ftp_listen}) {
	    $conn = $listen->accept($pkg) or return;
	    close($listen);
	}

	if (( ${*$self}{net_ftp_tlstype} || '') eq 'P'
	    && ! $conn->start_SSL( $self->is_ssl 
		? ( SSL_reuse_ctx => $self )
		: ( %{${*$self}{net_ftp_tlsargs}} )
	    ) ) {
	    croak("failed to ssl upgrade dataconn: $SSL_ERROR");
	    return;
	}

	$conn->timeout($self->timeout);
	${*$self}{net_ftp_dataconn} = $conn;
	${*$conn} = "";
	${*$conn}{net_ftp_cmd} = $self;
	${*$conn}{net_ftp_blksize} = ${*$self}{net_ftp_blksize};
	return $conn;
    };
}

{
    # Session Cache with single entry
    # used to make sure that we reuse same session for control channel and data
    package Net::SSLGlue::FTP::SingleSessionCache;
    sub new { my $x; return bless \$x,shift }
    sub add_session {
	my ($self,$key,$session) = @_;
	Net::SSLeay::SESSION_free($$self) if $$self;
	$$self = $session;
    }
    sub get_session {
	my $self = shift;
	return $$self
    }
    sub DESTROY {
	my $self = shift;
	Net::SSLeay::SESSION_free($$self) if $$self;
    }
}

1;

=head1 NAME

Net::SSLGlue::FTP - extend Net::FTP for FTPS (SSL) and IPv6

=head1 SYNOPSIS

    use Net::SSLGlue::FTP;
    # SSL right from start
    my $ftps = Net::FTP->new( $host,
	SSL => 1,
	SSL_ca_path => ...
    );

    # SSL through upgrade of plain connection
    my $ftp = Net::FTP->new( $host );
    $ftp->starttls( SSL_ca_path => ... );

    # change protection mode to unencrypted|encrypted
    $ftp->prot('C'); # clear
    $ftp->prot('P'); # protected

=head1 DESCRIPTION

L<Net::SSLGlue::FTP> extends L<Net::FTP> so one can either start directly with
SSL or switch later to SSL using starttls method (AUTH TLS command).
If IO::Socket::IP or IO::Socket::INET6 are installed it will also transparently
use IPv6.

By default it will take care to verify the certificate according to the rules
for FTP implemented in L<IO::Socket::SSL>.

=head1 METHODS

=over 4

=item new

The method C<new> of L<Net::FTP> is now able to start directly with SSL when
the argument C<<SSL => 1>> is given. One can give the usual C<SSL_*> parameter
of L<IO::Socket::SSL> to C<Net::FTP::new>.

=item starttls

If the connection is not yet SSLified it will issue the "AUTH TLS" command and
change the object, so that SSL will now be used. The usual C<SSL_*> parameter of
L<IO::Socket::SSL> will be given.

=item peer_certificate ...

Once the SSL connection is established you can use this method to get
information about the certificate. See the L<IO::Socket::SSL> documentation.

=back

All of these methods can take the C<SSL_*> parameter from L<IO::Socket::SSL> to
change the behavior of the SSL connection. The following parameters are
especially useful:

=over 4

=item SSL_ca_path, SSL_ca_file

Specifies the path or a file where the CAs used for checking the certificates
are located. This is typically L</etc/ssl/certs> on UNIX systems.

=item SSL_verify_mode

If set to 0, verification of the certificate will be disabled. By default
it is set to 1 which means that the peer certificate is checked.

=item SSL_verifycn_name

Usually the name given as the hostname in the constructor is used to verify the
identity of the certificate. If you want to check the certificate against
another name you can specify it with this parameter.

=back

=head1 SEE ALSO

IO::Socket::SSL, Net::FTP, Net::SSLGlue::Socket

=head1 COPYRIGHT

This module is copyright (c) 2013, Steffen Ullrich.
All Rights Reserved.
This module is free software. It may be used, redistributed and/or modified
under the same terms as Perl itself.