diff options
Diffstat (limited to 'lib/Net/FTP')
-rw-r--r-- | lib/Net/FTP/A.pm | 111 | ||||
-rw-r--r-- | lib/Net/FTP/E.pm | 8 | ||||
-rw-r--r-- | lib/Net/FTP/I.pm | 80 | ||||
-rw-r--r-- | lib/Net/FTP/L.pm | 8 | ||||
-rw-r--r-- | lib/Net/FTP/dataconn.pm | 127 |
5 files changed, 334 insertions, 0 deletions
diff --git a/lib/Net/FTP/A.pm b/lib/Net/FTP/A.pm new file mode 100644 index 0000000..c117d69 --- /dev/null +++ b/lib/Net/FTP/A.pm @@ -0,0 +1,111 @@ +## +## Package to read/write on ASCII data connections +## + +package Net::FTP::A; +use strict; +use vars qw(@ISA $buf $VERSION); +use Carp; + +require Net::FTP::dataconn; + +@ISA = qw(Net::FTP::dataconn); +$VERSION = "1.19"; + + +sub read { + my $data = shift; + local *buf = \$_[0]; + shift; + my $size = shift || croak 'read($buf,$size,[$offset])'; + my $timeout = @_ ? shift: $data->timeout; + + if (length(${*$data}) < $size && !${*$data}{'net_ftp_eof'}) { + my $blksize = ${*$data}{'net_ftp_blksize'}; + $blksize = $size if $size > $blksize; + + my $l = 0; + my $n; + + READ: + { + my $readbuf = defined(${*$data}{'net_ftp_cr'}) ? "\015" : ''; + + $data->can_read($timeout) + or croak "Timeout"; + + if ($n = sysread($data, $readbuf, $blksize, length $readbuf)) { + ${*$data}{'net_ftp_bytesread'} += $n; + ${*$data}{'net_ftp_cr'} = + substr($readbuf, -1) eq "\015" + ? chop($readbuf) + : undef; + } + else { + return undef + unless defined $n; + + ${*$data}{'net_ftp_eof'} = 1; + } + + $readbuf =~ s/\015\012/\n/sgo; + ${*$data} .= $readbuf; + + unless (length(${*$data})) { + + redo READ + if ($n > 0); + + $size = length(${*$data}) + if ($n == 0); + } + } + } + + $buf = substr(${*$data}, 0, $size); + substr(${*$data}, 0, $size) = ''; + + length $buf; +} + + +sub write { + my $data = shift; + local *buf = \$_[0]; + shift; + my $size = shift || croak 'write($buf,$size,[$timeout])'; + my $timeout = @_ ? shift: $data->timeout; + + my $nr = (my $tmp = substr($buf, 0, $size)) =~ tr/\r\n/\015\012/; + $tmp =~ s/(?<!\015)\012/\015\012/sg if $nr; + $tmp =~ s/^\015// if ${*$data}{'net_ftp_outcr'}; + ${*$data}{'net_ftp_outcr'} = substr($tmp, -1) eq "\015"; + + # If the remote server has closed the connection we will be signal'd + # when we write. This can happen if the disk on the remote server fills up + + local $SIG{PIPE} = 'IGNORE' + unless ($SIG{PIPE} || '') eq 'IGNORE' + or $^O eq 'MacOS'; + + my $len = length($tmp); + my $off = 0; + my $wrote = 0; + + my $blksize = ${*$data}{'net_ftp_blksize'}; + + while ($len) { + $data->can_write($timeout) + or croak "Timeout"; + + $off += $wrote; + $wrote = syswrite($data, substr($tmp, $off), $len > $blksize ? $blksize : $len); + return undef + unless defined($wrote); + $len -= $wrote; + } + + $size; +} + +1; diff --git a/lib/Net/FTP/E.pm b/lib/Net/FTP/E.pm new file mode 100644 index 0000000..d480cd7 --- /dev/null +++ b/lib/Net/FTP/E.pm @@ -0,0 +1,8 @@ +package Net::FTP::E; + +require Net::FTP::I; + +@ISA = qw(Net::FTP::I); +$VERSION = "0.01"; + +1; diff --git a/lib/Net/FTP/I.pm b/lib/Net/FTP/I.pm new file mode 100644 index 0000000..449bb99 --- /dev/null +++ b/lib/Net/FTP/I.pm @@ -0,0 +1,80 @@ +## +## Package to read/write on BINARY data connections +## + +package Net::FTP::I; + +use vars qw(@ISA $buf $VERSION); +use Carp; + +require Net::FTP::dataconn; + +@ISA = qw(Net::FTP::dataconn); +$VERSION = "1.12"; + + +sub read { + my $data = shift; + local *buf = \$_[0]; + shift; + my $size = shift || croak 'read($buf,$size,[$timeout])'; + my $timeout = @_ ? shift: $data->timeout; + + my $n; + + if ($size > length ${*$data} and !${*$data}{'net_ftp_eof'}) { + $data->can_read($timeout) + or croak "Timeout"; + + my $blksize = ${*$data}{'net_ftp_blksize'}; + $blksize = $size if $size > $blksize; + + unless ($n = sysread($data, ${*$data}, $blksize, length ${*$data})) { + return undef unless defined $n; + ${*$data}{'net_ftp_eof'} = 1; + } + } + + $buf = substr(${*$data}, 0, $size); + + $n = length($buf); + + substr(${*$data}, 0, $n) = ''; + + ${*$data}{'net_ftp_bytesread'} += $n; + + $n; +} + + +sub write { + my $data = shift; + local *buf = \$_[0]; + shift; + my $size = shift || croak 'write($buf,$size,[$timeout])'; + my $timeout = @_ ? shift: $data->timeout; + + # If the remote server has closed the connection we will be signal'd + # when we write. This can happen if the disk on the remote server fills up + + local $SIG{PIPE} = 'IGNORE' + unless ($SIG{PIPE} || '') eq 'IGNORE' + or $^O eq 'MacOS'; + my $sent = $size; + my $off = 0; + + my $blksize = ${*$data}{'net_ftp_blksize'}; + while ($sent > 0) { + $data->can_write($timeout) + or croak "Timeout"; + + my $n = syswrite($data, $buf, $sent > $blksize ? $blksize : $sent, $off); + return undef unless defined($n); + $sent -= $n; + $off += $n; + } + + $size; +} + +1; diff --git a/lib/Net/FTP/L.pm b/lib/Net/FTP/L.pm new file mode 100644 index 0000000..f7423cb --- /dev/null +++ b/lib/Net/FTP/L.pm @@ -0,0 +1,8 @@ +package Net::FTP::L; + +require Net::FTP::I; + +@ISA = qw(Net::FTP::I); +$VERSION = "0.01"; + +1; diff --git a/lib/Net/FTP/dataconn.pm b/lib/Net/FTP/dataconn.pm new file mode 100644 index 0000000..3f93668 --- /dev/null +++ b/lib/Net/FTP/dataconn.pm @@ -0,0 +1,127 @@ +## +## Generic data connection package +## + +package Net::FTP::dataconn; + +use Carp; +use vars qw(@ISA $timeout $VERSION); +use Net::Cmd; +use Errno; + +$VERSION = '0.12'; +@ISA = qw(IO::Socket::INET); + + +sub reading { + my $data = shift; + ${*$data}{'net_ftp_bytesread'} = 0; +} + + +sub abort { + my $data = shift; + my $ftp = ${*$data}{'net_ftp_cmd'}; + + # no need to abort if we have finished the xfer + return $data->close + if ${*$data}{'net_ftp_eof'}; + + # for some reason if we continuously open RETR connections and not + # read a single byte, then abort them after a while the server will + # close our connection, this prevents the unexpected EOF on the + # command channel -- GMB + if (exists ${*$data}{'net_ftp_bytesread'} + && (${*$data}{'net_ftp_bytesread'} == 0)) + { + my $buf = ""; + my $timeout = $data->timeout; + $data->can_read($timeout) && sysread($data, $buf, 1); + } + + ${*$data}{'net_ftp_eof'} = 1; # fake + + $ftp->abort; # this will close me +} + + +sub _close { + my $data = shift; + my $ftp = ${*$data}{'net_ftp_cmd'}; + + $data->SUPER::close(); + + delete ${*$ftp}{'net_ftp_dataconn'} + if defined $ftp + && exists ${*$ftp}{'net_ftp_dataconn'} + && $data == ${*$ftp}{'net_ftp_dataconn'}; +} + + +sub close { + my $data = shift; + my $ftp = ${*$data}{'net_ftp_cmd'}; + + if (exists ${*$data}{'net_ftp_bytesread'} && !${*$data}{'net_ftp_eof'}) { + my $junk; + eval { local($SIG{__DIE__}); $data->read($junk, 1, 0) }; + return $data->abort unless ${*$data}{'net_ftp_eof'}; + } + + $data->_close; + + return unless defined $ftp; + + $ftp->response() == CMD_OK + && $ftp->message =~ /unique file name:\s*(\S*)\s*\)/ + && (${*$ftp}{'net_ftp_unique'} = $1); + + $ftp->status == CMD_OK; +} + + +sub _select { + my ($data, $timeout, $do_read) = @_; + my ($rin, $rout, $win, $wout, $tout, $nfound); + + vec($rin = '', fileno($data), 1) = 1; + + ($win, $rin) = ($rin, $win) unless $do_read; + + while (1) { + $nfound = select($rout = $rin, $wout = $win, undef, $tout = $timeout); + + last if $nfound >= 0; + + croak "select: $!" + unless $!{EINTR}; + } + + $nfound; +} + + +sub can_read { + _select(@_[0, 1], 1); +} + + +sub can_write { + _select(@_[0, 1], 0); +} + + +sub cmd { + my $ftp = shift; + + ${*$ftp}{'net_ftp_cmd'}; +} + + +sub bytes_read { + my $ftp = shift; + + ${*$ftp}{'net_ftp_bytesread'} || 0; +} + +1; |