lib/Net/FTP/dataconn.pm

   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
  16 sub reading {
  17   my $data = shift;
  18   ${*$data}{'net_ftp_bytesread'} = 0;
  19 }
  20
  21
  22 sub abort {
  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   {
  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
  45 }
  46
  47
  48 sub _close {
  49   my $data = shift;
  50   my $ftp  = ${*$data}{'net_ftp_cmd'};
  51
  52   $data->SUPER::close();
  53
  54   delete ${*$ftp}{'net_ftp_dataconn'}
  55     if exists ${*$ftp}{'net_ftp_dataconn'}
  56     && $data == ${*$ftp}{'net_ftp_dataconn'};
  57 }
  58
  59
  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   }
  69
  70   $data->_close;
  71
  72   $ftp->response() == CMD_OK
  73     && $ftp->message =~ /unique file name:\s*(\S*)\s*\)/
  74     && (${*$ftp}{'net_ftp_unique'} = $1);
  75
  76   $ftp->status == CMD_OK;
  77 }
  78
  79
  80 sub _select {
  81   my ($data, $timeout, $do_read) = @_;
  82   my ($rin, $rout, $win, $wout, $tout, $nfound);
  83
  84   vec($rin = '', fileno($data), 1) = 1;
  85
  86   ($win, $rin) = ($rin, $win) unless $do_read;
  87
  88   while (1) {
  89     $nfound = select($rout = $rin, $wout = $win, undef, $tout = $timeout);
  90
  91     last if $nfound >= 0;
  92
  93     croak "select: $!"
  94       unless $!{EINTR};
  95   }
  96
  97   $nfound;
  98 }
  99
 100
 101 sub can_read {
 102   _select(@_[0, 1], 1);
 103 }
 104
 105
 106 sub can_write {
 107   _select(@_[0, 1], 0);
 108 }
 109
 110
 111 sub cmd {
 112   my $ftp = shift;
 113
 114   ${*$ftp}{'net_ftp_cmd'};
 115 }
 116
 117
 118 sub bytes_read {
 119   my $ftp = shift;
 120
 121   ${*$ftp}{'net_ftp_bytesread'} || 0;
 122 }
 123
 124 1;