# Net::FTP.pm
#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
-# reserved. This program is free software; you can redistribute it and/or
+# 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.
+#
+# Documentation (at end) improved 1996 by Nathan Torkington <gnat@frii.com>.
package Net::FTP;
-=head1 NAME
+require 5.001;
-Net::FTP - FTP Client class
+use strict;
+use vars qw(@ISA $VERSION);
+use Carp;
-=head1 SYNOPSIS
+use Socket 1.3;
+use IO::Socket;
+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);
- use Net::FTP;
-
- $ftp = Net::FTP->new("some.host.name");
- $ftp->login("anonymous","me@here.there");
- $ftp->cwd("/pub");
- $ftp->get("that.file");
- $ftp->quit;
+$VERSION = "2.75";
+@ISA = qw(Exporter Net::Cmd IO::Socket::INET);
-=head1 DESCRIPTION
+# Someday I will "use constant", when I am not bothered to much about
+# compatability with older releases of perl
-C<Net::FTP> is a class implementing a simple FTP client in Perl as described
-in RFC959
+use vars qw($TELNET_IAC $TELNET_IP $TELNET_DM);
+($TELNET_IAC,$TELNET_IP,$TELNET_DM) = (255,244,242);
-C<Net::FTP> provides methods that will perform various operations. These methods
-could be split into groups depending the level of interface the user requires.
+# Name is too long for AutoLoad, it clashes with pasv_xfer
+sub pasv_xfer_unique {
+ my($sftp,$sfile,$dftp,$dfile) = @_;
+ $sftp->pasv_xfer($sfile,$dftp,$dfile,1);
+}
-=head1 CONSTRUCTOR
+BEGIN {
+ # make a constant so code is fast'ish
+ my $is_os390 = $^O eq 'os390';
+ *trEBCDIC = sub () { $is_os390 }
+}
-=over 4
+1;
+# Having problems with AutoLoader
+#__END__
-=item new (HOST [,OPTIONS])
+sub new
+{
+ my $pkg = shift;
+ my ($peer,%arg);
+ if (@_ % 2) {
+ $peer = shift ;
+ %arg = @_;
+ } else {
+ %arg = @_;
+ $peer=delete $arg{Host};
+ }
-This is the constructor for a new Net::SMTP object. C<HOST> is the
-name of the remote host to which a FTP connection is required.
+ my $host = $peer;
+ my $fire = undef;
+ my $fire_type = undef;
-C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
-Possible options are:
+ if(exists($arg{Firewall}) || Net::Config->requires_firewall($peer))
+ {
+ $fire = $arg{Firewall}
+ || $ENV{FTP_FIREWALL}
+ || $NetConfig{ftp_firewall}
+ || undef;
-B<Firewall> - The name of a machine which acts as a 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 firwall machine and the string C<@hostname> is
-appended to the login identifier.
+ if(defined $fire)
+ {
+ $peer = $fire;
+ delete $arg{Port};
+ $fire_type = $arg{FirewallType}
+ || $ENV{FTP_FIREWALL_TYPE}
+ || $NetConfig{firewall_type}
+ || undef;
+ }
+ }
-B<Port> - The port number to connect to on the remote machine for the
-FTP connection
+ my $ftp = $pkg->SUPER::new(PeerAddr => $peer,
+ PeerPort => $arg{Port} || 'ftp(21)',
+ LocalAddr => $arg{'LocalAddr'},
+ Proto => 'tcp',
+ Timeout => defined $arg{Timeout}
+ ? $arg{Timeout}
+ : 120
+ ) or return undef;
-B<Timeout> - Set a timeout value (defaults to 120)
+ ${*$ftp}{'net_ftp_host'} = $host; # Remote hostname
+ ${*$ftp}{'net_ftp_type'} = 'A'; # ASCII/binary/etc mode
+ ${*$ftp}{'net_ftp_blksize'} = abs($arg{'BlockSize'} || 10240);
-B<Debug> - Debug level
+ ${*$ftp}{'net_ftp_localaddr'} = $arg{'LocalAddr'};
-B<Passive> - If set to I<true> then all data transfers will be done using
-passive mode. This is required for some I<dumb> servers.
+ ${*$ftp}{'net_ftp_firewall'} = $fire
+ if(defined $fire);
+ ${*$ftp}{'net_ftp_firewall_type'} = $fire_type
+ if(defined $fire_type);
-=back
+ ${*$ftp}{'net_ftp_passive'} = int
+ exists $arg{Passive}
+ ? $arg{Passive}
+ : exists $ENV{FTP_PASSIVE}
+ ? $ENV{FTP_PASSIVE}
+ : defined $fire
+ ? $NetConfig{ftp_ext_passive}
+ : $NetConfig{ftp_int_passive}; # Whew! :-)
-=head1 METHODS
+ $ftp->hash(exists $arg{Hash} ? $arg{Hash} : 0, 1024);
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, falure will be returned as I<undef> or an
-empty list.
+ $ftp->autoflush(1);
-=over 4
+ $ftp->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-=item login ([LOGIN [,PASSWORD [, ACCOUNT] ] ])
+ unless ($ftp->response() == CMD_OK)
+ {
+ $ftp->close();
+ $@ = $ftp->message;
+ undef $ftp;
+ }
-Log into the remote FTP server with the given login information. If
-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.
+ $ftp;
+}
-If the connection is via a firewall then the C<authorize> method will
-be called with no arguments.
+##
+## User interface methods
+##
-=item authorize ( [AUTH [, RESP]])
-This is a protocol used by some firewall ftp proxies. It is used
-to authorise the user to send data out. If both arguments are not specified
-then C<authorize> uses C<Net::Netrc> to do a lookup.
+sub host {
+ my $me = shift;
+ ${*$me}{'net_ftp_host'};
+}
-=item type (TYPE [, ARGS])
-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.
+sub hash {
+ my $ftp = shift; # self
-=item ascii ([ARGS]) binary([ARGS]) ebcdic([ARGS]) byte([ARGS])
+ my($h,$b) = @_;
+ 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];
+}
-Synonyms for C<type> with the first arguments set correctly
+sub quit
+{
+ my $ftp = shift;
-B<NOTE> ebcdic and byte are not fully supported.
+ $ftp->_QUIT;
+ $ftp->close;
+}
-=item rename ( OLDNAME, NEWNAME )
+sub DESTROY {}
-Rename a file on the remote FTP server from C<OLDNAME> to C<NEWNAME>. This
-is done by sending the RNFR and RNTO commands.
+sub ascii { shift->type('A',@_); }
+sub binary { shift->type('I',@_); }
-=item delete ( FILENAME )
+sub ebcdic
+{
+ carp "TYPE E is unsupported, shall default to I";
+ shift->type('E',@_);
+}
-Send a request to the server to delete C<FILENAME>.
+sub byte
+{
+ carp "TYPE L is unsupported, shall default to I";
+ shift->type('L',@_);
+}
-=item cwd ( [ DIR ] )
+# Allow the user to send a command directly, BE CAREFUL !!
-Change the current working directory to C<DIR>, or / if not given.
+sub quot
+{
+ my $ftp = shift;
+ my $cmd = shift;
-=item cdup ()
+ $ftp->command( uc $cmd, @_);
+ $ftp->response();
+}
-Change directory to the parent of the current directory.
+sub site
+{
+ my $ftp = shift;
-=item pwd ()
+ $ftp->command("SITE", @_);
+ $ftp->response();
+}
-Returns the full pathname of the current directory.
+sub mdtm
+{
+ my $ftp = shift;
+ my $file = shift;
-=item rmdir ( DIR )
+ # Server Y2K bug workaround
+ #
+ # sigh; some idiotic FTP servers use ("19%d",tm.tm_year) instead of
+ # ("%d",tm.tm_year+1900). This results in an extra digit in the
+ # string returned. To account for this we allow an optional extra
+ # digit in the year. Then if the first two digits are 19 we use the
+ # remainder, otherwise we subtract 1900 from the whole year.
+
+ $ftp->_MDTM($file) && $ftp->message =~ /((\d\d)(\d\d\d?))(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
+ ? timegm($8,$7,$6,$5,$4-1,$2 eq '19' ? $3 : ($1-1900))
+ : undef;
+}
-Remove the directory with the name C<DIR>.
+sub size {
+ my $ftp = shift;
+ my $file = shift;
+ my $io;
+ if($ftp->supported("SIZE")) {
+ return $ftp->_SIZE($file)
+ ? ($ftp->message =~ /(\d+)\s*(bytes?\s*)?$/)[0]
+ : undef;
+ }
+ elsif($ftp->supported("STAT")) {
+ my @msg;
+ return undef
+ unless $ftp->_STAT($file) && (@msg = $ftp->message) == 3;
+ my $line;
+ foreach $line (@msg) {
+ return (split(/\s+/,$line))[4]
+ if $line =~ /^[-rwxSsTt]{10}/
+ }
+ }
+ else {
+ my @files = $ftp->dir($file);
+ if(@files) {
+ return (split(/\s+/,$1))[4]
+ if $files[0] =~ /^([-rwxSsTt]{10}.*)$/;
+ }
+ }
+ undef;
+}
-=item mkdir ( DIR [, RECURSE ])
+sub login {
+ my($ftp,$user,$pass,$acct) = @_;
+ my($ok,$ruser,$fwtype);
-Create a new directory with the name C<DIR>. If C<RECURSE> is I<true> then
-C<mkdir> will attempt to create all the directories in the given path.
+ unless (defined $user) {
+ require Net::Netrc;
-Returns the full pathname to the new directory.
+ my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'});
-=item ls ( [ DIR ] )
+ ($user,$pass,$acct) = $rc->lpa()
+ if ($rc);
+ }
-Get a directory listing of C<DIR>, or the current directory.
+ $user ||= "anonymous";
+ $ruser = $user;
-Returns a reference to a list of lines returned from the server.
+ $fwtype = ${*$ftp}{'net_ftp_firewall_type'}
+ || $NetConfig{'ftp_firewall_type'}
+ || 0;
-=item dir ( [ DIR ] )
+ if ($fwtype && defined ${*$ftp}{'net_ftp_firewall'}) {
+ if ($fwtype == 1 || $fwtype == 7) {
+ $user .= '@' . ${*$ftp}{'net_ftp_host'};
+ }
+ else {
+ require Net::Netrc;
-Get a directory listing of C<DIR>, or the current directory in long format.
+ my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
-Returns a reference to a list of lines returned from the server.
+ my($fwuser,$fwpass,$fwacct) = $rc ? $rc->lpa() : ();
-=item get ( REMOTE_FILE [, LOCAL_FILE ] )
+ if ($fwtype == 5) {
+ $user = join('@',$user,$fwuser,${*$ftp}{'net_ftp_host'});
+ $pass = $pass . '@' . $fwpass;
+ }
+ else {
+ if ($fwtype == 2) {
+ $user .= '@' . ${*$ftp}{'net_ftp_host'};
+ }
+ elsif ($fwtype == 6) {
+ $fwuser .= '@' . ${*$ftp}{'net_ftp_host'};
+ }
-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
-the current directory with the same leafname as the remote file.
+ $ok = $ftp->_USER($fwuser);
-Returns C<LOCAL_FILE>, or the generated local file name if C<LOCAL_FILE>
-is not given.
+ return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
-=item put ( LOCAL_FILE [, REMOTE_FILE ] )
+ $ok = $ftp->_PASS($fwpass || "");
-Put a file on the remote server. C<LOCAL_FILE> may be a name or a filehandle.
-If C<LOCAL_FILE> is a filehandle then C<REMOTE_FILE> must be specified. If
-C<REMOTE_FILE> is not specified then the file will be stored in the current
-directory with the same leafname as C<LOCAL_FILE>.
+ return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
-Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
-is not given.
+ $ok = $ftp->_ACCT($fwacct)
+ if defined($fwacct);
-=item put_unique ( LOCAL_FILE [, REMOTE_FILE ] )
+ if ($fwtype == 3) {
+ $ok = $ftp->command("SITE",${*$ftp}{'net_ftp_host'})->response;
+ }
+ elsif ($fwtype == 4) {
+ $ok = $ftp->command("OPEN",${*$ftp}{'net_ftp_host'})->response;
+ }
-Same as put but uses the C<STOU> command.
+ return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
+ }
+ }
+ }
-Returns the name of the file on the server.
+ $ok = $ftp->_USER($user);
-=item append ( LOCAL_FILE [, REMOTE_FILE ] )
+ # Some dumb firewalls don't prefix the connection messages
+ $ok = $ftp->response()
+ if ($ok == CMD_OK && $ftp->code == 220 && $user =~ /\@/);
-Same as put but appends to the file on the remote server.
+ if ($ok == CMD_MORE) {
+ unless(defined $pass) {
+ require Net::Netrc;
-Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
-is not given.
+ my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser);
-=item unique_name ()
+ ($ruser,$pass,$acct) = $rc->lpa()
+ if ($rc);
-Returns the name of the last file stored on the server using the
-C<STOU> command.
+ $pass = '-anonymous@'
+ if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o));
+ }
-=item mdtm ( FILE )
+ $ok = $ftp->_PASS($pass || "");
+ }
-Returns the I<modification time> of the given file
+ $ok = $ftp->_ACCT($acct)
+ if (defined($acct) && ($ok == CMD_MORE || $ok == CMD_OK));
-=item size ( FILE )
+ if ($fwtype == 7 && $ok == CMD_OK && defined ${*$ftp}{'net_ftp_firewall'}) {
+ my($f,$auth,$resp) = _auth_id($ftp);
+ $ftp->authorize($auth,$resp) if defined($resp);
+ }
-Returns the size in bytes for the given file.
+ $ok == CMD_OK;
+}
-=back
+sub account
+{
+ @_ == 2 or croak 'usage: $ftp->account( ACCT )';
+ my $ftp = shift;
+ my $acct = shift;
+ $ftp->_ACCT($acct) == CMD_OK;
+}
-The following methods can return different results depending on
-how they are called. If the user explicitly calls either
-of the C<pasv> or C<port> methods then these methods will
-return a I<true> or I<false> value. If the user does not
-call either of these methods then the result will be a
-reference to a C<Net::FTP::dataconn> based object.
+sub _auth_id {
+ my($ftp,$auth,$resp) = @_;
-=over 4
+ unless(defined $resp)
+ {
+ require Net::Netrc;
-=item nlst ( [ DIR ] )
+ $auth ||= eval { (getpwuid($>))[0] } || $ENV{NAME};
-Send a C<NLST> command to the server, with an optional parameter.
+ my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}, $auth)
+ || Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
-=item list ( [ DIR ] )
+ ($auth,$resp) = $rc->lpa()
+ if ($rc);
+ }
+ ($ftp,$auth,$resp);
+}
-Same as C<nlst> but using the C<LIST> command
+sub authorize
+{
+ @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize( [AUTH [, RESP]])';
-=item retr ( FILE )
+ my($ftp,$auth,$resp) = &_auth_id;
-Begin the retrieval of a file called C<FILE> from the remote server.
+ my $ok = $ftp->_AUTH($auth || "");
-=item stor ( FILE )
+ $ok = $ftp->_RESP($resp || "")
+ if ($ok == CMD_MORE);
-Tell the server that you wish to store a file. C<FILE> is the
-name of the new file that should be created.
+ $ok == CMD_OK;
+}
-=item stou ( FILE )
+sub rename
+{
+ @_ == 3 or croak 'usage: $ftp->rename(FROM, TO)';
-Same as C<stor> but using the C<STOU> command. The name of the unique
-file which was created on the server will be avalaliable via the C<unique_name>
-method after the data connection has been closed.
+ my($ftp,$from,$to) = @_;
-=item appe ( FILE )
+ $ftp->_RNFR($from)
+ && $ftp->_RNTO($to);
+}
-Tell the server that we want to append some data to the end of a file
-called C<FILE>. If this file does not exist then create it.
+sub type
+{
+ my $ftp = shift;
+ my $type = shift;
+ my $oldval = ${*$ftp}{'net_ftp_type'};
-=back
+ return $oldval
+ unless (defined $type);
-If for some reason you want to have complete control over the data connection,
-this includes generating it and calling the C<response> method when required,
-then the user can use these methods to do so.
+ return undef
+ unless ($ftp->_TYPE($type,@_));
-However calling these methods only affects the use of the methods above that
-can return a data connection. They have no effect on methods C<get>, C<put>,
-C<put_unique> and those that do not require data connections.
+ ${*$ftp}{'net_ftp_type'} = join(" ",$type,@_);
-=over 4
+ $oldval;
+}
-=item port ( [ PORT ] )
+sub alloc
+{
+ my $ftp = shift;
+ my $size = shift;
+ my $oldval = ${*$ftp}{'net_ftp_allo'};
-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
-sent to the server.
+ return $oldval
+ unless (defined $size);
-=item pasv ()
+ return undef
+ unless ($ftp->_ALLO($size,@_));
-Tell the server to go into passive mode. Returns the text that represents the
-port on which the server is listening, this text is in a suitable form to
-sent to another ftp server using the C<port> method.
+ ${*$ftp}{'net_ftp_allo'} = join(" ",$size,@_);
-=back
+ $oldval;
+}
-The following methods can be used to transfer files between two remote
-servers, providing that these two servers can connect directly to each other.
+sub abort
+{
+ my $ftp = shift;
-=over 4
+ send($ftp,pack("CCC", $TELNET_IAC, $TELNET_IP, $TELNET_IAC),MSG_OOB);
-=item pasv_xfer ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
+ $ftp->command(pack("C",$TELNET_DM) . "ABOR");
-This method will do a file transfer between two remote ftp servers. If
-C<DEST_FILE> is omitted then the leaf name of C<SRC_FILE> will be used.
+ ${*$ftp}{'net_ftp_dataconn'}->close()
+ if defined ${*$ftp}{'net_ftp_dataconn'};
-=item pasv_wait ( NON_PASV_SERVER )
+ $ftp->response();
-This method can be used to wait for a transfer to complete between a passive
-server and a non-passive server. The method should be called on the passive
-server with the C<Net::FTP> object for the non-passive server passed as an
-argument.
+ $ftp->status == CMD_OK;
+}
-=item abort ()
+sub get
+{
+ my($ftp,$remote,$local,$where) = @_;
-Abort the current data transfer.
+ my($loc,$len,$buf,$resp,$data);
+ local *FD;
-=item quit ()
+ my $localfd = ref($local) || ref(\$local) eq "GLOB";
-Send the QUIT command to the remote FTP server and close the socket connection.
+ ($local = $remote) =~ s#^.*/##
+ unless(defined $local);
-=back
+ croak("Bad remote filename '$remote'\n")
+ if $remote =~ /[\r\n]/s;
-=head2 Methods for the adventurous
+ ${*$ftp}{'net_ftp_rest'} = $where if defined $where;
+ my $rest = ${*$ftp}{'net_ftp_rest'};
-C<Net::FTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
-be used to send commands to the remote FTP server.
+ delete ${*$ftp}{'net_ftp_port'};
+ delete ${*$ftp}{'net_ftp_pasv'};
-=over 4
+ $data = $ftp->retr($remote) or
+ return undef;
-=item quot (CMD [,ARGS])
+ if($localfd)
+ {
+ $loc = $local;
+ }
+ else
+ {
+ $loc = \*FD;
-Send a command, that Net::FTP does not directly support, to the remote
-server and wait for a response.
+ unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($rest ? O_APPEND : O_TRUNC)))
+ {
+ carp "Cannot open Local file $local: $!\n";
+ $data->abort;
+ return undef;
+ }
+ }
-Returns most significant digit of the response code.
+ if($ftp->type eq 'I' && !binmode($loc))
+ {
+ carp "Cannot binmode Local file $local: $!\n";
+ $data->abort;
+ close($loc) unless $localfd;
+ return undef;
+ }
-B<WARNING> This call should only be used on commands that do not require
-data connections. Misuse of this method can hang the connection.
+ $buf = '';
+ my($count,$hashh,$hashb,$ref) = (0);
-=back
+ ($hashh,$hashb) = @$ref
+ if($ref = ${*$ftp}{'net_ftp_hash'});
-=head1 THE dataconn CLASS
+ my $blksize = ${*$ftp}{'net_ftp_blksize'};
+ local $\; # Just in case
-Some of the methods defined in C<Net::FTP> return an object which will
-be derived from this class.The dataconn class itself is derived from
-the C<IO::Socket::INET> class, so any normal IO operations can be performed.
-However the following methods are defined in the dataconn class and IO should
-be performed using these.
+ while(1)
+ {
+ last unless $len = $data->read($buf,$blksize);
-=over 4
+ if (trEBCDIC && $ftp->type ne 'I')
+ {
+ $buf = $ftp->toebcdic($buf);
+ $len = length($buf);
+ }
-=item read ( BUFFER, SIZE [, TIMEOUT ] )
+ if($hashh) {
+ $count += $len;
+ print $hashh "#" x (int($count / $hashb));
+ $count %= $hashb;
+ }
+ unless(print $loc $buf)
+ {
+ carp "Cannot write to Local file $local: $!\n";
+ $data->abort;
+ close($loc)
+ unless $localfd;
+ return undef;
+ }
+ }
-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.
+ print $hashh "\n" if $hashh;
-Returns the number of bytes read before any <CRLF> translation.
+ unless ($localfd)
+ {
+ unless (close($loc))
+ {
+ carp "Cannot close file $local (perhaps disk space) $!\n";
+ return undef;
+ }
+ }
-=item write ( BUFFER, SIZE [, TIMEOUT ] )
+ unless ($data->close()) # implied $ftp->response
+ {
+ carp "Unable to close datastream";
+ return undef;
+ }
-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.
+ return $local;
+}
-Returns the number of bytes written before any <CRLF> translation.
+sub cwd
+{
+ @_ == 1 || @_ == 2 or croak 'usage: $ftp->cwd( [ DIR ] )';
-=item abort ()
+ my($ftp,$dir) = @_;
-Abort the current data transfer.
+ $dir = "/" unless defined($dir) && $dir =~ /\S/;
-=item close ()
+ $dir eq ".."
+ ? $ftp->_CDUP()
+ : $ftp->_CWD($dir);
+}
-Close the data connection and get a response from the FTP server. Returns
-I<true> if the connection was closed sucessfully and the first digit of
-the response from the server was a '2'.
+sub cdup
+{
+ @_ == 1 or croak 'usage: $ftp->cdup()';
+ $_[0]->_CDUP;
+}
-=back
+sub pwd
+{
+ @_ == 1 || croak 'usage: $ftp->pwd()';
+ my $ftp = shift;
-=head1 AUTHOR
+ $ftp->_PWD();
+ $ftp->_extract_path;
+}
-Graham Barr <Graham.Barr@tiuk.ti.com>
+# rmdir( $ftp, $dir, [ $recurse ] )
+#
+# Removes $dir on remote host via FTP.
+# $ftp is handle for remote host
+#
+# If $recurse is TRUE, the directory and deleted recursively.
+# This means all of its contents and subdirectories.
+#
+# Initial version contributed by Dinkum Software
+#
+sub rmdir
+{
+ @_ == 2 || @_ == 3 or croak('usage: $ftp->rmdir( DIR [, RECURSE ] )');
-=head1 REVISION
+ # Pick off the args
+ my ($ftp, $dir, $recurse) = @_ ;
+ my $ok;
-$Revision: 2.8 $
-$Date: 1996/09/05 06:53:58 $
+ return $ok
+ if $ok = $ftp->_RMD( $dir ) or !$recurse;
-The VERSION is derived from the revision by changing each number after the
-first dot into a 2 digit number so
+ # Try to delete the contents
+ # Get a list of all the files in the directory
+ my @filelist = grep { !/^\.{1,2}$/ } $ftp->ls($dir);
- Revision 1.8 => VERSION 1.08
- Revision 1.2.3 => VERSION 1.0203
+ return undef
+ unless @filelist; # failed, it is probably not a directory
-=head1 SEE ALSO
+ # Go thru and delete each file or the directory
+ my $file;
+ foreach $file (map { m,/, ? $_ : "$dir/$_" } @filelist)
+ {
+ next # successfully deleted the file
+ if $ftp->delete($file);
+
+ # Failed to delete it, assume its a directory
+ # Recurse and ignore errors, the final rmdir() will
+ # fail on any errors here
+ return $ok
+ unless $ok = $ftp->rmdir($file, 1) ;
+ }
-L<Net::Netrc>
-L<Net::Cmd>
+ # Directory should be empty
+ # Try to remove the directory again
+ # Pass results directly to caller
+ # If any of the prior deletes failed, this
+ # rmdir() will fail because directory is not empty
+ return $ftp->_RMD($dir) ;
+}
-=head1 CREDITS
+sub restart
+{
+ @_ == 2 || croak 'usage: $ftp->restart( BYTE_OFFSET )';
-Henry Gabryjelski <henryg@WPI.EDU> - for the suggestion of creating directories
-recursively.
+ my($ftp,$where) = @_;
-=head1 COPYRIGHT
+ ${*$ftp}{'net_ftp_rest'} = $where;
-Copyright (c) 1995 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.
+ return undef;
+}
-=cut
-require 5.001;
+sub mkdir
+{
+ @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )';
-use strict;
-use vars qw(@ISA $VERSION);
-use Carp;
+ my($ftp,$dir,$recurse) = @_;
-use Socket 1.3;
-use IO::Socket;
-use Time::Local;
-use Net::Cmd;
-use Net::Telnet qw(TELNET_IAC TELNET_IP TELNET_DM);
+ $ftp->_MKD($dir) || $recurse or
+ return undef;
-$VERSION = do{my @r=(q$Revision: 2.8 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
-@ISA = qw(Exporter Net::Cmd IO::Socket::INET);
+ my $path = $dir;
-sub new
+ unless($ftp->ok)
+ {
+ my @path = split(m#(?=/+)#, $dir);
+
+ $path = "";
+
+ while(@path)
+ {
+ $path .= shift @path;
+
+ $ftp->_MKD($path);
+
+ $path = $ftp->_extract_path($path);
+ }
+
+ # 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;
+ $ftp->cwd($pwd);
+ }
+ else
+ {
+ undef $path;
+ }
+ $ftp->set_status($status,$message);
+ }
+ }
+
+ $path;
+}
+
+sub delete
{
- my $pkg = shift;
- my $peer = shift;
- my %arg = @_;
+ @_ == 2 || croak 'usage: $ftp->delete( FILENAME )';
- my $host = $peer;
- my $fire = undef;
+ $_[0]->_DELE($_[1]);
+}
+
+sub put { shift->_store_cmd("stor",@_) }
+sub put_unique { shift->_store_cmd("stou",@_) }
+sub append { shift->_store_cmd("appe",@_) }
+
+sub nlst { shift->_data_cmd("NLST",@_) }
+sub list { shift->_data_cmd("LIST",@_) }
+sub retr { shift->_data_cmd("RETR",@_) }
+sub stor { shift->_data_cmd("STOR",@_) }
+sub stou { shift->_data_cmd("STOU",@_) }
+sub appe { shift->_data_cmd("APPE",@_) }
+
+sub _store_cmd
+{
+ my($ftp,$cmd,$local,$remote) = @_;
+ my($loc,$sock,$len,$buf);
+ local *FD;
+
+ my $localfd = ref($local) || ref(\$local) eq "GLOB";
+
+ unless(defined $remote)
+ {
+ croak 'Must specify remote filename with stream input'
+ if $localfd;
- unless(defined inet_aton($peer))
+ require File::Basename;
+ $remote = File::Basename::basename($local);
+ }
+ if( defined ${*$ftp}{'net_ftp_allo'} )
{
- $fire = $ENV{FTP_FIREWALL} || $arg{Firewall} || undef;
- if(defined $fire)
+ 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($localfd)
+ {
+ $loc = $local;
+ }
+ else
+ {
+ $loc = \*FD;
+
+ unless(sysopen($loc, $local, O_RDONLY))
{
- $peer = $fire;
- delete $arg{Port};
+ carp "Cannot open Local file $local: $!\n";
+ return undef;
}
}
- my $ftp = $pkg->SUPER::new(PeerAddr => $peer,
- PeerPort => $arg{Port} || 'ftp(21)',
- Proto => 'tcp',
- Timeout => defined $arg{Timeout}
- ? $arg{Timeout}
- : 120
- ) or return undef;
+ if($ftp->type eq 'I' && !binmode($loc))
+ {
+ carp "Cannot binmode Local file $local: $!\n";
+ return undef;
+ }
- ${*$ftp}{'net_ftp_passive'} = $arg{Passive} || 0; # Always use pasv mode
- ${*$ftp}{'net_ftp_host'} = $host; # Remote hostname
- ${*$ftp}{'net_ftp_type'} = 'A'; # ASCII/binary/etc mode
+ delete ${*$ftp}{'net_ftp_port'};
+ delete ${*$ftp}{'net_ftp_pasv'};
- ${*$ftp}{'net_ftp_firewall'} = $fire
- if defined $fire;
+ $sock = $ftp->_data_cmd($cmd, $remote) or
+ return undef;
- $ftp->autoflush(1);
+ $remote = ($ftp->message =~ /FILE:\s*(.*)/)[0]
+ if 'STOU' eq uc $cmd;
- $ftp->debug(exists $arg{Debug} ? $arg{Debug} : undef);
+ my $blksize = ${*$ftp}{'net_ftp_blksize'};
- unless ($ftp->response() == CMD_OK)
+ my($count,$hashh,$hashb,$ref) = (0);
+
+ ($hashh,$hashb) = @$ref
+ if($ref = ${*$ftp}{'net_ftp_hash'});
+
+ while(1)
{
- $ftp->SUPER::close();
- undef $ftp;
+ last unless $len = read($loc,$buf="",$blksize);
+
+ if (trEBCDIC && $ftp->type ne 'I')
+ {
+ $buf = $ftp->toascii($buf);
+ $len = length($buf);
+ }
+
+ if($hashh) {
+ $count += $len;
+ print $hashh "#" x (int($count / $hashb));
+ $count %= $hashb;
+ }
+
+ my $wlen;
+ unless(defined($wlen = $sock->write($buf,$len)) && $wlen == $len)
+ {
+ $sock->abort;
+ close($loc)
+ unless $localfd;
+ print $hashh "\n" if $hashh;
+ return undef;
+ }
}
- $ftp;
+ print $hashh "\n" if $hashh;
+
+ close($loc)
+ unless $localfd;
+
+ $sock->close() or
+ return undef;
+
+ 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;
+}
+
+sub port
+{
+ @_ == 1 || @_ == 2 or croak 'usage: $ftp->port([PORT])';
+
+ my($ftp,$port) = @_;
+ my $ok;
+
+ delete ${*$ftp}{'net_ftp_intern_port'};
+
+ unless(defined $port)
+ {
+ # create a Listen socket at same address as the command socket
+
+ ${*$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(/\./,$listen->sockhost));
+
+ $port = join(',', @myaddr, $myport >> 8, $myport & 0xff);
+
+ ${*$ftp}{'net_ftp_intern_port'} = 1;
+ }
+
+ $ok = $ftp->_PORT($port);
+
+ ${*$ftp}{'net_ftp_port'} = $port;
+
+ $ok;
+}
+
+sub ls { shift->_list_cmd("NLST",@_); }
+sub dir { shift->_list_cmd("LIST",@_); }
+
+sub pasv
+{
+ @_ == 1 or croak 'usage: $ftp->pasv()';
+
+ my $ftp = shift;
+
+ delete ${*$ftp}{'net_ftp_intern_port'};
+
+ $ftp->_PASV && $ftp->message =~ /(\d+(,\d+)+)/
+ ? ${*$ftp}{'net_ftp_pasv'} = $1
+ : undef;
+}
+
+sub unique_name
+{
+ my $ftp = shift;
+ ${*$ftp}{'net_ftp_unique'} || undef;
+}
+
+sub supported {
+ @_ == 2 or croak 'usage: $ftp->supported( CMD )';
+ my $ftp = shift;
+ my $cmd = uc shift;
+ my $hash = ${*$ftp}{'net_ftp_supported'} ||= {};
+
+ return $hash->{$cmd}
+ if exists $hash->{$cmd};
+
+ return $hash->{$cmd} = 0
+ unless $ftp->_HELP($cmd);
+
+ my $text = $ftp->message;
+ if($text =~ /following\s+commands/i) {
+ $text =~ s/^.*\n//;
+ while($text =~ /(\*?)(\w+)(\*?)/sg) {
+ $hash->{"\U$2"} = !length("$1$3");
+ }
+ }
+ else {
+ $hash->{$cmd} = $text !~ /unimplemented/i;
+ }
+
+ $hash->{$cmd} ||= 0;
}
##
-## User interface methods
+## Deprecated methods
##
-sub quit
+sub lsl
+{
+ carp "Use of Net::FTP::lsl deprecated, use 'dir'"
+ if $^W;
+ goto &dir;
+}
+
+sub authorise
+{
+ carp "Use of Net::FTP::authorise deprecated, use 'authorize'"
+ if $^W;
+ goto &authorize;
+}
+
+
+##
+## Private methods
+##
+
+sub _extract_path
+{
+ my($ftp, $path) = @_;
+
+ # This tries to work both with and without the quote doubling
+ # convention (RFC 959 requires it, but the first 3 servers I checked
+ # didn't implement it). It will fail on a server which uses a quote in
+ # the message which isn't a part of or surrounding the path.
+ $ftp->ok &&
+ $ftp->message =~ /(?:^|\s)\"(.*)\"(?:$|\s)/ &&
+ ($path = $1) =~ s/\"\"/\"/g;
+
+ $path;
+}
+
+##
+## Communication methods
+##
+
+sub _dataconn
{
my $ftp = shift;
+ my $data = undef;
+ my $pkg = "Net::FTP::" . $ftp->type;
+
+ eval "require " . $pkg;
+
+ $pkg =~ s/ /_/g;
+
+ delete ${*$ftp}{'net_ftp_dataconn'};
+
+ if(defined ${*$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'
+ );
+ }
+ elsif(defined ${*$ftp}{'net_ftp_listen'})
+ {
+ $data = ${*$ftp}{'net_ftp_listen'}->accept($pkg);
+ close(delete ${*$ftp}{'net_ftp_listen'});
+ }
+
+ if($data)
+ {
+ ${*$data} = "";
+ $data->timeout($ftp->timeout);
+ ${*$ftp}{'net_ftp_dataconn'} = $data;
+ ${*$data}{'net_ftp_cmd'} = $ftp;
+ ${*$data}{'net_ftp_blksize'} = ${*$ftp}{'net_ftp_blksize'};
+ }
- $ftp->_QUIT
- && $ftp->SUPER::close;
+ $data;
}
-sub close
+sub _list_cmd
{
my $ftp = shift;
+ my $cmd = uc shift;
- ref($ftp)
- && defined fileno($ftp)
- && $ftp->quit;
-}
-
-sub DESTROY { shift->close }
+ delete ${*$ftp}{'net_ftp_port'};
+ delete ${*$ftp}{'net_ftp_pasv'};
-sub ascii { shift->type('A',@_); }
-sub binary { shift->type('I',@_); }
+ my $data = $ftp->_data_cmd($cmd,@_);
-sub ebcdic
-{
- carp "TYPE E is unsupported, shall default to I";
- shift->type('E',@_);
-}
+ return
+ unless(defined $data);
-sub byte
-{
- carp "TYPE L is unsupported, shall default to I";
- shift->type('L',@_);
-}
+ require Net::FTP::A;
+ bless $data, "Net::FTP::A"; # Force ASCII mode
-# Allow the user to send a command directly, BE CAREFUL !!
+ my $databuf = '';
+ my $buf = '';
+ my $blksize = ${*$ftp}{'net_ftp_blksize'};
-sub quot
-{
- my $ftp = shift;
- my $cmd = shift;
+ while($data->read($databuf,$blksize)) {
+ $buf .= $databuf;
+ }
- $ftp->command( uc $cmd, @_);
- $ftp->response();
-}
+ my $list = [ split(/\n/,$buf) ];
-sub mdtm
-{
- my $ftp = shift;
- my $file = shift;
+ $data->close();
- return undef
- unless $ftp->_MDTM($file);
+ if (trEBCDIC)
+ {
+ for (@$list) { $_ = $ftp->toebcdic($_) }
+ }
- my @gt = reverse ($ftp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/);
- $gt[5] -= 1;
- timegm(@gt);
+ wantarray ? @{$list}
+ : $list;
}
-sub size
+sub _data_cmd
{
- my $ftp = shift;
- my $file = shift;
-
- $ftp->_SIZE($file)
- ? ($ftp->message =~ /(\d+)/)[0]
- : undef;
-}
+ my $ftp = shift;
+ my $cmd = uc shift;
+ my $ok = 1;
+ my $where = delete ${*$ftp}{'net_ftp_rest'} || 0;
+ my $arg;
-sub login
-{
- my($ftp,$user,$pass,$acct) = @_;
- my($ok,$ruser);
+ for $arg (@_) {
+ croak("Bad argument '$arg'\n")
+ if $arg =~ /[\r\n]/s;
+ }
- unless (defined $user)
+ if(${*$ftp}{'net_ftp_passive'} &&
+ !defined ${*$ftp}{'net_ftp_pasv'} &&
+ !defined ${*$ftp}{'net_ftp_port'})
{
- require Net::Netrc;
+ my $data = undef;
- my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'});
+ $ok = defined $ftp->pasv;
+ $ok = $ftp->_REST($where)
+ if $ok && $where;
- ($user,$pass,$acct) = $rc->lpa()
- if ($rc);
+ if($ok)
+ {
+ $ftp->command($cmd,@_);
+ $data = $ftp->_dataconn();
+ $ok = CMD_INFO == $ftp->response();
+ if($ok)
+ {
+ $data->reading
+ if $data && $cmd =~ /RETR|LIST|NLST/;
+ return $data
+ }
+ $data->_close
+ if $data;
+ }
+ return undef;
}
- $user ||= "anonymous";
- $ruser = $user;
+ $ok = $ftp->port
+ unless (defined ${*$ftp}{'net_ftp_port'} ||
+ defined ${*$ftp}{'net_ftp_pasv'});
- if(defined ${*$ftp}{'net_ftp_firewall'})
- {
- $user .= "@" . ${*$ftp}{'net_ftp_host'};
- }
+ $ok = $ftp->_REST($where)
+ if $ok && $where;
- $ok = $ftp->_USER($user);
+ return undef
+ unless $ok;
- # Some dumb firewall's don't prefix the connection messages
- $ok = $ftp->response()
- if($ok == CMD_OK && $ftp->code == 220 && $user =~ /\@/);
+ $ftp->command($cmd,@_);
- if ($ok == CMD_MORE)
- {
- unless(defined $pass)
- {
- require Net::Netrc;
+ return 1
+ if(defined ${*$ftp}{'net_ftp_pasv'});
- my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser);
+ $ok = CMD_INFO == $ftp->response();
- ($ruser,$pass,$acct) = $rc->lpa()
- if ($rc);
+ return $ok
+ unless exists ${*$ftp}{'net_ftp_intern_port'};
- $pass = "-" . (getpwuid($>))[0] . "@"
- if (!defined $pass && $ruser =~ /^anonymous/o);
- }
+ if($ok) {
+ my $data = $ftp->_dataconn();
- $ok = $ftp->_PASS($pass || "");
- }
+ $data->reading
+ if $data && $cmd =~ /RETR|LIST|NLST/;
- $ok = $ftp->_ACCT($acct || "")
- if ($ok == CMD_MORE);
+ return $data;
+ }
- $ftp->authorize()
- if($ok == CMD_OK && defined ${*$ftp}{'net_ftp_firewall'});
- $ok == CMD_OK;
+ close(delete ${*$ftp}{'net_ftp_listen'});
+
+ return undef;
}
-sub authorize
+##
+## Over-ride methods (Net::Cmd)
+##
+
+sub debug_text { $_[2] =~ /^(pass|resp|acct)/i ? "$1 ....\n" : $_[2]; }
+
+sub command
{
- @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize( [AUTH [, RESP]])';
+ my $ftp = shift;
- my($ftp,$auth,$resp) = @_;
+ delete ${*$ftp}{'net_ftp_port'};
+ $ftp->SUPER::command(@_);
+}
- unless(defined $resp)
- {
- require Net::Netrc;
+sub response
+{
+ my $ftp = shift;
+ my $code = $ftp->SUPER::response();
- $auth ||= (getpwuid($>))[0];
+ delete ${*$ftp}{'net_ftp_pasv'}
+ if ($code != CMD_MORE && $code != CMD_INFO);
- my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}, $auth)
- || Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
+ $code;
+}
- ($auth,$resp) = $rc->lpa()
- if($rc);
- }
+sub parse_response
+{
+ return ($1, $2 eq "-")
+ if $_[1] =~ s/^(\d\d\d)(.?)//o;
- my $ok = $ftp->_AUTH($auth || "");
+ my $ftp = shift;
- $ok = $ftp->_RESP($resp || "")
- if ($ok == CMD_MORE);
+ # Darn MS FTP server is a load of CRAP !!!!
+ return ()
+ unless ${*$ftp}{'net_cmd_code'} + 0;
- $ok == CMD_OK;
+ (${*$ftp}{'net_cmd_code'},1);
}
-sub rename
-{
- @_ == 3 or croak 'usage: $ftp->rename(FROM, TO)';
+##
+## Allow 2 servers to talk directly
+##
- my($ftp,$from,$to) = @_;
+sub pasv_xfer {
+ my($sftp,$sfile,$dftp,$dfile,$unique) = @_;
- $ftp->_RNFR($from)
- && $ftp->_RNTO($to);
+ ($dfile = $sfile) =~ s#.*/##
+ unless(defined $dfile);
+
+ my $port = $sftp->pasv or
+ return undef;
+
+ $dftp->port($port) or
+ return undef;
+
+ return undef
+ unless($unique ? $dftp->stou($dfile) : $dftp->stor($dfile));
+
+ unless($sftp->retr($sfile) && $sftp->response == CMD_INFO) {
+ $sftp->retr($sfile);
+ $dftp->abort;
+ $dftp->response();
+ return undef;
+ }
+
+ $dftp->pasv_wait($sftp);
}
-sub type
+sub pasv_wait
{
- my $ftp = shift;
- my $type = shift;
- my $oldval = ${*$ftp}{'net_ftp_type'};
+ @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)';
- return $oldval
- unless (defined $type);
+ my($ftp, $non_pasv) = @_;
+ my($file,$rin,$rout);
+
+ vec($rin='',fileno($ftp),1) = 1;
+ select($rout=$rin, undef, undef, undef);
+
+ $ftp->response();
+ $non_pasv->response();
return undef
- unless ($ftp->_TYPE($type,@_));
+ unless $ftp->ok() && $non_pasv->ok();
- ${*$ftp}{'net_ftp_type'} = join(" ",$type,@_);
+ return $1
+ if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/;
- $oldval;
+ return $1
+ if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/;
+
+ return 1;
}
-sub abort
-{
- my $ftp = shift;
+sub cmd { shift->command(@_)->response() }
+
+########################################
+#
+# RFC959 commands
+#
+
+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 _QUIT { shift->command("QUIT")->response() == CMD_OK }
+sub _DELE { shift->command("DELE",@_)->response() == CMD_OK }
+sub _CWD { shift->command("CWD", @_)->response() == CMD_OK }
+sub _PORT { shift->command("PORT",@_)->response() == CMD_OK }
+sub _RMD { shift->command("RMD", @_)->response() == CMD_OK }
+sub _MKD { shift->command("MKD", @_)->response() == CMD_OK }
+sub _PWD { shift->command("PWD", @_)->response() == CMD_OK }
+sub _TYPE { shift->command("TYPE",@_)->response() == CMD_OK }
+sub _RNTO { shift->command("RNTO",@_)->response() == CMD_OK }
+sub _RESP { shift->command("RESP",@_)->response() == CMD_OK }
+sub _MDTM { shift->command("MDTM",@_)->response() == CMD_OK }
+sub _SIZE { shift->command("SIZE",@_)->response() == CMD_OK }
+sub _HELP { shift->command("HELP",@_)->response() == CMD_OK }
+sub _STAT { shift->command("STAT",@_)->response() == CMD_OK }
+sub _APPE { shift->command("APPE",@_)->response() == CMD_INFO }
+sub _LIST { shift->command("LIST",@_)->response() == CMD_INFO }
+sub _NLST { shift->command("NLST",@_)->response() == CMD_INFO }
+sub _RETR { shift->command("RETR",@_)->response() == CMD_INFO }
+sub _STOR { shift->command("STOR",@_)->response() == CMD_INFO }
+sub _STOU { shift->command("STOU",@_)->response() == CMD_INFO }
+sub _RNFR { shift->command("RNFR",@_)->response() == CMD_MORE }
+sub _REST { shift->command("REST",@_)->response() == CMD_MORE }
+sub _USER { shift->command("user",@_)->response() } # A certain brain dead firewall :-)
+sub _PASS { shift->command("PASS",@_)->response() }
+sub _ACCT { shift->command("ACCT",@_)->response() }
+sub _AUTH { shift->command("AUTH",@_)->response() }
- send($ftp,pack("CC",TELNET_IAC,TELNET_IP),0);
- send($ftp,pack("C", TELNET_IAC),MSG_OOB);
- send($ftp,pack("C", TELNET_DM),0);
+sub _SMNT { shift->unsupported(@_) }
+sub _MODE { shift->unsupported(@_) }
+sub _SYST { shift->unsupported(@_) }
+sub _STRU { shift->unsupported(@_) }
+sub _REIN { shift->unsupported(@_) }
- $ftp->command("ABOR");
+1;
- defined ${*$ftp}{'net_ftp_dataconn'}
- ? ${*$ftp}{'net_ftp_dataconn'}->close()
- : $ftp->response();
+__END__
- $ftp->response()
- if $ftp->status == CMD_REJECT;
+=head1 NAME
- $ftp->status == CMD_OK;
-}
+Net::FTP - FTP Client class
-sub get
-{
- my($ftp,$remote,$local,$where) = @_;
+=head1 SYNOPSIS
- my($loc,$len,$buf,$resp,$localfd,$data);
- local *FD;
+ use Net::FTP;
- $localfd = ref($local) ? fileno($local)
- : undef;
+ $ftp = Net::FTP->new("some.host.name", Debug => 0)
+ or die "Cannot connect to some.host.name: $@";
- ($local = $remote) =~ s#^.*/##
- unless(defined $local);
+ $ftp->login("anonymous",'-anonymous@')
+ or die "Cannot login ", $ftp->message;
- ${*$ftp}{'net_ftp_rest'} = $where
- if ($where);
+ $ftp->cwd("/pub")
+ or die "Cannot change working directory ", $ftp->message;
- delete ${*$ftp}{'net_ftp_port'};
- delete ${*$ftp}{'net_ftp_pasv'};
+ $ftp->get("that.file")
+ or die "get failed ", $ftp->message;
- $data = $ftp->retr($remote) or
- return undef;
+ $ftp->quit;
- if(defined $localfd)
- {
- $loc = $local;
- }
- else
- {
- $loc = \*FD;
+=head1 DESCRIPTION
- unless(($where) ? open($loc,">>$local") : open($loc,">$local"))
- {
- carp "Cannot open Local file $local: $!\n";
- $data->abort;
- return undef;
- }
- }
- if ($ftp->binary && !binmode($loc))
- {
- carp "Cannot binmode Local file $local: $!\n";
- return undef;
- }
+C<Net::FTP> is a class implementing a simple FTP client in Perl as
+described in RFC959. It provides wrappers for a subset of the RFC959
+commands.
+
+=head1 OVERVIEW
+
+FTP stands for File Transfer Protocol. It is a way of transferring
+files between networked machines. The protocol defines a client
+(whose commands are provided by this module) and a server (not
+implemented in this module). Communication is always initiated by the
+client, and the server responds with a message and a status code (and
+sometimes with data).
+
+The FTP protocol allows files to be sent to or fetched from the
+server. Each transfer involves a B<local file> (on the client) and a
+B<remote file> (on the server). In this module, the same file name
+will be used for both local and remote if only one is specified. This
+means that transferring remote file C</path/to/file> will try to put
+that file in C</path/to/file> locally, unless you specify a local file
+name.
+
+The protocol also defines several standard B<translations> which the
+file can undergo during transfer. These are ASCII, EBCDIC, binary,
+and byte. ASCII is the default type, and indicates that the sender of
+files will translate the ends of lines to a standard representation
+which the receiver will then translate back into their local
+representation. EBCDIC indicates the file being transferred is in
+EBCDIC format. Binary (also known as image) format sends the data as
+a contiguous bit stream. Byte format transfers the data as bytes, the
+values of which remain the same regardless of differences in byte size
+between the two machines (in theory - in practice you should only use
+this if you really know what you're doing).
- $buf = '';
+=head1 CONSTRUCTOR
- do
- {
- $len = $data->read($buf,1024);
- }
- while($len > 0 && syswrite($loc,$buf,$len) == $len);
+=over 4
- close($loc)
- unless defined $localfd;
-
- $data->close(); # implied $ftp->response
+=item new ([ HOST ] [, OPTIONS ])
- return $local;
-}
+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.
-sub cwd
-{
- @_ == 2 || @_ == 3 or croak 'usage: $ftp->cwd( [ DIR ] )';
+C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
+Possible options are:
- my($ftp,$dir) = @_;
+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.
- $dir ||= "/";
- $dir eq ".."
- ? $ftp->_CDUP()
- : $ftp->_CWD($dir);
-}
+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 an ftp proxy.
-sub cdup
-{
- @_ == 1 or croak 'usage: $ftp->cdup()';
- $_[0]->_CDUP;
-}
+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>.
-sub pwd
-{
- @_ == 1 || croak 'usage: $ftp->pwd()';
- my $ftp = shift;
+B<BlockSize> - This is the block size that Net::FTP will use when doing
+transfers. (defaults to 10240)
- $ftp->_PWD();
- $ftp->_extract_path;
-}
+B<Port> - The port number to connect to on the remote machine for the
+FTP connection
-sub rmdir
-{
- @_ == 2 || croak 'usage: $ftp->rmdir( DIR )';
+B<Timeout> - Set a timeout value (defaults to 120)
- $_[0]->_RMD($_[1]);
-}
+B<Debug> - debug level (see the debug method in L<Net::Cmd>)
-sub mkdir
-{
- @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )';
+B<Passive> - If set to a non-zero value then all data transfers will be done
+using passive mode. This is not usually required except for some I<dumb>
+servers, and some firewall configurations. This can also be set by the
+environment variable C<FTP_PASSIVE>.
- my($ftp,$dir,$recurse) = @_;
+B<Hash> - If given a reference to a file handle (e.g., C<\*STDERR>),
+print hash marks (#) on that filehandle every 1024 bytes. This
+simply invokes the C<hash()> method for you, so that hash marks
+are displayed for all transfers. You can, of course, call C<hash()>
+explicitly whenever you'd like.
- $ftp->_MKD($dir) || $recurse or
- return undef;
+B<LocalAddr> - Local address to use for all socket connections, this
+argument will be passed to L<IO::Socket::INET>
- my $path = undef;
- unless($ftp->ok)
- {
- my @path = split(m#(?=/+)#, $dir);
+If the constructor fails undef will be returned and an error message will
+be in $@
- $path = "";
+=back
- while(@path)
- {
- $path .= shift @path;
+=head1 METHODS
- $ftp->_MKD($path);
- $path = $ftp->_extract_path($path);
+Unless otherwise stated all methods return either a I<true> or I<false>
+value, with I<true> meaning that the operation was a success. When a method
+states that it returns a value, failure will be returned as I<undef> or an
+empty list.
- # 521 means directory already exists
- last
- unless $ftp->ok || $ftp->code == 521;
- }
- }
+=over 4
- $ftp->_extract_path($path);
-}
+=item login ([LOGIN [,PASSWORD [, ACCOUNT] ] ])
-sub delete
-{
- @_ == 2 || croak 'usage: $ftp->delete( FILENAME )';
+Log into the remote FTP server with the given login information. If
+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 I<anonymous@>
+will be used for password.
- $_[0]->_DELE($_[1]);
-}
+If the connection is via a firewall then the C<authorize> method will
+be called with no arguments.
-sub put { shift->_store_cmd("stor",@_) }
-sub put_unique { shift->_store_cmd("stou",@_) }
-sub append { shift->_store_cmd("appe",@_) }
+=item authorize ( [AUTH [, RESP]])
-sub nlst { shift->_data_cmd("NLST",@_) }
-sub list { shift->_data_cmd("LIST",@_) }
-sub retr { shift->_data_cmd("RETR",@_) }
-sub stor { shift->_data_cmd("STOR",@_) }
-sub stou { shift->_data_cmd("STOU",@_) }
-sub appe { shift->_data_cmd("APPE",@_) }
+This is a protocol used by some firewall ftp proxies. It is used
+to authorise the user to send data out. If both arguments are not specified
+then C<authorize> uses C<Net::Netrc> to do a lookup.
-sub _store_cmd
-{
- my($ftp,$cmd,$local,$remote) = @_;
- my($loc,$sock,$len,$buf,$localfd);
- local *FD;
+=item site (ARGS)
- $localfd = ref($local) ? fileno($local)
- : undef;
+Send a SITE command to the remote server and wait for a response.
- unless(defined $remote)
- {
- croak 'Must specify remote filename with stream input'
- if defined $localfd;
+Returns most significant digit of the response code.
- ($remote = $local) =~ s%.*/%%;
- }
+=item ascii
- if(defined $localfd)
- {
- $loc = $local;
- }
- else
- {
- $loc = \*FD;
+Transfer file in ASCII. CRLF translation will be done if required
- unless(open($loc,"<$local"))
- {
- carp "Cannot open Local file $local: $!\n";
- return undef;
- }
- if ($ftp->binary && !binmode($loc))
- {
- carp "Cannot binmode Local file $local: $!\n";
- return undef;
- }
- }
+=item binary
- delete ${*$ftp}{'net_ftp_port'};
- delete ${*$ftp}{'net_ftp_pasv'};
+Transfer file in binary mode. No transformation will be done.
- $sock = $ftp->_data_cmd($cmd, $remote) or
- return undef;
+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.
- do
- {
- $len = sysread($loc,$buf="",1024);
- }
- while($len && $sock->write($buf,$len) == $len);
+=item rename ( OLDNAME, NEWNAME )
- close($loc)
- unless defined $localfd;
+Rename a file on the remote FTP server from C<OLDNAME> to C<NEWNAME>. This
+is done by sending the RNFR and RNTO commands.
- $sock->close();
+=item delete ( FILENAME )
- ($remote) = $ftp->message =~ /unique file name:\s*(\S*)\s*\)/
- if ('STOU' eq uc $cmd);
+Send a request to the server to delete C<FILENAME>.
- return $remote;
-}
+=item cwd ( [ DIR ] )
-sub port
-{
- @_ == 1 || @_ == 2 or croak 'usage: $ftp->port([PORT])';
+Attempt to change directory to the directory given in C<$dir>. If
+C<$dir> is C<"..">, the FTP C<CDUP> command is used to attempt to
+move up one directory. If no directory is given then an attempt is made
+to change the directory to the root directory.
- my($ftp,$port) = @_;
- my $ok;
+=item cdup ()
- delete ${*$ftp}{'net_ftp_intern_port'};
+Change directory to the parent of the current directory.
- unless(defined $port)
- {
- # create a Listen socket at same address as the command socket
+=item pwd ()
- ${*$ftp}{'net_ftp_listen'} ||= IO::Socket::INET->new(Listen => 5,
- Proto => 'tcp',
- LocalAddr => $ftp->sockhost,
- );
-
- my $listen = ${*$ftp}{'net_ftp_listen'};
+Returns the full pathname of the current directory.
- my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost));
+=item restart ( WHERE )
- $port = join(',', @myaddr, $myport >> 8, $myport & 0xff);
+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.
- ${*$ftp}{'net_ftp_intern_port'} = 1;
- }
+=item rmdir ( DIR [, RECURSE ])
- $ok = $ftp->_PORT($port);
+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.
- ${*$ftp}{'net_ftp_port'} = $port;
+=item mkdir ( DIR [, RECURSE ])
- $ok;
-}
+Create a new directory with the name C<DIR>. If C<RECURSE> is I<true> then
+C<mkdir> will attempt to create all the directories in the given path.
-sub ls { shift->_list_cmd("NLST",@_); }
-sub dir { shift->_list_cmd("LIST",@_); }
+Returns the full pathname to the new directory.
-sub pasv
-{
- @_ == 1 or croak 'usage: $ftp->pasv()';
+=item alloc ( SIZE [, RECORD_SIZE] )
- my $ftp = shift;
+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.
- delete ${*$ftp}{'net_ftp_intern_port'};
+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.
- $ftp->_PASV && $ftp->message =~ /(\d+(,\d+)+)/
- ? ${*$ftp}{'net_ftp_pasv'} = $1
- : undef;
-}
+=item ls ( [ DIR ] )
-sub unique_name
-{
- my $ftp = shift;
- ${*$ftp}{'net_ftp_unique'} || undef;
-}
+Get a directory listing of C<DIR>, or the current directory.
-##
-## Depreciated methods
-##
+In an array context, returns a list of lines returned from the server. In
+a scalar context, returns a reference to a list.
-sub lsl
-{
- carp "Use of Net::FTP::lsl depreciated, use 'dir'"
- if $^W;
- goto &dir;
-}
+=item dir ( [ DIR ] )
-sub authorise
-{
- carp "Use of Net::FTP::authorise depreciated, use 'authorize'"
- if $^W;
- goto &authorize;
-}
+Get a directory listing of C<DIR>, or the current directory in long format.
+In an array context, returns a list of lines returned from the server. In
+a scalar context, returns a reference to a list.
-##
-## Private methods
-##
+=item get ( REMOTE_FILE [, LOCAL_FILE [, WHERE]] )
-sub _extract_path
-{
- my($ftp, $path) = @_;
+Get C<REMOTE_FILE> from the server and store locally. C<LOCAL_FILE> may be
+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.
- $ftp->ok &&
- $ftp->message =~ /\s\"(.*)\"\s/o &&
- ($path = $1) =~ s/\"\"/\"/g;
+If C<WHERE> is given then the first C<WHERE> bytes of the file will
+not be transfered, and the remaining bytes will be appended to
+the local file if it already exists.
- $path;
-}
+Returns C<LOCAL_FILE>, or the generated local file name if C<LOCAL_FILE>
+is not given. If an error was encountered undef is returned.
-##
-## Communication methods
-##
+=item put ( LOCAL_FILE [, REMOTE_FILE ] )
-sub _dataconn
-{
- my $ftp = shift;
- my $data = undef;
- my $pkg = "Net::FTP::" . $ftp->type;
+Put a file on the remote server. C<LOCAL_FILE> may be a name or a filehandle.
+If C<LOCAL_FILE> is a filehandle then C<REMOTE_FILE> must be specified. If
+C<REMOTE_FILE> is not specified then the file will be stored in the current
+directory with the same leafname as C<LOCAL_FILE>.
- $pkg =~ s/ /_/g;
+Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
+is not given.
- delete ${*$ftp}{'net_ftp_dataconn'};
+B<NOTE>: If for some reason the transfer does not complete and an error is
+returned then the contents that had been transfered will not be remove
+automatically.
- if(defined ${*$ftp}{'net_ftp_pasv'})
- {
- my @port = split(/,/,${*$ftp}{'net_ftp_pasv'});
+=item put_unique ( LOCAL_FILE [, REMOTE_FILE ] )
- $data = $pkg->new(PeerAddr => join(".",@port[0..3]),
- PeerPort => $port[4] * 256 + $port[5],
- Proto => 'tcp'
- );
- }
- elsif(defined ${*$ftp}{'net_ftp_listen'})
- {
- $data = ${*$ftp}{'net_ftp_listen'}->accept($pkg);
- close(delete ${*$ftp}{'net_ftp_listen'});
- }
+Same as put but uses the C<STOU> command.
- if($data)
- {
- ${*$data} = "";
- $data->timeout($ftp->timeout);
- ${*$ftp}{'net_ftp_dataconn'} = $data;
- ${*$data}{'net_ftp_cmd'} = $ftp;
- }
+Returns the name of the file on the server.
- $data;
-}
+=item append ( LOCAL_FILE [, REMOTE_FILE ] )
-sub _list_cmd
-{
- my $ftp = shift;
- my $cmd = uc shift;
+Same as put but appends to the file on the remote server.
- delete ${*$ftp}{'net_ftp_port'};
- delete ${*$ftp}{'net_ftp_pasv'};
+Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
+is not given.
- my $data = $ftp->_data_cmd($cmd,@_);
+=item unique_name ()
- return undef
- unless(defined $data);
+Returns the name of the last file stored on the server using the
+C<STOU> command.
- bless $data, "Net::FTP::A"; # Force ASCII mode
+=item mdtm ( FILE )
- my $databuf = '';
- my $buf = '';
+Returns the I<modification time> of the given file
- while($data->read($databuf,1024))
- {
- $buf .= $databuf;
- }
+=item size ( FILE )
- my $list = [ split(/\n/,$buf) ];
+Returns the size in bytes for the given file as stored on the remote server.
- $data->close();
+B<NOTE>: The size reported is the size of the stored file on the remote server.
+If the file is subsequently transfered from the server in ASCII mode
+and the remote server and local machine have different ideas about
+"End Of Line" then the size of file on the local machine after transfer
+may be different.
- wantarray ? @{$list}
- : $list;
-}
+=item supported ( CMD )
-sub _data_cmd
-{
- my $ftp = shift;
- my $cmd = uc shift;
- my $ok = 1;
- my $where = delete ${*$ftp}{'net_ftp_rest'} || 0;
+Returns TRUE if the remote server supports the given command.
- if(${*$ftp}{'net_ftp_passive'} &&
- !defined ${*$ftp}{'net_ftp_pasv'} &&
- !defined ${*$ftp}{'net_ftp_port'})
- {
- my $data = undef;
+=item hash ( [FILEHANDLE_GLOB_REF],[ BYTES_PER_HASH_MARK] )
- $ok = defined $ftp->pasv;
- $ok = $ftp->_REST($where)
- if $ok && $where;
+Called without parameters, or with the first argument false, hash marks
+are suppressed. If the first argument is true but not a reference to a
+file handle glob, then \*STDERR is used. The second argument is the number
+of bytes per hash mark printed, and defaults to 1024. In all cases the
+return value is a reference to an array of two: the filehandle glob reference
+and the bytes per hash mark.
- if($ok)
- {
- $ftp->command($cmd,@_);
- $data = $ftp->_dataconn();
- $ok = CMD_INFO == $ftp->response();
- }
- return $ok ? $data
- : undef;
- }
+=back
- $ok = $ftp->port
- unless (defined ${*$ftp}{'net_ftp_port'} ||
- defined ${*$ftp}{'net_ftp_pasv'});
+The following methods can return different results depending on
+how they are called. If the user explicitly calls either
+of the C<pasv> or C<port> methods then these methods will
+return a I<true> or I<false> value. If the user does not
+call either of these methods then the result will be a
+reference to a C<Net::FTP::dataconn> based object.
- $ok = $ftp->_REST($where)
- if $ok && $where;
+=over 4
- return undef
- unless $ok;
+=item nlst ( [ DIR ] )
- $ftp->command($cmd,@_);
+Send an C<NLST> command to the server, with an optional parameter.
- return 1
- if(defined ${*$ftp}{'net_ftp_pasv'});
+=item list ( [ DIR ] )
- $ok = CMD_INFO == $ftp->response();
+Same as C<nlst> but using the C<LIST> command
- return $ok
- unless exists ${*$ftp}{'net_ftp_intern_port'};
+=item retr ( FILE )
- $ok ? $ftp->_dataconn()
- : undef;
-}
+Begin the retrieval of a file called C<FILE> from the remote server.
-##
-## Over-ride methods (Net::Cmd)
-##
+=item stor ( FILE )
-sub debug_text { $_[2] =~ /^(pass|resp)/i ? "$1 ....\n" : $_[2]; }
+Tell the server that you wish to store a file. C<FILE> is the
+name of the new file that should be created.
-sub command
-{
- my $ftp = shift;
+=item stou ( FILE )
- delete ${*$ftp}{'net_ftp_port'};
- $ftp->SUPER::command(@_);
-}
+Same as C<stor> but using the C<STOU> command. The name of the unique
+file which was created on the server will be available via the C<unique_name>
+method after the data connection has been closed.
-sub response
-{
- my $ftp = shift;
- my $code = $ftp->SUPER::response();
+=item appe ( FILE )
- delete ${*$ftp}{'net_ftp_pasv'}
- if ($code != CMD_MORE && $code != CMD_INFO);
+Tell the server that we want to append some data to the end of a file
+called C<FILE>. If this file does not exist then create it.
- $code;
-}
+=back
-##
-## Allow 2 servers to talk directly
-##
+If for some reason you want to have complete control over the data connection,
+this includes generating it and calling the C<response> method when required,
+then the user can use these methods to do so.
-sub pasv_xfer
-{
- my($sftp,$sfile,$dftp,$dfile) = @_;
+However calling these methods only affects the use of the methods above that
+can return a data connection. They have no effect on methods C<get>, C<put>,
+C<put_unique> and those that do not require data connections.
- ($dfile = $sfile) =~ s#.*/##
- unless(defined $dfile);
+=over 4
- my $port = $sftp->pasv or
- return undef;
+=item port ( [ PORT ] )
- unless($dftp->port($port) && $sftp->retr($sfile) && $dftp->stou($dfile))
- {
- $sftp->abort;
- $dftp->abort;
- return undef;
- }
+Send a C<PORT> command to the server. If C<PORT> is specified then it is sent
+to the server. If not, then a listen socket is created and the correct information
+sent to the server.
- $dftp->pasv_wait($sftp);
-}
+=item pasv ()
-sub pasv_wait
-{
- @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)';
+Tell the server to go into passive mode. Returns the text that represents the
+port on which the server is listening, this text is in a suitable form to
+sent to another ftp server using the C<port> method.
- my($ftp, $non_pasv) = @_;
- my($file,$rin,$rout);
+=back
- vec($rin,fileno($ftp),1) = 1;
- select($rout=$rin, undef, undef, undef);
+The following methods can be used to transfer files between two remote
+servers, providing that these two servers can connect directly to each other.
- $ftp->response();
- $non_pasv->response();
+=over 4
- return undef
- unless $ftp->ok() && $non_pasv->ok();
+=item pasv_xfer ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
- return $1
- if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/;
+This method will do a file transfer between two remote ftp servers. If
+C<DEST_FILE> is omitted then the leaf name of C<SRC_FILE> will be used.
- return $1
- if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/;
+=item pasv_xfer_unique ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
- return 1;
-}
+Like C<pasv_xfer> but the file is stored on the remote server using
+the STOU command.
-sub cmd { shift->command(@_)->responce() }
+=item pasv_wait ( NON_PASV_SERVER )
-########################################
-#
-# RFC959 commands
-#
+This method can be used to wait for a transfer to complete between a passive
+server and a non-passive server. The method should be called on the passive
+server with the C<Net::FTP> object for the non-passive server passed as an
+argument.
-sub _ABOR { shift->command("ABOR")->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 _QUIT { shift->command("QUIT")->response() == CMD_OK }
-sub _DELE { shift->command("DELE",@_)->response() == CMD_OK }
-sub _CWD { shift->command("CWD", @_)->response() == CMD_OK }
-sub _PORT { shift->command("PORT",@_)->response() == CMD_OK }
-sub _RMD { shift->command("RMD", @_)->response() == CMD_OK }
-sub _MKD { shift->command("MKD", @_)->response() == CMD_OK }
-sub _PWD { shift->command("PWD", @_)->response() == CMD_OK }
-sub _TYPE { shift->command("TYPE",@_)->response() == CMD_OK }
-sub _RNTO { shift->command("RNTO",@_)->response() == CMD_OK }
-sub _ACCT { shift->command("ACCT",@_)->response() == CMD_OK }
-sub _RESP { shift->command("RESP",@_)->response() == CMD_OK }
-sub _MDTM { shift->command("MDTM",@_)->response() == CMD_OK }
-sub _SIZE { shift->command("SIZE",@_)->response() == CMD_OK }
-sub _APPE { shift->command("APPE",@_)->response() == CMD_INFO }
-sub _LIST { shift->command("LIST",@_)->response() == CMD_INFO }
-sub _NLST { shift->command("NLST",@_)->response() == CMD_INFO }
-sub _RETR { shift->command("RETR",@_)->response() == CMD_INFO }
-sub _STOR { shift->command("STOR",@_)->response() == CMD_INFO }
-sub _STOU { shift->command("STOU",@_)->response() == CMD_INFO }
-sub _RNFR { shift->command("RNFR",@_)->response() == CMD_MORE }
-sub _REST { shift->command("REST",@_)->response() == CMD_MORE }
-sub _USER { shift->command("user",@_)->response() } # A certain brain dead firewall :-)
-sub _PASS { shift->command("PASS",@_)->response() }
-sub _AUTH { shift->command("AUTH",@_)->response() }
+=item abort ()
-sub _ALLO { shift->unsupported(@_) }
-sub _SMNT { shift->unsupported(@_) }
-sub _HELP { shift->unsupported(@_) }
-sub _MODE { shift->unsupported(@_) }
-sub _SITE { shift->unsupported(@_) }
-sub _SYST { shift->unsupported(@_) }
-sub _STAT { shift->unsupported(@_) }
-sub _STRU { shift->unsupported(@_) }
-sub _REIN { shift->unsupported(@_) }
+Abort the current data transfer.
-##
-## Generic data connection package
-##
+=item quit ()
-package Net::FTP::dataconn;
+Send the QUIT command to the remote FTP server and close the socket connection.
-use Carp;
-use vars qw(@ISA $timeout);
-use Net::Cmd;
+=back
-@ISA = qw(IO::Socket::INET);
+=head2 Methods for the adventurous
-sub abort
-{
- my $data = shift;
- my $ftp = ${*$data}{'net_ftp_cmd'};
+C<Net::FTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
+be used to send commands to the remote FTP server.
- $ftp->abort; # this will close me
-}
+=over 4
-sub close
-{
- my $data = shift;
- my $ftp = ${*$data}{'net_ftp_cmd'};
+=item quot (CMD [,ARGS])
- $data->SUPER::close();
+Send a command, that Net::FTP does not directly support, to the remote
+server and wait for a response.
- delete ${*$ftp}{'net_ftp_dataconn'}
- if exists ${*$ftp}{'net_ftp_dataconn'} &&
- $data == ${*$ftp}{'net_ftp_dataconn'};
+Returns most significant digit of the response code.
- $ftp->response() == CMD_OK &&
- $ftp->message =~ /unique file name:\s*(\S*)\s*\)/ &&
- (${*$ftp}{'net_ftp_unique'} = $1);
+B<WARNING> This call should only be used on commands that do not require
+data connections. Misuse of this method can hang the connection.
- $ftp->status == CMD_OK;
-}
+=back
-sub _select
-{
- my $data = shift;
- local *timeout = \$_[0]; shift;
- my $rw = shift;
+=head1 THE dataconn CLASS
- my($rin,$win);
+Some of the methods defined in C<Net::FTP> return an object which will
+be derived from this class.The dataconn class itself is derived from
+the C<IO::Socket::INET> class, so any normal IO operations can be performed.
+However the following methods are defined in the dataconn class and IO should
+be performed using these.
- return 1 unless $timeout;
+=over 4
- $rin = '';
- vec($rin,fileno($data),1) = 1;
+=item read ( BUFFER, SIZE [, TIMEOUT ] )
- $win = $rw ? undef : $rin;
- $rin = undef unless $rw;
+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 timeout value from the command connection will be used.
- my $nfound = select($rin, $win, undef, $timeout);
+Returns the number of bytes read before any <CRLF> translation.
- croak "select: $!"
- if $nfound < 0;
+=item write ( BUFFER, SIZE [, TIMEOUT ] )
- return $nfound;
-}
+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 timeout value from the command connection will be used.
-sub can_read
-{
- my $data = shift;
- local *timeout = \$_[0];
+Returns the number of bytes written before any <CRLF> translation.
- $data->_select($timeout,1);
-}
+=item bytes_read ()
-sub can_write
-{
- my $data = shift;
- local *timeout = \$_[0];
+Returns the number of bytes read so far.
- $data->_select($timeout,0);
-}
+=item abort ()
-sub cmd
-{
- my $ftp = shift;
+Abort the current data transfer.
- ${*$ftp}{'net_ftp_cmd'};
-}
+=item close ()
+Close the data connection and get a response from the FTP server. Returns
+I<true> if the connection was closed successfully and the first digit of
+the response from the server was a '2'.
-@Net::FTP::L::ISA = qw(Net::FTP::I);
-@Net::FTP::E::ISA = qw(Net::FTP::I);
+=back
-##
-## Package to read/write on ASCII data connections
-##
+=head1 UNIMPLEMENTED
-package Net::FTP::A;
+The following RFC959 commands have not been implemented:
-use vars qw(@ISA $buf);
-use Carp;
+=over 4
-@ISA = qw(Net::FTP::dataconn);
+=item B<SMNT>
-sub read
-{
- my $data = shift;
- local *buf = \$_[0]; shift;
- my $size = shift || croak 'read($buf,$size,[$offset])';
- my $offset = shift || 0;
- my $timeout = $data->timeout;
+Mount a different file system structure without changing login or
+accounting information.
- croak "Bad offset"
- if($offset < 0);
+=item B<HELP>
- $offset = length $buf
- if($offset > length $buf);
+Ask the server for "helpful information" (that's what the RFC says) on
+the commands it accepts.
- ${*$data} ||= "";
- my $l = 0;
+=item B<MODE>
- READ:
- {
- $data->can_read($timeout) or
- croak "Timeout";
+Specifies transfer mode (stream, block or compressed) for file to be
+transferred.
- my $n = sysread($data, ${*$data}, $size, length ${*$data});
+=item B<SYST>
- return $n
- unless($n >= 0);
+Request remote server system identification.
- ${*$data} =~ s/(\015)?(?!\012)\Z//so;
- my $lf = $1 || "";
+=item B<STAT>
- ${*$data} =~ s/\015\012/\n/sgo;
+Request remote server status.
- substr($buf,$offset) = ${*$data};
+=item B<STRU>
- $l += length(${*$data});
- $offset += length(${*$data});
+Specifies file structure for file to be transferred.
- ${*$data} = $lf;
-
- redo READ
- if($l == 0 && $n > 0);
+=item B<REIN>
- if($n == 0 && $l == 0)
- {
- substr($buf,$offset) = ${*$data};
- ${*$data} = "";
- }
- }
+Reinitialize the connection, flushing all I/O and account information.
- return $l;
-}
+=back
-sub write
-{
- my $data = shift;
- local *buf = \$_[0]; shift;
- my $size = shift || croak 'write($buf,$size,[$timeout])';
- my $timeout = @_ ? shift : $data->timeout;
+=head1 REPORTING BUGS
- $data->can_write($timeout) or
- croak "Timeout";
+When reporting bugs/problems please include as much information as possible.
+It may be difficult for me to reproduce the problem as almost every setup
+is different.
- # What is previous pkt ended in \015 or not ??
+A small script which yields the problem will probably be of help. It would
+also be useful if this script was run with the extra options C<Debug => 1>
+passed to the constructor, and the output sent with the bug report. If you
+cannot include a small script then please include a Debug trace from a
+run of your program which does yield the problem.
- my $tmp;
- ($tmp = $buf) =~ s/(?!\015)\012/\015\012/sg;
+=head1 AUTHOR
- my $len = $size + length($tmp) - length($buf);
- my $wrote = syswrite($data, $tmp, $len);
+Graham Barr <gbarr@pobox.com>
- if($wrote >= 0)
- {
- $wrote = $wrote == $len ? $size
- : $len - $wrote
- }
+=head1 SEE ALSO
- return $wrote;
-}
+L<Net::Netrc>
+L<Net::Cmd>
-##
-## Package to read/write on BINARY data connections
-##
+ftp(1), ftpd(8), RFC 959
+http://www.cis.ohio-state.edu/htbin/rfc/rfc959.html
-package Net::FTP::I;
+=head1 USE EXAMPLES
-use vars qw(@ISA $buf);
-use Carp;
+For an example of the use of Net::FTP see
-@ISA = qw(Net::FTP::dataconn);
+=over 4
-sub read
-{
- my $data = shift;
- local *buf = \$_[0]; shift;
- my $size = shift || croak 'read($buf,$size,[$timeout])';
- my $timeout = @_ ? shift : $data->timeout;
+=item http://www.csh.rit.edu/~adam/Progs/
- $data->can_read($timeout) or
- croak "Timeout";
+C<autoftp> is a program that can retrieve, send, or list files via
+the FTP protocol in a non-interactive manner.
- my $n = sysread($data, $buf, $size);
+=back
- $n;
-}
+=head1 CREDITS
-sub write
-{
- my $data = shift;
- local *buf = \$_[0]; shift;
- my $size = shift || croak 'write($buf,$size,[$timeout])';
- my $timeout = @_ ? shift : $data->timeout;
+Henry Gabryjelski <henryg@WPI.EDU> - for the suggestion of creating directories
+recursively.
- $data->can_write($timeout) or
- croak "Timeout";
+Nathan Torkington <gnat@frii.com> - for some input on the documentation.
- syswrite($data, $buf, $size);
-}
+Roderick Schertler <roderick@gate.net> - for various inputs
+=head1 COPYRIGHT
-1;
+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.
+=cut
https://perl5.git.perl.org / perl5.git / blobdiff