# Net::FTP.pm
#
-# Copyright (c) 1995-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
# use AutoLoader qw(AUTOLOAD);
-$VERSION = "2.61"; # $Id: //depot/libnet/Net/FTP.pm#61 $
+$VERSION = "2.75";
@ISA = qw(Exporter Net::Cmd IO::Socket::INET);
# Someday I will "use constant", when I am not bothered to much about
sub new
{
my $pkg = shift;
- my $peer = shift;
- my %arg = @_;
+ my ($peer,%arg);
+ if (@_ % 2) {
+ $peer = shift ;
+ %arg = @_;
+ } else {
+ %arg = @_;
+ $peer=delete $arg{Host};
+ }
my $host = $peer;
my $fire = undef;
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
## User interface methods
##
+
+sub host {
+ my $me = shift;
+ ${*$me}{'net_ftp_host'};
+}
+
+
sub hash {
my $ftp = shift; # self
$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*(bytes?\s*)?$/)[0]
: undef;
}
elsif($ftp->supported("STAT")) {
my $line;
foreach $line (@msg) {
return (split(/\s+/,$line))[4]
- if $line =~ /^[-rwx]{10}/
+ if $line =~ /^[-rwxSsTt]{10}/
}
}
else {
my @files = $ftp->dir($file);
if(@files) {
return (split(/\s+/,$1))[4]
- if $files[0] =~ /^([-rwx]{10}.*)$/;
+ if $files[0] =~ /^([-rwxSsTt]{10}.*)$/;
}
}
undef;
($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;
{
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);
croak("Bad remote filename '$remote'\n")
if $remote =~ /[\r\n]/s;
- ${*$ftp}{'net_ftp_rest'} = $where
- if ($where);
+ ${*$ftp}{'net_ftp_rest'} = $where if defined $where;
+ my $rest = ${*$ftp}{'net_ftp_rest'};
delete ${*$ftp}{'net_ftp_port'};
delete ${*$ftp}{'net_ftp_pasv'};
$data = $ftp->retr($remote) or
return undef;
- if(defined $localfd)
+ if($localfd)
{
$loc = $local;
}
{
$loc = \*FD;
- unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($where ? O_APPEND : O_TRUNC)))
+ unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($rest ? 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)
{
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;
- unless (defined $localfd)
+ unless ($localfd)
{
unless (close($loc))
{
# Try to delete the contents
# Get a list of all the files in the directory
- my $filelist = $ftp->ls($dir);
+ my @filelist = grep { !/^\.{1,2}$/ } $ftp->ls($dir);
return undef
- unless $filelist && @$filelist; # failed, it is probably not a directory
+ unless @filelist; # failed, it is probably not a directory
# Go thru and delete each file or the directory
my $file;
- foreach $file (map { m,/, ? $_ : "$dir/$_" } @$filelist)
+ foreach $file (map { m,/, ? $_ : "$dir/$_" } @filelist)
{
next # successfully deleted the file
if $ftp->delete($file);
$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)
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 = do { local $^W; -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;
}
$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)
+ if (trEBCDIC && $ftp->type ne 'I')
{
$buf = $ftp->toascii($buf);
$len = length($buf);
{
$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;
- if ('STOU' eq uc $cmd and $ftp->message =~ m/unique\ file\ name:(.*)\)|"(.*)"/)
+ if ('STOU' eq uc $cmd and $ftp->message =~ m/unique\s+file\s*name\s*:\s*(.*)\)|"(.*)"/)
{
require File::Basename;
$remote = File::Basename::basename($+)
if(defined ${*$ftp}{'net_ftp_pasv'})
{
- my @port = split(/,/,${*$ftp}{'net_ftp_pasv'});
+ my @port = map { 0+$_ } split(/,/,${*$ftp}{'net_ftp_pasv'});
$data = $pkg->new(PeerAddr => join(".",@port[0..3]),
PeerPort => $port[4] * 256 + $port[5],
+ LocalAddr => ${*$ftp}{'net_ftp_localaddr'},
Proto => 'tcp'
);
}
#
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(@_) }
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
=over 4
-=item new (HOST [,OPTIONS])
+=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 an FTP connection is required.
+C<HOST> is optional. If C<HOST> is not given then it may instead be
+passed as the C<Host> option described below.
+
C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
Possible options are:
+B<Host> - FTP host to connect to. It may be a single scalar, as defined for
+the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
+an array with hosts to try in turn. The L</host> method will return the value
+which was used to connect to the host.
+
+
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
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 )
reason this method will not return an error, but setting it may cause
a subsequent data transfer to fail.
-=item rmdir ( DIR )
+=item rmdir ( DIR [, RECURSE ])
-Remove the directory with the name C<DIR>.
+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 ])
Returns the full pathname to the new directory.
+=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.
+
=item ls ( [ DIR ] )
Get a directory listing of C<DIR>, or the current directory.
=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 ()
=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
=over 4
-=item http://www.csh.rit.edu/~adam/Progs/autoftp-2.0.tar.gz
+=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.
=head1 COPYRIGHT
-Copyright (c) 1995-1998 Graham Barr. All rights reserved.
+Copyright (c) 1995-2004 Graham Barr. All rights reserved.
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#61 $>
-
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff