File Coverage

blib/lib/Net/INET6Glue/FTP.pm
Criterion Covered Total %
statement 24 24 100.0
branch 1 2 50.0
condition n/a
subroutine 8 8 100.0
pod n/a
total 33 34 97.0


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