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