File Coverage

blib/lib/Net/INET6Glue/FTP.pm
Criterion Covered Total %
statement 22 76 28.9
branch 1 26 3.8
condition 0 21 0.0
subroutine 8 15 53.3
pod n/a
total 31 138 22.4


line stmt bran cond sub pod time code
1 1     1   704 use strict;
  1         3  
  1         33  
2 1     1   5 use warnings;
  1         2  
  1         56  
3             package Net::INET6Glue::FTP;
4             our $VERSION = 0.5;
5              
6             ############################################################################
7             # implement EPRT, EPSV for Net::FTP to support IPv6
8             ############################################################################
9              
10 1     1   465 use Net::INET6Glue::INET_is_INET6;
  1         3  
  1         41  
11 1     1   1181 use Net::FTP; # tested with version 2.77
  1         25838  
  1         94  
12             BEGIN {
13 1 50   1   190 $Net::FTP::VERSION eq '2.77'
14             or warn "Not tested with Net::FTP version $Net::FTP::VERSION";
15             }
16              
17 1     1   12 use Socket;
  1         2  
  1         745  
18 1     1   7 use Carp 'croak';
  1         31  
  1         563  
19              
20             if ( defined &Net::FTP::_EPRT ) {
21             # Net::SSLGlue::FTP implements IPv6 too
22             warn "somebody else already implements FTP IPv6 support - skipping ".
23             __PACKAGE__."\n";
24              
25             } else {
26             # implement EPRT
27             *Net::FTP::_EPRT = sub {
28 0     0     shift->command("EPRT", @_)->response() == Net::FTP::CMD_OK
29             };
30             *Net::FTP::eprt = sub {
31 0 0 0 0     @_ == 1 || @_ == 2 or croak 'usage: $ftp->eprt([PORT])';
32 0           my ($ftp,$port) = @_;
33 0           delete ${*$ftp}{net_ftp_intern_port};
  0            
34 0 0         unless ($port) {
35 0   0       my $listen = ${*$ftp}{net_ftp_listen} ||=
  0            
36             $Net::INET6Glue::INET_is_INET6::INET6CLASS->new(
37             Listen => 1,
38             Timeout => $ftp->timeout,
39             LocalAddr => $ftp->sockhost,
40             );
41 0           ${*$ftp}{net_ftp_intern_port} = 1;
  0            
42 0 0         my $fam = ($listen->sockdomain == AF_INET) ? 1:2;
43 0           $port = "|$fam|".$listen->sockhost."|".$listen->sockport."|";
44             }
45 0           my $ok = $ftp->_EPRT($port);
46 0 0         ${*$ftp}{net_ftp_port} = $port if $ok;
  0            
47 0           return $ok;
48             };
49              
50             # implement EPSV
51             *Net::FTP::_EPSV = sub {
52 0     0     shift->command("EPSV", @_)->response() == Net::FTP::CMD_OK
53             };
54             *Net::FTP::epsv = sub {
55 0     0     my $ftp = shift;
56 0 0         @_ and croak 'usage: $ftp->epsv()';
57 0           delete ${*$ftp}{net_ftp_intern_port};
  0            
58              
59 0           $ftp->_EPSV && $ftp->message =~ m{\(([\x33-\x7e])\1\1(\d+)\1\)}
60 0 0 0       ? ${*$ftp}{'net_ftp_pasv'} = $2
61             : undef;
62             };
63              
64             # redefine PORT and PASV so that they use EPRT and EPSV if necessary
65 1     1   6 no warnings 'redefine';
  1         1  
  1         538  
66             my $old_port = \&Net::FTP::port;
67             *Net::FTP::port =sub {
68 0 0 0 0     goto &$old_port if $_[0]->sockdomain == AF_INET or @_<1 or @_>2;
      0        
69 0           goto &Net::FTP::eprt;
70             };
71              
72             my $old_pasv = \&Net::FTP::pasv;
73             *Net::FTP::pasv = sub {
74 0 0 0 0     goto &$old_pasv if $_[0]->sockdomain == AF_INET or @_<1 or @_>2;
      0        
75 0           goto &Net::FTP::epsv;
76             };
77              
78             # redefined _dataconn to make use of the data it got from EPSV
79             # copied and adapted from Net::FTP::_dataconn
80             my $old_dataconn = \&Net::FTP::_dataconn;
81             *Net::FTP::_dataconn = sub {
82 0 0   0     goto &$old_dataconn if $_[0]->sockdomain == AF_INET;
83 0           my $ftp = shift;
84              
85 0           my $pkg = "Net::FTP::" . $ftp->type;
86 0           eval "require $pkg";
87 0           $pkg =~ s/ /_/g;
88 0           delete ${*$ftp}{net_ftp_dataconn};
  0            
89              
90 0           my $data;
91 0 0         if ( my $port = ${*$ftp}{net_ftp_pasv} ) {
  0 0          
  0            
92 0           $data = $pkg->new(
93             PeerAddr => $ftp->peerhost,
94             PeerPort => $port,
95 0           LocalAddr => ${*$ftp}{net_ftp_localaddr},
96             );
97             } elsif (my $listen = delete ${*$ftp}{net_ftp_listen}) {
98 0           $data = $listen->accept($pkg);
99 0           close($listen);
100             }
101              
102 0 0         return if ! $data;
103              
104 0           $data->timeout($ftp->timeout);
105 0           ${*$ftp}{net_ftp_dataconn} = $data;
  0            
106 0           ${*$data} = "";
  0            
107 0           ${*$data}{net_ftp_cmd} = $ftp;
  0            
108 0           ${*$data}{net_ftp_blksize} = ${*$ftp}{net_ftp_blksize};
  0            
  0            
109 0           return $data;
110             };
111             }
112              
113             1;
114              
115             =head1 NAME
116              
117             Net::INET6Glue::FTP - adds IPv6 support to L by hotpatching
118              
119             =head1 SYNOPSIS
120              
121             use Net::INET6Glue::FTP;
122             use Net::FTP;
123             my $ftp = Net::FTP->new( '::1' );
124             $ftp->login(...)
125              
126             =head1 DESCRIPTION
127              
128             This module adds support for IPv6 by hotpatching support for EPRT and EPSV
129             commands into L and hotpatching B, B and B<_dataconn>
130             methods to make use of EPRT and EPSV on IPv6 connections.
131              
132             It also includes L to make the L
133             sockets IPv6 capable.
134              
135             =head1 COPYRIGHT
136              
137             This module is copyright (c) 2008..2014, Steffen Ullrich.
138             All Rights Reserved.
139             This module is free software. It may be used, redistributed and/or modified
140             under the same terms as Perl itself.