Commit | Line | Data |
406c51ee |
1 | ## |
2 | ## Generic data connection package |
3 | ## |
4 | |
5 | package Net::FTP::dataconn; |
6 | |
7 | use Carp; |
686337f3 |
8 | use vars qw(@ISA $timeout $VERSION); |
406c51ee |
9 | use Net::Cmd; |
67ada6d4 |
10 | use Errno; |
406c51ee |
11 | |
67ada6d4 |
12 | $VERSION = '0.11'; |
b3f6f6a6 |
13 | @ISA = qw(IO::Socket::INET); |
406c51ee |
14 | |
406c51ee |
15 | |
b3f6f6a6 |
16 | sub reading { |
17 | my $data = shift; |
18 | ${*$data}{'net_ftp_bytesread'} = 0; |
19 | } |
406c51ee |
20 | |
406c51ee |
21 | |
b3f6f6a6 |
22 | sub abort { |
23 | my $data = shift; |
24 | my $ftp = ${*$data}{'net_ftp_cmd'}; |
406c51ee |
25 | |
b3f6f6a6 |
26 | # no need to abort if we have finished the xfer |
27 | return $data->close |
28 | if ${*$data}{'net_ftp_eof'}; |
406c51ee |
29 | |
b3f6f6a6 |
30 | # for some reason if we continously open RETR connections and not |
31 | # read a single byte, then abort them after a while the server will |
32 | # close our connection, this prevents the unexpected EOF on the |
33 | # command channel -- GMB |
34 | if (exists ${*$data}{'net_ftp_bytesread'} |
35 | && (${*$data}{'net_ftp_bytesread'} == 0)) |
36 | { |
37 | my $buf = ""; |
38 | my $timeout = $data->timeout; |
39 | $data->can_read($timeout) && sysread($data, $buf, 1); |
40 | } |
41 | |
42 | ${*$data}{'net_ftp_eof'} = 1; # fake |
43 | |
44 | $ftp->abort; # this will close me |
406c51ee |
45 | } |
46 | |
406c51ee |
47 | |
b3f6f6a6 |
48 | sub _close { |
49 | my $data = shift; |
50 | my $ftp = ${*$data}{'net_ftp_cmd'}; |
51 | |
52 | $data->SUPER::close(); |
406c51ee |
53 | |
b3f6f6a6 |
54 | delete ${*$ftp}{'net_ftp_dataconn'} |
55 | if exists ${*$ftp}{'net_ftp_dataconn'} |
56 | && $data == ${*$ftp}{'net_ftp_dataconn'}; |
406c51ee |
57 | } |
58 | |
406c51ee |
59 | |
b3f6f6a6 |
60 | sub close { |
61 | my $data = shift; |
62 | my $ftp = ${*$data}{'net_ftp_cmd'}; |
63 | |
64 | if (exists ${*$data}{'net_ftp_bytesread'} && !${*$data}{'net_ftp_eof'}) { |
65 | my $junk; |
66 | $data->read($junk, 1, 0); |
67 | return $data->abort unless ${*$data}{'net_ftp_eof'}; |
68 | } |
406c51ee |
69 | |
b3f6f6a6 |
70 | $data->_close; |
406c51ee |
71 | |
b3f6f6a6 |
72 | $ftp->response() == CMD_OK |
73 | && $ftp->message =~ /unique file name:\s*(\S*)\s*\)/ |
74 | && (${*$ftp}{'net_ftp_unique'} = $1); |
406c51ee |
75 | |
b3f6f6a6 |
76 | $ftp->status == CMD_OK; |
406c51ee |
77 | } |
78 | |
b3f6f6a6 |
79 | |
67ada6d4 |
80 | sub _select { |
b3f6f6a6 |
81 | my ($data, $timeout, $do_read) = @_; |
82 | my ($rin, $rout, $win, $wout, $tout, $nfound); |
83 | |
84 | vec($rin = '', fileno($data), 1) = 1; |
406c51ee |
85 | |
b3f6f6a6 |
86 | ($win, $rin) = ($rin, $win) unless $do_read; |
406c51ee |
87 | |
b3f6f6a6 |
88 | while (1) { |
89 | $nfound = select($rout = $rin, $wout = $win, undef, $tout = $timeout); |
406c51ee |
90 | |
b3f6f6a6 |
91 | last if $nfound >= 0; |
406c51ee |
92 | |
b3f6f6a6 |
93 | croak "select: $!" |
94 | unless $!{EINTR}; |
95 | } |
406c51ee |
96 | |
b3f6f6a6 |
97 | $nfound; |
406c51ee |
98 | } |
99 | |
b3f6f6a6 |
100 | |
101 | sub can_read { |
102 | _select(@_[0, 1], 1); |
406c51ee |
103 | } |
104 | |
b3f6f6a6 |
105 | |
106 | sub can_write { |
107 | _select(@_[0, 1], 0); |
406c51ee |
108 | } |
109 | |
406c51ee |
110 | |
b3f6f6a6 |
111 | sub cmd { |
112 | my $ftp = shift; |
113 | |
114 | ${*$ftp}{'net_ftp_cmd'}; |
406c51ee |
115 | } |
116 | |
b3f6f6a6 |
117 | |
686337f3 |
118 | sub bytes_read { |
b3f6f6a6 |
119 | my $ftp = shift; |
686337f3 |
120 | |
b3f6f6a6 |
121 | ${*$ftp}{'net_ftp_bytesread'} || 0; |
686337f3 |
122 | } |
123 | |
406c51ee |
124 | 1; |