use Time::Local;
use Net::Cmd;
use Net::Config;
+use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
# use AutoLoader qw(AUTOLOAD);
-$VERSION = "2.56"; # $Id:$
+$VERSION = "2.72"; # $Id: //depot/libnet/Net/FTP.pm#80 $
@ISA = qw(Exporter Net::Cmd IO::Socket::INET);
# Someday I will "use constant", when I am not bothered to much about
$sftp->pasv_xfer($sfile,$dftp,$dfile,1);
}
+BEGIN {
+ # make a constant so code is fast'ish
+ my $is_os390 = $^O eq 'os390';
+ *trEBCDIC = sub () { $is_os390 }
+}
+
1;
# Having problems with AutoLoader
#__END__
my $host = $peer;
my $fire = undef;
+ my $fire_type = undef;
if(exists($arg{Firewall}) || Net::Config->requires_firewall($peer))
{
{
$peer = $fire;
delete $arg{Port};
+ $fire_type = $arg{FirewallType}
+ || $ENV{FTP_FIREWALL_TYPE}
+ || $NetConfig{firewall_type}
+ || undef;
}
}
my $ftp = $pkg->SUPER::new(PeerAddr => $peer,
PeerPort => $arg{Port} || 'ftp(21)',
+ LocalAddr => $arg{'LocalAddr'},
Proto => 'tcp',
Timeout => defined $arg{Timeout}
? $arg{Timeout}
${*$ftp}{'net_ftp_type'} = 'A'; # ASCII/binary/etc mode
${*$ftp}{'net_ftp_blksize'} = abs($arg{'BlockSize'} || 10240);
+ ${*$ftp}{'net_ftp_localaddr'} = $arg{'LocalAddr'};
+
${*$ftp}{'net_ftp_firewall'} = $fire
if(defined $fire);
+ ${*$ftp}{'net_ftp_firewall_type'} = $fire_type
+ if(defined $fire_type);
${*$ftp}{'net_ftp_passive'} = int
exists $arg{Passive}
sub hash {
my $ftp = shift; # self
- my $prev = ${*$ftp}{'net_ftp_hash'} || [\*STDERR, 0];
- unless(@_) {
- return $prev;
- }
my($h,$b) = @_;
- if(@_ == 1) {
- unless($h) {
- delete ${*$ftp}{'net_ftp_hash'};
- return $prev;
- }
- elsif(ref($h)) {
- $b = 1024;
- }
- else {
- ($h,$b) = (\*STDERR,$h);
- }
+ unless($h) {
+ delete ${*$ftp}{'net_ftp_hash'};
+ return [\*STDERR,0];
}
+ ($h,$b) = (ref($h)? $h : \*STDERR, $b || 1024);
select((select($h), $|=1)[0]);
$b = 512 if $b < 512;
${*$ftp}{'net_ftp_hash'} = [$h, $b];
- $prev;
}
sub quit
$ftp->close;
}
-sub DESTROY
-{
- my $ftp = shift;
- defined(fileno($ftp)) && $ftp->quit
-}
+sub DESTROY {}
sub ascii { shift->type('A',@_); }
sub binary { shift->type('I',@_); }
my $io;
if($ftp->supported("SIZE")) {
return $ftp->_SIZE($file)
- ? ($ftp->message =~ /(\d+)/)[0]
+ ? ($ftp->message =~ /(\d+)\s*$/)[0]
: undef;
}
elsif($ftp->supported("STAT")) {
my $line;
foreach $line (@msg) {
return (split(/\s+/,$line))[4]
- if $line =~ /^[-rw]{10}/
+ if $line =~ /^[-rwxSsTt]{10}/
}
}
else {
my @files = $ftp->dir($file);
if(@files) {
return (split(/\s+/,$1))[4]
- if $files[0] =~ /^([-rw]{10}.*)$/;
+ if $files[0] =~ /^([-rwxSsTt]{10}.*)$/;
}
}
undef;
$user ||= "anonymous";
$ruser = $user;
- $fwtype = $NetConfig{'ftp_firewall_type'} || 0;
+ $fwtype = ${*$ftp}{'net_ftp_firewall_type'}
+ || $NetConfig{'ftp_firewall_type'}
+ || 0;
if ($fwtype && defined ${*$ftp}{'net_ftp_firewall'}) {
if ($fwtype == 1 || $fwtype == 7) {
($ruser,$pass,$acct) = $rc->lpa()
if ($rc);
- $pass = "-" . (eval { (getpwuid($>))[0] } || $ENV{NAME} ) . '@'
+ $pass = '-anonymous@'
if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o));
}
$oldval;
}
+sub alloc
+{
+ my $ftp = shift;
+ my $size = shift;
+ my $oldval = ${*$ftp}{'net_ftp_allo'};
+
+ return $oldval
+ unless (defined $size);
+
+ return undef
+ unless ($ftp->_ALLO($size,@_));
+
+ ${*$ftp}{'net_ftp_allo'} = join(" ",$size,@_);
+
+ $oldval;
+}
+
sub abort
{
my $ftp = shift;
send($ftp,pack("CCC", $TELNET_IAC, $TELNET_IP, $TELNET_IAC),MSG_OOB);
$ftp->command(pack("C",$TELNET_DM) . "ABOR");
-
+
${*$ftp}{'net_ftp_dataconn'}->close()
if defined ${*$ftp}{'net_ftp_dataconn'};
{
my($ftp,$remote,$local,$where) = @_;
- my($loc,$len,$buf,$resp,$localfd,$data);
+ my($loc,$len,$buf,$resp,$data);
local *FD;
- $localfd = ref($local) || ref(\$local) eq "GLOB"
- ? fileno($local)
- : undef;
+ my $localfd = ref($local) || ref(\$local) eq "GLOB";
($local = $remote) =~ s#^.*/##
unless(defined $local);
$data = $ftp->retr($remote) or
return undef;
- if(defined $localfd)
+ if($localfd)
{
$loc = $local;
}
{
$loc = \*FD;
- unless(($where) ? open($loc,">>$local") : open($loc,">$local"))
+ unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($where ? O_APPEND : O_TRUNC)))
{
carp "Cannot open Local file $local: $!\n";
$data->abort;
if($ref = ${*$ftp}{'net_ftp_hash'});
my $blksize = ${*$ftp}{'net_ftp_blksize'};
+ local $\; # Just in case
while(1)
{
last unless $len = $data->read($buf,$blksize);
+
+ if (trEBCDIC && $ftp->type ne 'I')
+ {
+ $buf = $ftp->toebcdic($buf);
+ $len = length($buf);
+ }
+
if($hashh) {
$count += $len;
print $hashh "#" x (int($count / $hashb));
$count %= $hashb;
}
- my $written = syswrite($loc,$buf,$len);
- unless(defined($written) && $written == $len)
+ unless(print $loc $buf)
{
carp "Cannot write to Local file $local: $!\n";
$data->abort;
close($loc)
- unless defined $localfd;
+ unless $localfd;
return undef;
}
}
print $hashh "\n" if $hashh;
- close($loc)
- unless defined $localfd;
-
- $data->close(); # implied $ftp->response
+ unless ($localfd)
+ {
+ unless (close($loc))
+ {
+ carp "Cannot close file $local (perhaps disk space) $!\n";
+ return undef;
+ }
+ }
+
+ unless ($data->close()) # implied $ftp->response
+ {
+ carp "Unable to close datastream";
+ return undef;
+ }
return $local;
}
my $ok;
return $ok
- if $ftp->_RMD( $dir ) || !$recurse;
+ if $ok = $ftp->_RMD( $dir ) or !$recurse;
# Try to delete the contents
# Get a list of all the files in the directory
return $ftp->_RMD($dir) ;
}
+sub restart
+{
+ @_ == 2 || croak 'usage: $ftp->restart( BYTE_OFFSET )';
+
+ my($ftp,$where) = @_;
+
+ ${*$ftp}{'net_ftp_rest'} = $where;
+
+ return undef;
+}
+
+
sub mkdir
{
@_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )';
$path = $ftp->_extract_path($path);
}
- # If the creation of the last element was not sucessful, see if we
+ # If the creation of the last element was not successful, see if we
# can cd to it, if so then return path
unless($ftp->ok)
{
my($status,$message) = ($ftp->status,$ftp->message);
my $pwd = $ftp->pwd;
-
+
if($pwd && $ftp->cwd($dir))
{
$path = $dir;
sub _store_cmd
{
my($ftp,$cmd,$local,$remote) = @_;
- my($loc,$sock,$len,$buf,$localfd);
+ my($loc,$sock,$len,$buf);
local *FD;
- $localfd = ref($local) || ref(\$local) eq "GLOB"
- ? fileno($local)
- : undef;
+ my $localfd = ref($local) || ref(\$local) eq "GLOB";
unless(defined $remote)
{
croak 'Must specify remote filename with stream input'
- if defined $localfd;
+ if $localfd;
require File::Basename;
$remote = File::Basename::basename($local);
}
-
+ if( defined ${*$ftp}{'net_ftp_allo'} )
+ {
+ delete ${*$ftp}{'net_ftp_allo'};
+ } else
+ {
+ # if the user hasn't already invoked the alloc method since the last
+ # _store_cmd call, figure out if the local file is a regular file(not
+ # a pipe, or device) and if so get the file size from stat, and send
+ # an ALLO command before sending the STOR, STOU, or APPE command.
+ my $size = -f $local && -s _; # no ALLO if sending data from a pipe
+ $ftp->_ALLO($size) if $size;
+ }
croak("Bad remote filename '$remote'\n")
if $remote =~ /[\r\n]/s;
- if(defined $localfd)
+ if($localfd)
{
$loc = $local;
}
{
$loc = \*FD;
- unless(open($loc,"<$local"))
+ unless(sysopen($loc, $local, O_RDONLY))
{
carp "Cannot open Local file $local: $!\n";
return undef;
$sock = $ftp->_data_cmd($cmd, $remote) or
return undef;
+ $remote = ($ftp->message =~ /FILE:\s*(.*)/)[0]
+ if 'STOU' eq uc $cmd;
+
my $blksize = ${*$ftp}{'net_ftp_blksize'};
my($count,$hashh,$hashb,$ref) = (0);
while(1)
{
- last unless $len = sysread($loc,$buf="",$blksize);
+ last unless $len = read($loc,$buf="",$blksize);
+
+ if (trEBCDIC && $ftp->type ne 'I')
+ {
+ $buf = $ftp->toascii($buf);
+ $len = length($buf);
+ }
if($hashh) {
$count += $len;
{
$sock->abort;
close($loc)
- unless defined $localfd;
+ unless $localfd;
print $hashh "\n" if $hashh;
return undef;
}
print $hashh "\n" if $hashh;
close($loc)
- unless defined $localfd;
+ unless $localfd;
$sock->close() or
return undef;
- ($remote) = $ftp->message =~ /unique file name:\s*(\S*)\s*\)/
- if ('STOU' eq uc $cmd);
+ if ('STOU' eq uc $cmd and $ftp->message =~ m/unique\s+file\s*name\s*:\s*(.*)\)|"(.*)"/)
+ {
+ require File::Basename;
+ $remote = File::Basename::basename($+)
+ }
return $remote;
}
${*$ftp}{'net_ftp_listen'} ||= IO::Socket::INET->new(Listen => 5,
Proto => 'tcp',
+ Timeout => $ftp->timeout,
+ LocalAddr => $ftp->sockhost,
);
-
+
my $listen = ${*$ftp}{'net_ftp_listen'};
- my($myport, @myaddr) = ($listen->sockport, split(/\./,$ftp->sockhost));
+ my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost));
$port = join(',', @myaddr, $myport >> 8, $myport & 0xff);
my $text = $ftp->message;
if($text =~ /following\s+commands/i) {
$text =~ s/^.*\n//;
- $text =~ s/\n/ /sog;
- while($text =~ /(\w+)([* ])/g) {
- $hash->{"\U$1"} = $2 eq " " ? 1 : 0;
- }
+ while($text =~ /(\*?)(\w+)(\*?)/sg) {
+ $hash->{"\U$2"} = !length("$1$3");
+ }
}
else {
$hash->{$cmd} = $text !~ /unimplemented/i;
$data = $pkg->new(PeerAddr => join(".",@port[0..3]),
PeerPort => $port[4] * 256 + $port[5],
+ LocalAddr => ${*$ftp}{'net_ftp_localaddr'},
Proto => 'tcp'
);
}
$data->close();
+ if (trEBCDIC)
+ {
+ for (@$list) { $_ = $ftp->toebcdic($_) }
+ }
+
wantarray ? @{$list}
: $list;
}
return $data;
}
-
+
close(delete ${*$ftp}{'net_ftp_listen'});
-
+
return undef;
}
#
sub _ABOR { shift->command("ABOR")->response() == CMD_OK }
+sub _ALLO { shift->command("ALLO",@_)->response() == CMD_OK}
sub _CDUP { shift->command("CDUP")->response() == CMD_OK }
sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
sub _PASV { shift->command("PASV")->response() == CMD_OK }
sub _ACCT { shift->command("ACCT",@_)->response() }
sub _AUTH { shift->command("AUTH",@_)->response() }
-sub _ALLO { shift->unsupported(@_) }
sub _SMNT { shift->unsupported(@_) }
sub _MODE { shift->unsupported(@_) }
sub _SYST { shift->unsupported(@_) }
=head1 SYNOPSIS
use Net::FTP;
-
- $ftp = Net::FTP->new("some.host.name", Debug => 0);
- $ftp->login("anonymous",'me@here.there');
- $ftp->cwd("/pub");
- $ftp->get("that.file");
+
+ $ftp = Net::FTP->new("some.host.name", Debug => 0)
+ or die "Cannot connect to some.host.name: $@";
+
+ $ftp->login("anonymous",'-anonymous@')
+ or die "Cannot login ", $ftp->message;
+
+ $ftp->cwd("/pub")
+ or die "Cannot change working directory ", $ftp->message;
+
+ $ftp->get("that.file")
+ or die "get failed ", $ftp->message;
+
$ftp->quit;
=head1 DESCRIPTION
=item new (HOST [,OPTIONS])
This is the constructor for a new Net::FTP object. C<HOST> is the
-name of the remote host to which a FTP connection is required.
+name of the remote host to which an FTP connection is required.
C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
Possible options are:
-B<Firewall> - The name of a machine which acts as a FTP firewall. This can be
+B<Firewall> - The name of a machine which acts as an FTP firewall. This can be
overridden by an environment variable C<FTP_FIREWALL>. If specified, and the
given host cannot be directly connected to, then the
connection is made to the firewall machine and the string C<@hostname> is
appended to the login identifier. This kind of setup is also refered to
-as a ftp proxy.
+as an ftp proxy.
+
+B<FirewallType> - The type of firewall running on the machine indicated by
+B<Firewall>. This can be overridden by an environment variable
+C<FTP_FIREWALL_TYPE>. For a list of permissible types, see the description of
+ftp_firewall_type in L<Net::Config>.
B<BlockSize> - This is the block size that Net::FTP will use when doing
transfers. (defaults to 10240)
are displayed for all transfers. You can, of course, call C<hash()>
explicitly whenever you'd like.
+B<LocalAddr> - Local address to use for all socket connections, this
+argument will be passed to L<IO::Socket::INET>
+
If the constructor fails undef will be returned and an error message will
be in $@
no arguments are given then the C<Net::FTP> uses the C<Net::Netrc>
package to lookup the login information for the connected host.
If no information is found then a login of I<anonymous> is used.
-If no password is given and the login is I<anonymous> then the users
-Email address will be used for a password.
+If no password is given and the login is I<anonymous> then I<anonymous@>
+will be used for password.
If the connection is via a firewall then the C<authorize> method will
be called with no arguments.
Returns most significant digit of the response code.
-=item type (TYPE [, ARGS])
+=item ascii
-This method will send the TYPE command to the remote FTP server
-to change the type of data transfer. The return value is the previous
-value.
+Transfer file in ASCII. CRLF translation will be done if required
-=item ascii ([ARGS]) binary([ARGS]) ebcdic([ARGS]) byte([ARGS])
+=item binary
-Synonyms for C<type> with the first arguments set correctly
+Transfer file in binary mode. No transformation will be done.
-B<NOTE> ebcdic and byte are not fully supported.
+B<Hint>: If both server and client machines use the same line ending for
+text files, then it will be faster to transfer all files in binary mode.
=item rename ( OLDNAME, NEWNAME )
Returns the full pathname of the current directory.
-=item rmdir ( DIR )
+=item restart ( WHERE )
+
+Set the byte offset at which to begin the next data transfer. Net::FTP simply
+records this value and uses it when during the next data transfer. For this
+reason this method will not return an error, but setting it may cause
+a subsequent data transfer to fail.
-Remove the directory with the name C<DIR>.
+=item rmdir ( DIR [, RECURSE ])
+
+Remove the directory with the name C<DIR>. If C<RECURSE> is I<true> then
+C<rmdir> will attempt to delete everything inside the directory.
=item mkdir ( DIR [, RECURSE ])
=item ls ( [ DIR ] )
+=item alloc ( SIZE [, RECORD_SIZE] )
+
+The alloc command allows you to give the ftp server a hint about the size
+of the file about to be transfered using the ALLO ftp command. Some storage
+systems use this to make intelligent decisions about how to store the file.
+The C<SIZE> argument represents the size of the file in bytes. The
+C<RECORD_SIZE> argument indicates a mazimum record or page size for files
+sent with a record or page structure.
+
+The size of the file will be determined, and sent to the server
+automatically for normal files so that this method need only be called if
+you are transfering data from a socket, named pipe, or other stream not
+associated with a normal file.
+
Get a directory listing of C<DIR>, or the current directory.
In an array context, returns a list of lines returned from the server. In
=item get ( REMOTE_FILE [, LOCAL_FILE [, WHERE]] )
Get C<REMOTE_FILE> from the server and store locally. C<LOCAL_FILE> may be
-a filename or a filehandle. If not specified the the file will be stored in
+a filename or a filehandle. If not specified, the file will be stored in
the current directory with the same leafname as the remote file.
If C<WHERE> is given then the first C<WHERE> bytes of the file will
the local file if it already exists.
Returns C<LOCAL_FILE>, or the generated local file name if C<LOCAL_FILE>
-is not given.
+is not given. If an error was encountered undef is returned.
=item put ( LOCAL_FILE [, REMOTE_FILE ] )
=item nlst ( [ DIR ] )
-Send a C<NLST> command to the server, with an optional parameter.
+Send an C<NLST> command to the server, with an optional parameter.
=item list ( [ DIR ] )
=item port ( [ PORT ] )
Send a C<PORT> command to the server. If C<PORT> is specified then it is sent
-to the server. If not the a listen socket is created and the correct information
+to the server. If not, then a listen socket is created and the correct information
sent to the server.
=item pasv ()
Read C<SIZE> bytes of data from the server and place it into C<BUFFER>, also
performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
-given the the timeout value from the command connection will be used.
+given, the timeout value from the command connection will be used.
Returns the number of bytes read before any <CRLF> translation.
Write C<SIZE> bytes of data from C<BUFFER> to the server, also
performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
-given the the timeout value from the command connection will be used.
+given, the timeout value from the command connection will be used.
Returns the number of bytes written before any <CRLF> translation.
+=item bytes_read ()
+
+Returns the number of bytes read so far.
+
=item abort ()
Abort the current data transfer.
=over 4
-=item B<ALLO>
-
-Allocates storage for the file to be transferred.
-
=item B<SMNT>
Mount a different file system structure without changing login or
ftp(1), ftpd(8), RFC 959
http://www.cis.ohio-state.edu/htbin/rfc/rfc959.html
+=head1 USE EXAMPLES
+
+For an example of the use of Net::FTP see
+
+=over 4
+
+=item http://www.csh.rit.edu/~adam/Progs/
+
+C<autoftp> is a program that can retrieve, send, or list files via
+the FTP protocol in a non-interactive manner.
+
+=back
+
=head1 CREDITS
Henry Gabryjelski <henryg@WPI.EDU> - for the suggestion of creating directories
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
+=for html <hr>
+
+I<$Id: //depot/libnet/Net/FTP.pm#80 $>
+
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff