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