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
CommitLineData
406c51ee
JH
1##
2## Generic data connection package
3##
4
5package Net::FTP::dataconn;
6
7use Carp;
8use vars qw(@ISA $timeout);
9use Net::Cmd;
10
11@ISA = qw(IO::Socket::INET);
12
13sub reading
14{
15 my $data = shift;
16 ${*$data}{'net_ftp_bytesread'} = 0;
17}
18
19sub 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
44sub _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
56sub 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
76sub _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
100sub can_read
101{
102 my $data = shift;
103 local *timeout = \$_[0];
104
105 $data->_select($timeout,1);
106}
107
108sub can_write
109{
110 my $data = shift;
111 local *timeout = \$_[0];
112
113 $data->_select($timeout,0);
114}
115
116sub cmd
117{
118 my $ftp = shift;
119
120 ${*$ftp}{'net_ftp_cmd'};
121}
122
1231;