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