1##
2## Generic data connection package
3##
4
5package Net::FTP::dataconn;
6
7use 5.008001;
8
9use strict;
10use warnings;
11
12use Carp;
13use Errno;
14use Net::Cmd;
15
16our $VERSION = '3.15';
17
18$Net::FTP::IOCLASS or die "please load Net::FTP before Net::FTP::dataconn";
19our @ISA = $Net::FTP::IOCLASS;
20
21sub reading {
22  my $data = shift;
23  ${*$data}{'net_ftp_bytesread'} = 0;
24}
25
26
27sub abort {
28  my $data = shift;
29  my $ftp  = ${*$data}{'net_ftp_cmd'};
30
31  # no need to abort if we have finished the xfer
32  return $data->close
33    if ${*$data}{'net_ftp_eof'};
34
35  # for some reason if we continuously open RETR connections and not
36  # read a single byte, then abort them after a while the server will
37  # close our connection, this prevents the unexpected EOF on the
38  # command channel -- GMB
39  if (exists ${*$data}{'net_ftp_bytesread'}
40    && (${*$data}{'net_ftp_bytesread'} == 0))
41  {
42    my $buf     = "";
43    my $timeout = $data->timeout;
44    $data->can_read($timeout) && sysread($data, $buf, 1);
45  }
46
47  ${*$data}{'net_ftp_eof'} = 1;    # fake
48
49  $ftp->abort;                     # this will close me
50}
51
52
53sub _close {
54  my $data = shift;
55  my $ftp  = ${*$data}{'net_ftp_cmd'};
56
57  $data->SUPER::close();
58
59  delete ${*$ftp}{'net_ftp_dataconn'}
60    if defined $ftp
61    && exists ${*$ftp}{'net_ftp_dataconn'}
62    && $data == ${*$ftp}{'net_ftp_dataconn'};
63}
64
65
66sub close {
67  my $data = shift;
68  my $ftp  = ${*$data}{'net_ftp_cmd'};
69
70  if (exists ${*$data}{'net_ftp_bytesread'} && !${*$data}{'net_ftp_eof'}) {
71    my $junk;
72    eval { local($SIG{__DIE__}); $data->read($junk, 1, 0) };
73    return $data->abort unless ${*$data}{'net_ftp_eof'};
74  }
75
76  $data->_close;
77
78  return unless defined $ftp;
79
80  $ftp->response() == CMD_OK
81    && $ftp->message =~ /unique file name:\s*(\S*)\s*\)/
82    && (${*$ftp}{'net_ftp_unique'} = $1);
83
84  $ftp->status == CMD_OK;
85}
86
87
88sub _select {
89  my ($data, $timeout, $do_read) = @_;
90  my ($rin, $rout, $win, $wout, $tout, $nfound);
91
92  vec($rin = '', fileno($data), 1) = 1;
93
94  ($win, $rin) = ($rin, $win) unless $do_read;
95
96  while (1) {
97    $nfound = select($rout = $rin, $wout = $win, undef, $tout = $timeout);
98
99    last if $nfound >= 0;
100
101    croak "select: $!"
102      unless $!{EINTR};
103  }
104
105  $nfound;
106}
107
108
109sub can_read {
110  _select(@_[0, 1], 1);
111}
112
113
114sub can_write {
115  _select(@_[0, 1], 0);
116}
117
118
119sub cmd {
120  my $ftp = shift;
121
122  ${*$ftp}{'net_ftp_cmd'};
123}
124
125
126sub bytes_read {
127  my $ftp = shift;
128
129  ${*$ftp}{'net_ftp_bytesread'} || 0;
130}
131
1321;
133
134__END__
135
136=head1 NAME
137
138Net::FTP::dataconn - FTP Client data connection class
139
140=head1 SYNOPSIS
141
142    # Perform IO operations on an FTP client data connection object:
143
144    $num_bytes_read = $obj->read($buffer, $size);
145    $num_bytes_read = $obj->read($buffer, $size, $timeout);
146
147    $num_bytes_written = $obj->write($buffer, $size);
148    $num_bytes_written = $obj->write($buffer, $size, $timeout);
149
150    $num_bytes_read_so_far = $obj->bytes_read();
151
152    $obj->abort();
153
154    $closed_successfully = $obj->close();
155
156=head1 DESCRIPTION
157
158Some of the methods defined in C<Net::FTP> return an object which will
159be derived from this class. The dataconn class itself is derived from
160the C<IO::Socket::INET> class, so any normal IO operations can be performed.
161However the following methods are defined in the dataconn class and IO should
162be performed using these.
163
164=over 4
165
166=item C<read($buffer, $size[, $timeout])>
167
168Read C<$size> bytes of data from the server and place it into C<$buffer>, also
169performing any <CRLF> translation necessary. C<$timeout> is optional, if not
170given, the timeout value from the command connection will be used.
171
172Returns the number of bytes read before any <CRLF> translation.
173
174=item C<write($buffer, $size[, $timeout])>
175
176Write C<$size> bytes of data from C<$buffer> to the server, also
177performing any <CRLF> translation necessary. C<$timeout> is optional, if not
178given, the timeout value from the command connection will be used.
179
180Returns the number of bytes written before any <CRLF> translation.
181
182=item C<bytes_read()>
183
184Returns the number of bytes read so far.
185
186=item C<abort()>
187
188Abort the current data transfer.
189
190=item C<close()>
191
192Close the data connection and get a response from the FTP server. Returns
193I<true> if the connection was closed successfully and the first digit of
194the response from the server was a '2'.
195
196=back
197
198=head1 EXPORTS
199
200I<None>.
201
202=head1 KNOWN BUGS
203
204I<None>.
205
206=head1 AUTHOR
207
208Graham Barr E<lt>L<gbarr@pobox.com|mailto:gbarr@pobox.com>E<gt>.
209
210Steve Hay E<lt>L<shay@cpan.org|mailto:shay@cpan.org>E<gt> is now maintaining
211libnet as of version 1.22_02.
212
213=head1 COPYRIGHT
214
215Copyright (C) 1997-2010 Graham Barr.  All rights reserved.
216
217Copyright (C) 2013-2014, 2020 Steve Hay.  All rights reserved.
218
219=head1 LICENCE
220
221This module is free software; you can redistribute it and/or modify it under the
222same terms as Perl itself, i.e. under the terms of either the GNU General Public
223License or the Artistic License, as specified in the F<LICENCE> file.
224
225=head1 VERSION
226
227Version 3.15
228
229=head1 DATE
230
23120 March 2023
232
233=head1 HISTORY
234
235See the F<Changes> file.
236
237=cut
238