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
|
##
## Generic data connection package
##
package Net::FTP::dataconn;
use 5.008001;
use strict;
use warnings;
use Carp;
use Errno;
use Net::Cmd;
our $VERSION = '3.08_01';
$Net::FTP::IOCLASS or die "please load Net::FTP before Net::FTP::dataconn";
our @ISA = $Net::FTP::IOCLASS;
sub reading {
my $data = shift;
${*$data}{'net_ftp_bytesread'} = 0;
}
sub abort {
my $data = shift;
my $ftp = ${*$data}{'net_ftp_cmd'};
# no need to abort if we have finished the xfer
return $data->close
if ${*$data}{'net_ftp_eof'};
# for some reason if we continuously open RETR connections and not
# read a single byte, then abort them after a while the server will
# close our connection, this prevents the unexpected EOF on the
# command channel -- GMB
if (exists ${*$data}{'net_ftp_bytesread'}
&& (${*$data}{'net_ftp_bytesread'} == 0))
{
my $buf = "";
my $timeout = $data->timeout;
$data->can_read($timeout) && sysread($data, $buf, 1);
}
${*$data}{'net_ftp_eof'} = 1; # fake
$ftp->abort; # this will close me
}
sub _close {
my $data = shift;
my $ftp = ${*$data}{'net_ftp_cmd'};
$data->SUPER::close();
delete ${*$ftp}{'net_ftp_dataconn'}
if defined $ftp
&& exists ${*$ftp}{'net_ftp_dataconn'}
&& $data == ${*$ftp}{'net_ftp_dataconn'};
}
sub close {
my $data = shift;
my $ftp = ${*$data}{'net_ftp_cmd'};
if (exists ${*$data}{'net_ftp_bytesread'} && !${*$data}{'net_ftp_eof'}) {
my $junk;
eval { local($SIG{__DIE__}); $data->read($junk, 1, 0) };
return $data->abort unless ${*$data}{'net_ftp_eof'};
}
$data->_close;
return unless defined $ftp;
$ftp->response() == CMD_OK
&& $ftp->message =~ /unique file name:\s*(\S*)\s*\)/
&& (${*$ftp}{'net_ftp_unique'} = $1);
$ftp->status == CMD_OK;
}
sub _select {
my ($data, $timeout, $do_read) = @_;
my ($rin, $rout, $win, $wout, $tout, $nfound);
vec($rin = '', fileno($data), 1) = 1;
($win, $rin) = ($rin, $win) unless $do_read;
while (1) {
$nfound = select($rout = $rin, $wout = $win, undef, $tout = $timeout);
last if $nfound >= 0;
croak "select: $!"
unless $!{EINTR};
}
$nfound;
}
sub can_read {
_select(@_[0, 1], 1);
}
sub can_write {
_select(@_[0, 1], 0);
}
sub cmd {
my $ftp = shift;
${*$ftp}{'net_ftp_cmd'};
}
sub bytes_read {
my $ftp = shift;
${*$ftp}{'net_ftp_bytesread'} || 0;
}
1;
__END__
=head1 NAME
Net::FTP::dataconn - FTP Client data connection class
=head1 DESCRIPTION
Some of the methods defined in C<Net::FTP> return an object which will
be derived from this class. The dataconn class itself is derived from
the C<IO::Socket::INET> class, so any normal IO operations can be performed.
However the following methods are defined in the dataconn class and IO should
be performed using these.
=over 4
=item read ( BUFFER, SIZE [, TIMEOUT ] )
Read C<SIZE> bytes of data from the server and place it into C<BUFFER>, also
performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
given, the timeout value from the command connection will be used.
Returns the number of bytes read before any <CRLF> translation.
=item write ( BUFFER, SIZE [, TIMEOUT ] )
Write C<SIZE> bytes of data from C<BUFFER> to the server, also
performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
given, the timeout value from the command connection will be used.
Returns the number of bytes written before any <CRLF> translation.
=item bytes_read ()
Returns the number of bytes read so far.
=item abort ()
Abort the current data transfer.
=item close ()
Close the data connection and get a response from the FTP server. Returns
I<true> if the connection was closed successfully and the first digit of
the response from the server was a '2'.
=back
=cut
|
