X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNet%2FFTP.pm;h=d2780d31f6b1ba7373b7d0d1bec34a7329464d59;hb=c798bd2165d7b5d59c62ab6330f7cf77ff8b09dd;hp=d635f000bc7e9e8934053cb46ce5c54cc20c3b19;hpb=7e1af8bca57f405a8444b575a870918a6d88fc5c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm index d635f00..d2780d3 100644 --- a/lib/Net/FTP.pm +++ b/lib/Net/FTP.pm @@ -1,1391 +1,1719 @@ # Net::FTP.pm # -# Copyright (c) 1995 Graham Barr . All rights -# reserved. This program is free software; you can redistribute it and/or +# Copyright (c) 1995-8 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. +# +# Documentation (at end) improved 1996 by Nathan Torkington . package Net::FTP; -=head1 NAME - -Net::FTP - FTP Client class +require 5.001; -=head1 SYNOPSIS +use strict; +use vars qw(@ISA $VERSION); +use Carp; - 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; +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); -=head1 DESCRIPTION +$VERSION = "2.62"; # $Id: //depot/libnet/Net/FTP.pm#64 $ +@ISA = qw(Exporter Net::Cmd IO::Socket::INET); -C is a class implementing a simple FTP client in Perl as described -in RFC959 +# Someday I will "use constant", when I am not bothered to much about +# compatability with older releases of perl -C provides methods that will perform various operations. These methods -could be split into groups depending the level of interface the user requires. +use vars qw($TELNET_IAC $TELNET_IP $TELNET_DM); +($TELNET_IAC,$TELNET_IP,$TELNET_DM) = (255,244,242); -=head1 CONSTRUCTOR +# 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); +} -=over 4 +BEGIN { + # make a constant so code is fast'ish + my $is_os390 = $^O eq 'os390'; + *trEBCDIC = sub () { $is_os390 } +} -=item new (HOST [,OPTIONS]) +1; +# Having problems with AutoLoader +#__END__ -This is the constructor for a new Net::SMTP object. C is the -name of the remote host to which a FTP connection is required. +sub new +{ + my $pkg = shift; + my $peer = shift; + my %arg = @_; -C are passed in a hash like fasion, using key and value pairs. -Possible options are: + my $host = $peer; + my $fire = undef; + my $fire_type = undef; -B - The name of a machine which acts as a FTP firewall. This can be -overridden by an environment variable C. 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(exists($arg{Firewall}) || Net::Config->requires_firewall($peer)) + { + $fire = $arg{Firewall} + || $ENV{FTP_FIREWALL} + || $NetConfig{ftp_firewall} + || undef; -B - The port number to connect to on the remote machine for the -FTP connection + if(defined $fire) + { + $peer = $fire; + delete $arg{Port}; + $fire_type = $arg{FirewallType} + || $ENV{FTP_FIREWALL_TYPE} + || undef; + } + } -B - Set a timeout value (defaults to 120) + my $ftp = $pkg->SUPER::new(PeerAddr => $peer, + PeerPort => $arg{Port} || 'ftp(21)', + Proto => 'tcp', + Timeout => defined $arg{Timeout} + ? $arg{Timeout} + : 120 + ) or return undef; -B - Debug level + ${*$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 - If set to I then all data transfers will be done using -passive mode. This is required for some I 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 or I -value, with I meaning that the operation was a success. When a method -states that it returns a value, falure will be returned as I 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 uses the C -package to lookup the login information for the connected host. -If no information is found then a login of I is used. -If no password is given and the login is I then the users -Email address will be used for a password. + $ftp; +} -If the connection is via a firewall then the C method will -be called with no arguments. +## +## User interface methods +## -=item authorize ( [AUTH [, RESP]]) +sub hash { + my $ftp = shift; # self -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 uses C to do a lookup. + 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]; +} -=item type (TYPE [, ARGS]) +sub quit +{ + my $ftp = shift; -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. + $ftp->_QUIT; + $ftp->close; +} -=item ascii ([ARGS]) binary([ARGS]) ebcdic([ARGS]) byte([ARGS]) +sub DESTROY {} -Synonyms for C with the first arguments set correctly +sub ascii { shift->type('A',@_); } +sub binary { shift->type('I',@_); } -B ebcdic and byte are not fully supported. +sub ebcdic +{ + carp "TYPE E is unsupported, shall default to I"; + shift->type('E',@_); +} -=item rename ( OLDNAME, NEWNAME ) +sub byte +{ + carp "TYPE L is unsupported, shall default to I"; + shift->type('L',@_); +} -Rename a file on the remote FTP server from C to C. This -is done by sending the RNFR and RNTO commands. +# Allow the user to send a command directly, BE CAREFUL !! -=item delete ( FILENAME ) +sub quot +{ + my $ftp = shift; + my $cmd = shift; -Send a request to the server to delete C. + $ftp->command( uc $cmd, @_); + $ftp->response(); +} -=item cwd ( [ DIR ] ) +sub site +{ + my $ftp = shift; -Change the current working directory to C, or / if not given. + $ftp->command("SITE", @_); + $ftp->response(); +} -=item cdup () +sub mdtm +{ + my $ftp = shift; + my $file = shift; -Change directory to the parent of the current directory. + # 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; +} -=item pwd () +sub size { + my $ftp = shift; + my $file = shift; + my $io; + if($ftp->supported("SIZE")) { + return $ftp->_SIZE($file) + ? ($ftp->message =~ /(\d+)$/)[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 =~ /^[-rwx]{10}/ + } + } + else { + my @files = $ftp->dir($file); + if(@files) { + return (split(/\s+/,$1))[4] + if $files[0] =~ /^([-rwx]{10}.*)$/; + } + } + undef; +} -Returns the full pathname of the current directory. +sub login { + my($ftp,$user,$pass,$acct) = @_; + my($ok,$ruser,$fwtype); -=item rmdir ( DIR ) + unless (defined $user) { + require Net::Netrc; -Remove the directory with the name C. + my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}); -=item mkdir ( DIR [, RECURSE ]) + ($user,$pass,$acct) = $rc->lpa() + if ($rc); + } -Create a new directory with the name C. If C is I then -C will attempt to create all the directories in the given path. + $user ||= "anonymous"; + $ruser = $user; -Returns the full pathname to the new directory. + $fwtype = ${*$ftp}{'net_ftp_firewall_type'} + || $NetConfig{'ftp_firewall_type'} + || 0; -=item ls ( [ 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, or the current directory. + 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 dir ( [ DIR ] ) + 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 a directory listing of C, or the current directory in long format. + $ok = $ftp->_USER($fwuser); -Returns a reference to a list of lines returned from the server. + return 0 unless $ok == CMD_OK || $ok == CMD_MORE; -=item get ( REMOTE_FILE [, LOCAL_FILE ] ) + $ok = $ftp->_PASS($fwpass || ""); -Get C from the server and store locally. C 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. + return 0 unless $ok == CMD_OK || $ok == CMD_MORE; -Returns C, or the generated local file name if C -is not given. + $ok = $ftp->_ACCT($fwacct) + if defined($fwacct); -=item put ( 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; + } -Put a file on the remote server. C may be a name or a filehandle. -If C is a filehandle then C must be specified. If -C is not specified then the file will be stored in the current -directory with the same leafname as C. + return 0 unless $ok == CMD_OK || $ok == CMD_MORE; + } + } + } -Returns C, or the generated remote filename if C -is not given. + $ok = $ftp->_USER($user); -=item put_unique ( 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 uses the C command. + if ($ok == CMD_MORE) { + unless(defined $pass) { + require Net::Netrc; -Returns the name of the file on the server. + my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser); -=item append ( LOCAL_FILE [, REMOTE_FILE ] ) + ($ruser,$pass,$acct) = $rc->lpa() + if ($rc); -Same as put but appends to the file on the remote server. + $pass = '-anonymous@' + if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o)); + } -Returns C, or the generated remote filename if C -is not given. + $ok = $ftp->_PASS($pass || ""); + } -=item unique_name () + $ok = $ftp->_ACCT($acct) + if (defined($acct) && ($ok == CMD_MORE || $ok == CMD_OK)); -Returns the name of the last file stored on the server using the -C command. + 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); + } -=item mdtm ( FILE ) + $ok == CMD_OK; +} -Returns the I of the given file +sub account +{ + @_ == 2 or croak 'usage: $ftp->account( ACCT )'; + my $ftp = shift; + my $acct = shift; + $ftp->_ACCT($acct) == CMD_OK; +} -=item size ( FILE ) +sub _auth_id { + my($ftp,$auth,$resp) = @_; -Returns the size in bytes for the given file. + unless(defined $resp) + { + require Net::Netrc; -=back + $auth ||= eval { (getpwuid($>))[0] } || $ENV{NAME}; -The following methods can return different results depending on -how they are called. If the user explicitly calls either -of the C or C methods then these methods will -return a I or I value. If the user does not -call either of these methods then the result will be a -reference to a C based object. + my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}, $auth) + || Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}); -=over 4 + ($auth,$resp) = $rc->lpa() + if ($rc); + } + ($ftp,$auth,$resp); +} -=item nlst ( [ DIR ] ) +sub authorize +{ + @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize( [AUTH [, RESP]])'; -Send a C command to the server, with an optional parameter. + my($ftp,$auth,$resp) = &_auth_id; -=item list ( [ DIR ] ) + my $ok = $ftp->_AUTH($auth || ""); -Same as C but using the C command + $ok = $ftp->_RESP($resp || "") + if ($ok == CMD_MORE); -=item retr ( FILE ) + $ok == CMD_OK; +} -Begin the retrieval of a file called C from the remote server. +sub rename +{ + @_ == 3 or croak 'usage: $ftp->rename(FROM, TO)'; -=item stor ( FILE ) + my($ftp,$from,$to) = @_; -Tell the server that you wish to store a file. C is the -name of the new file that should be created. + $ftp->_RNFR($from) + && $ftp->_RNTO($to); +} -=item stou ( FILE ) +sub type +{ + my $ftp = shift; + my $type = shift; + my $oldval = ${*$ftp}{'net_ftp_type'}; -Same as C but using the C command. The name of the unique -file which was created on the server will be avalaliable via the C -method after the data connection has been closed. + return $oldval + unless (defined $type); -=item appe ( FILE ) + return undef + unless ($ftp->_TYPE($type,@_)); -Tell the server that we want to append some data to the end of a file -called C. If this file does not exist then create it. + ${*$ftp}{'net_ftp_type'} = join(" ",$type,@_); -=back + $oldval; +} -If for some reason you want to have complete control over the data connection, -this includes generating it and calling the C method when required, -then the user can use these methods to do so. +sub abort +{ + my $ftp = shift; -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, C, -C and those that do not require data connections. + send($ftp,pack("CCC", $TELNET_IAC, $TELNET_IP, $TELNET_IAC),MSG_OOB); -=over 4 + $ftp->command(pack("C",$TELNET_DM) . "ABOR"); -=item port ( [ PORT ] ) + ${*$ftp}{'net_ftp_dataconn'}->close() + if defined ${*$ftp}{'net_ftp_dataconn'}; -Send a C command to the server. If C 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. + $ftp->response(); -=item pasv () + $ftp->status == CMD_OK; +} -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 method. +sub get +{ + my($ftp,$remote,$local,$where) = @_; -=back + my($loc,$len,$buf,$resp,$localfd,$data); + local *FD; -The following methods can be used to transfer files between two remote -servers, providing that these two servers can connect directly to each other. + $localfd = ref($local) || ref(\$local) eq "GLOB" + ? fileno($local) + : undef; -=over 4 + ($local = $remote) =~ s#^.*/## + unless(defined $local); -=item pasv_xfer ( SRC_FILE, DEST_SERVER [, DEST_FILE ] ) + croak("Bad remote filename '$remote'\n") + if $remote =~ /[\r\n]/s; -This method will do a file transfer between two remote ftp servers. If -C is omitted then the leaf name of C will be used. + ${*$ftp}{'net_ftp_rest'} = $where + if ($where); -=item pasv_wait ( NON_PASV_SERVER ) + delete ${*$ftp}{'net_ftp_port'}; + delete ${*$ftp}{'net_ftp_pasv'}; -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 object for the non-passive server passed as an -argument. + $data = $ftp->retr($remote) or + return undef; -=item abort () + if(defined $localfd) + { + $loc = $local; + } + else + { + $loc = \*FD; -Abort the current data transfer. + unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($where ? O_APPEND : O_TRUNC))) + { + carp "Cannot open Local file $local: $!\n"; + $data->abort; + return undef; + } + } -=item quit () + if($ftp->type eq 'I' && !binmode($loc)) + { + carp "Cannot binmode Local file $local: $!\n"; + $data->abort; + close($loc) unless $localfd; + return undef; + } -Send the QUIT command to the remote FTP server and close the socket connection. + $buf = ''; + my($count,$hashh,$hashb,$ref) = (0); -=back + ($hashh,$hashb) = @$ref + if($ref = ${*$ftp}{'net_ftp_hash'}); -=head2 Methods for the adventurous + my $blksize = ${*$ftp}{'net_ftp_blksize'}; -C inherits from C so methods defined in C may -be used to send commands to the remote FTP server. + 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 quot (CMD [,ARGS]) + if($hashh) { + $count += $len; + print $hashh "#" x (int($count / $hashb)); + $count %= $hashb; + } + my $written = syswrite($loc,$buf,$len); + unless(defined($written) && $written == $len) + { + carp "Cannot write to Local file $local: $!\n"; + $data->abort; + close($loc) + unless defined $localfd; + return undef; + } + } -Send a command, that Net::FTP does not directly support, to the remote -server and wait for a response. + print $hashh "\n" if $hashh; -Returns most significant digit of the response code. + unless (defined $localfd) + { + unless (close($loc)) + { + carp "Cannot close file $local (perhaps disk space) $!\n"; + return undef; + } + } -B This call should only be used on commands that do not require -data connections. Misuse of this method can hang the connection. + unless ($data->close()) # implied $ftp->response + { + carp "Unable to close datastream"; + return undef; + } -=back + return $local; +} -=head1 THE dataconn CLASS +sub cwd +{ + @_ == 1 || @_ == 2 or croak 'usage: $ftp->cwd( [ DIR ] )'; -Some of the methods defined in C return an object which will -be derived from this class.The dataconn class itself is derived from -the C 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. + my($ftp,$dir) = @_; -=over 4 + $dir = "/" unless defined($dir) && $dir =~ /\S/; -=item read ( BUFFER, SIZE [, TIMEOUT ] ) + $dir eq ".." + ? $ftp->_CDUP() + : $ftp->_CWD($dir); +} -Read C bytes of data from the server and place it into C, also -performing any translation necessary. C is optional, if not -given the the timeout value from the command connection will be used. +sub cdup +{ + @_ == 1 or croak 'usage: $ftp->cdup()'; + $_[0]->_CDUP; +} -Returns the number of bytes read before any translation. +sub pwd +{ + @_ == 1 || croak 'usage: $ftp->pwd()'; + my $ftp = shift; -=item write ( BUFFER, SIZE [, TIMEOUT ] ) + $ftp->_PWD(); + $ftp->_extract_path; +} -Write C bytes of data from C to the server, also -performing any translation necessary. C is optional, if not -given the the timeout value from the command connection will be used. +# 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 ] )'); -Returns the number of bytes written before any translation. + # Pick off the args + my ($ftp, $dir, $recurse) = @_ ; + my $ok; -=item abort () + return $ok + if $ok = $ftp->_RMD( $dir ) or !$recurse; -Abort the current data transfer. + # Try to delete the contents + # Get a list of all the files in the directory + my $filelist = $ftp->ls($dir); -=item close () + return undef + unless $filelist && @$filelist; # failed, it is probably not a directory -Close the data connection and get a response from the FTP server. Returns -I if the connection was closed sucessfully and the first digit of -the response from the server was a '2'. + # 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) ; + } -=back + # 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 AUTHOR +sub restart +{ + @_ == 2 || croak 'usage: $ftp->restart( BYTE_OFFSET )'; -Graham Barr + my($ftp,$where) = @_; -=head1 REVISION + ${*$ftp}{'net_ftp_rest'} = $where; -$Revision: 2.8 $ -$Date: 1996/09/05 06:53:58 $ + return undef; +} -The VERSION is derived from the revision by changing each number after the -first dot into a 2 digit number so - Revision 1.8 => VERSION 1.08 - Revision 1.2.3 => VERSION 1.0203 +sub mkdir +{ + @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )'; -=head1 SEE ALSO + my($ftp,$dir,$recurse) = @_; -L -L + $ftp->_MKD($dir) || $recurse or + return undef; -=head1 CREDITS + my $path = $dir; -Henry Gabryjelski - for the suggestion of creating directories -recursively. + unless($ftp->ok) + { + my @path = split(m#(?=/+)#, $dir); -=head1 COPYRIGHT + $path = ""; -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. + while(@path) + { + $path .= shift @path; -=cut + $ftp->_MKD($path); -require 5.001; + $path = $ftp->_extract_path($path); + } -use strict; -use vars qw(@ISA $VERSION); -use Carp; + # If the creation of the last element was not sucessful, see if we + # can cd to it, if so then return path -use Socket 1.3; -use IO::Socket; -use Time::Local; -use Net::Cmd; -use Net::Telnet qw(TELNET_IAC TELNET_IP TELNET_DM); + 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); + } + } -$VERSION = do{my @r=(q$Revision: 2.8 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r}; -@ISA = qw(Exporter Net::Cmd IO::Socket::INET); + $path; +} -sub new +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]); +} - unless(defined inet_aton($peer)) - { - $fire = $ENV{FTP_FIREWALL} || $arg{Firewall} || undef; - if(defined $fire) - { - $peer = $fire; - delete $arg{Port}; - } - } +sub put { shift->_store_cmd("stor",@_) } +sub put_unique { shift->_store_cmd("stou",@_) } +sub append { shift->_store_cmd("appe",@_) } - my $ftp = $pkg->SUPER::new(PeerAddr => $peer, - PeerPort => $arg{Port} || 'ftp(21)', - Proto => 'tcp', - Timeout => defined $arg{Timeout} - ? $arg{Timeout} - : 120 - ) or return undef; +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,$localfd); + local *FD; - ${*$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 + $localfd = ref($local) || ref(\$local) eq "GLOB" + ? fileno($local) + : undef; - ${*$ftp}{'net_ftp_firewall'} = $fire - if defined $fire; + unless(defined $remote) + { + croak 'Must specify remote filename with stream input' + if defined $localfd; - $ftp->autoflush(1); + require File::Basename; + $remote = File::Basename::basename($local); + } - $ftp->debug(exists $arg{Debug} ? $arg{Debug} : undef); + croak("Bad remote filename '$remote'\n") + if $remote =~ /[\r\n]/s; - unless ($ftp->response() == CMD_OK) + if(defined $localfd) { - $ftp->SUPER::close(); - undef $ftp; + $loc = $local; } + else + { + $loc = \*FD; - $ftp; -} + unless(sysopen($loc, $local, O_RDONLY)) + { + carp "Cannot open Local file $local: $!\n"; + return undef; + } + } -## -## User interface methods -## + if($ftp->type eq 'I' && !binmode($loc)) + { + carp "Cannot binmode Local file $local: $!\n"; + return undef; + } -sub quit -{ - my $ftp = shift; + delete ${*$ftp}{'net_ftp_port'}; + delete ${*$ftp}{'net_ftp_pasv'}; - $ftp->_QUIT - && $ftp->SUPER::close; -} + $sock = $ftp->_data_cmd($cmd, $remote) or + return undef; -sub close -{ - my $ftp = shift; + my $blksize = ${*$ftp}{'net_ftp_blksize'}; - ref($ftp) - && defined fileno($ftp) - && $ftp->quit; -} + my($count,$hashh,$hashb,$ref) = (0); -sub DESTROY { shift->close } + ($hashh,$hashb) = @$ref + if($ref = ${*$ftp}{'net_ftp_hash'}); -sub ascii { shift->type('A',@_); } -sub binary { shift->type('I',@_); } + while(1) + { + last unless $len = sysread($loc,$buf="",$blksize); -sub ebcdic -{ - carp "TYPE E is unsupported, shall default to I"; - shift->type('E',@_); -} + if (trEBCDIC) + { + $buf = $ftp->toascii($buf); + $len = length($buf); + } -sub byte -{ - carp "TYPE L is unsupported, shall default to I"; - shift->type('L',@_); -} + if($hashh) { + $count += $len; + print $hashh "#" x (int($count / $hashb)); + $count %= $hashb; + } -# Allow the user to send a command directly, BE CAREFUL !! + my $wlen; + unless(defined($wlen = $sock->write($buf,$len)) && $wlen == $len) + { + $sock->abort; + close($loc) + unless defined $localfd; + print $hashh "\n" if $hashh; + return undef; + } + } -sub quot -{ - my $ftp = shift; - my $cmd = shift; + print $hashh "\n" if $hashh; - $ftp->command( uc $cmd, @_); - $ftp->response(); -} + close($loc) + unless defined $localfd; -sub mdtm -{ - my $ftp = shift; - my $file = shift; + $sock->close() or + return undef; - return undef - unless $ftp->_MDTM($file); + if ('STOU' eq uc $cmd and $ftp->message =~ m/unique\ file\ name:(.*)\)|"(.*)"/) + { + require File::Basename; + $remote = File::Basename::basename($+) + } - my @gt = reverse ($ftp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/); - $gt[5] -= 1; - timegm(@gt); + return $remote; } -sub size +sub port { - my $ftp = shift; - my $file = shift; + @_ == 1 || @_ == 2 or croak 'usage: $ftp->port([PORT])'; - $ftp->_SIZE($file) - ? ($ftp->message =~ /(\d+)/)[0] - : undef; -} + my($ftp,$port) = @_; + my $ok; -sub login -{ - my($ftp,$user,$pass,$acct) = @_; - my($ok,$ruser); + delete ${*$ftp}{'net_ftp_intern_port'}; - unless (defined $user) + unless(defined $port) { - require Net::Netrc; - - my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}); + # create a Listen socket at same address as the command socket - ($user,$pass,$acct) = $rc->lpa() - if ($rc); - } + ${*$ftp}{'net_ftp_listen'} ||= IO::Socket::INET->new(Listen => 5, + Proto => 'tcp', + Timeout => $ftp->timeout, + LocalAddr => $ftp->sockhost, + ); - $user ||= "anonymous"; - $ruser = $user; + my $listen = ${*$ftp}{'net_ftp_listen'}; - if(defined ${*$ftp}{'net_ftp_firewall'}) - { - $user .= "@" . ${*$ftp}{'net_ftp_host'}; - } + my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost)); - $ok = $ftp->_USER($user); + $port = join(',', @myaddr, $myport >> 8, $myport & 0xff); - # Some dumb firewall's don't prefix the connection messages - $ok = $ftp->response() - if($ok == CMD_OK && $ftp->code == 220 && $user =~ /\@/); + ${*$ftp}{'net_ftp_intern_port'} = 1; + } - if ($ok == CMD_MORE) - { - unless(defined $pass) - { - require Net::Netrc; + $ok = $ftp->_PORT($port); - my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser); + ${*$ftp}{'net_ftp_port'} = $port; - ($ruser,$pass,$acct) = $rc->lpa() - if ($rc); + $ok; +} - $pass = "-" . (getpwuid($>))[0] . "@" - if (!defined $pass && $ruser =~ /^anonymous/o); - } +sub ls { shift->_list_cmd("NLST",@_); } +sub dir { shift->_list_cmd("LIST",@_); } - $ok = $ftp->_PASS($pass || ""); - } +sub pasv +{ + @_ == 1 or croak 'usage: $ftp->pasv()'; - $ok = $ftp->_ACCT($acct || "") - if ($ok == CMD_MORE); + my $ftp = shift; - $ftp->authorize() - if($ok == CMD_OK && defined ${*$ftp}{'net_ftp_firewall'}); + delete ${*$ftp}{'net_ftp_intern_port'}; - $ok == CMD_OK; + $ftp->_PASV && $ftp->message =~ /(\d+(,\d+)+)/ + ? ${*$ftp}{'net_ftp_pasv'} = $1 + : undef; } -sub authorize +sub unique_name { - @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize( [AUTH [, RESP]])'; + my $ftp = shift; + ${*$ftp}{'net_ftp_unique'} || undef; +} - my($ftp,$auth,$resp) = @_; +sub supported { + @_ == 2 or croak 'usage: $ftp->supported( CMD )'; + my $ftp = shift; + my $cmd = uc shift; + my $hash = ${*$ftp}{'net_ftp_supported'} ||= {}; - unless(defined $resp) - { - require Net::Netrc; + return $hash->{$cmd} + if exists $hash->{$cmd}; - $auth ||= (getpwuid($>))[0]; + return $hash->{$cmd} = 0 + unless $ftp->_HELP($cmd); - my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}, $auth) - || Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}); + 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; + } - ($auth,$resp) = $rc->lpa() - if($rc); - } + $hash->{$cmd} ||= 0; +} - my $ok = $ftp->_AUTH($auth || ""); +## +## Deprecated methods +## - $ok = $ftp->_RESP($resp || "") - if ($ok == CMD_MORE); +sub lsl +{ + carp "Use of Net::FTP::lsl deprecated, use 'dir'" + if $^W; + goto &dir; +} - $ok == CMD_OK; +sub authorise +{ + carp "Use of Net::FTP::authorise deprecated, use 'authorize'" + if $^W; + goto &authorize; } -sub rename + +## +## Private methods +## + +sub _extract_path { - @_ == 3 or croak 'usage: $ftp->rename(FROM, TO)'; + my($ftp, $path) = @_; - my($ftp,$from,$to) = @_; + # 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; - $ftp->_RNFR($from) - && $ftp->_RNTO($to); + $path; } -sub type +## +## Communication methods +## + +sub _dataconn { my $ftp = shift; - my $type = shift; - my $oldval = ${*$ftp}{'net_ftp_type'}; + my $data = undef; + my $pkg = "Net::FTP::" . $ftp->type; - return $oldval - unless (defined $type); + eval "require " . $pkg; - return undef - unless ($ftp->_TYPE($type,@_)); + $pkg =~ s/ /_/g; - ${*$ftp}{'net_ftp_type'} = join(" ",$type,@_); + delete ${*$ftp}{'net_ftp_dataconn'}; - $oldval; + if(defined ${*$ftp}{'net_ftp_pasv'}) + { + my @port = split(/,/,${*$ftp}{'net_ftp_pasv'}); + + $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'}); + } + + 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'}; + } + + $data; } -sub abort +sub _list_cmd { my $ftp = shift; + my $cmd = uc shift; - send($ftp,pack("CC",TELNET_IAC,TELNET_IP),0); - send($ftp,pack("C", TELNET_IAC),MSG_OOB); - send($ftp,pack("C", TELNET_DM),0); + delete ${*$ftp}{'net_ftp_port'}; + delete ${*$ftp}{'net_ftp_pasv'}; - $ftp->command("ABOR"); + my $data = $ftp->_data_cmd($cmd,@_); - defined ${*$ftp}{'net_ftp_dataconn'} - ? ${*$ftp}{'net_ftp_dataconn'}->close() - : $ftp->response(); + return + unless(defined $data); - $ftp->response() - if $ftp->status == CMD_REJECT; + require Net::FTP::A; + bless $data, "Net::FTP::A"; # Force ASCII mode - $ftp->status == CMD_OK; -} + my $databuf = ''; + my $buf = ''; + my $blksize = ${*$ftp}{'net_ftp_blksize'}; -sub get -{ - my($ftp,$remote,$local,$where) = @_; + while($data->read($databuf,$blksize)) { + $buf .= $databuf; + } - my($loc,$len,$buf,$resp,$localfd,$data); - local *FD; + my $list = [ split(/\n/,$buf) ]; - $localfd = ref($local) ? fileno($local) - : undef; + $data->close(); - ($local = $remote) =~ s#^.*/## - unless(defined $local); + if (trEBCDIC) + { + for (@$list) { $_ = $ftp->toebcdic($_) } + } - ${*$ftp}{'net_ftp_rest'} = $where - if ($where); + wantarray ? @{$list} + : $list; +} - delete ${*$ftp}{'net_ftp_port'}; - delete ${*$ftp}{'net_ftp_pasv'}; +sub _data_cmd +{ + my $ftp = shift; + my $cmd = uc shift; + my $ok = 1; + my $where = delete ${*$ftp}{'net_ftp_rest'} || 0; + my $arg; - $data = $ftp->retr($remote) or - return undef; + for $arg (@_) { + croak("Bad argument '$arg'\n") + if $arg =~ /[\r\n]/s; + } - if(defined $localfd) - { - $loc = $local; - } - else + if(${*$ftp}{'net_ftp_passive'} && + !defined ${*$ftp}{'net_ftp_pasv'} && + !defined ${*$ftp}{'net_ftp_port'}) { - $loc = \*FD; + my $data = undef; + + $ok = defined $ftp->pasv; + $ok = $ftp->_REST($where) + if $ok && $where; - unless(($where) ? open($loc,">>$local") : open($loc,">$local")) + if($ok) { - carp "Cannot open Local file $local: $!\n"; - $data->abort; - return undef; + $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; } - if ($ftp->binary && !binmode($loc)) - { - carp "Cannot binmode Local file $local: $!\n"; - return undef; - } - $buf = ''; + $ok = $ftp->port + unless (defined ${*$ftp}{'net_ftp_port'} || + defined ${*$ftp}{'net_ftp_pasv'}); - do - { - $len = $data->read($buf,1024); - } - while($len > 0 && syswrite($loc,$buf,$len) == $len); + $ok = $ftp->_REST($where) + if $ok && $where; - close($loc) - unless defined $localfd; - - $data->close(); # implied $ftp->response + return undef + unless $ok; - return $local; -} + $ftp->command($cmd,@_); -sub cwd -{ - @_ == 2 || @_ == 3 or croak 'usage: $ftp->cwd( [ DIR ] )'; + return 1 + if(defined ${*$ftp}{'net_ftp_pasv'}); - my($ftp,$dir) = @_; + $ok = CMD_INFO == $ftp->response(); - $dir ||= "/"; + return $ok + unless exists ${*$ftp}{'net_ftp_intern_port'}; - $dir eq ".." - ? $ftp->_CDUP() - : $ftp->_CWD($dir); -} + if($ok) { + my $data = $ftp->_dataconn(); -sub cdup -{ - @_ == 1 or croak 'usage: $ftp->cdup()'; - $_[0]->_CDUP; + $data->reading + if $data && $cmd =~ /RETR|LIST|NLST/; + + return $data; + } + + + close(delete ${*$ftp}{'net_ftp_listen'}); + + return undef; } -sub pwd +## +## Over-ride methods (Net::Cmd) +## + +sub debug_text { $_[2] =~ /^(pass|resp|acct)/i ? "$1 ....\n" : $_[2]; } + +sub command { - @_ == 1 || croak 'usage: $ftp->pwd()'; my $ftp = shift; - $ftp->_PWD(); - $ftp->_extract_path; + delete ${*$ftp}{'net_ftp_port'}; + $ftp->SUPER::command(@_); } -sub rmdir +sub response { - @_ == 2 || croak 'usage: $ftp->rmdir( DIR )'; + my $ftp = shift; + my $code = $ftp->SUPER::response(); + + delete ${*$ftp}{'net_ftp_pasv'} + if ($code != CMD_MORE && $code != CMD_INFO); - $_[0]->_RMD($_[1]); + $code; } -sub mkdir +sub parse_response { - @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )'; + return ($1, $2 eq "-") + if $_[1] =~ s/^(\d\d\d)(.?)//o; - my($ftp,$dir,$recurse) = @_; + my $ftp = shift; - $ftp->_MKD($dir) || $recurse or - return undef; + # Darn MS FTP server is a load of CRAP !!!! + return () + unless ${*$ftp}{'net_cmd_code'} + 0; - my $path = undef; - unless($ftp->ok) - { - my @path = split(m#(?=/+)#, $dir); + (${*$ftp}{'net_cmd_code'},1); +} - $path = ""; +## +## Allow 2 servers to talk directly +## - while(@path) - { - $path .= shift @path; +sub pasv_xfer { + my($sftp,$sfile,$dftp,$dfile,$unique) = @_; - $ftp->_MKD($path); - $path = $ftp->_extract_path($path); + ($dfile = $sfile) =~ s#.*/## + unless(defined $dfile); + + my $port = $sftp->pasv or + return undef; - # 521 means directory already exists - last - unless $ftp->ok || $ftp->code == 521; + $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; } - } - $ftp->_extract_path($path); + $dftp->pasv_wait($sftp); } -sub delete +sub pasv_wait { - @_ == 2 || croak 'usage: $ftp->delete( FILENAME )'; + @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)'; - $_[0]->_DELE($_[1]); + 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->ok() && $non_pasv->ok(); + + return $1 + if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/; + + return $1 + if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/; + + return 1; } -sub put { shift->_store_cmd("stor",@_) } -sub put_unique { shift->_store_cmd("stou",@_) } -sub append { shift->_store_cmd("appe",@_) } +sub cmd { shift->command(@_)->response() } -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",@_) } +######################################## +# +# RFC959 commands +# -sub _store_cmd -{ - my($ftp,$cmd,$local,$remote) = @_; - my($loc,$sock,$len,$buf,$localfd); - local *FD; +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 _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() } - $localfd = ref($local) ? fileno($local) - : undef; +sub _ALLO { shift->unsupported(@_) } +sub _SMNT { shift->unsupported(@_) } +sub _MODE { shift->unsupported(@_) } +sub _SYST { shift->unsupported(@_) } +sub _STRU { shift->unsupported(@_) } +sub _REIN { shift->unsupported(@_) } - unless(defined $remote) - { - croak 'Must specify remote filename with stream input' - if defined $localfd; +1; - ($remote = $local) =~ s%.*/%%; - } +__END__ - if(defined $localfd) - { - $loc = $local; - } - else - { - $loc = \*FD; +=head1 NAME - 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; - } - } +Net::FTP - FTP Client class - delete ${*$ftp}{'net_ftp_port'}; - delete ${*$ftp}{'net_ftp_pasv'}; +=head1 SYNOPSIS - $sock = $ftp->_data_cmd($cmd, $remote) or - return undef; + use Net::FTP; - do - { - $len = sysread($loc,$buf="",1024); - } - while($len && $sock->write($buf,$len) == $len); + $ftp = Net::FTP->new("some.host.name", Debug => 0); + $ftp->login("anonymous",'-anonymous@'); + $ftp->cwd("/pub"); + $ftp->get("that.file"); + $ftp->quit; - close($loc) - unless defined $localfd; +=head1 DESCRIPTION - $sock->close(); +C 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 (on the client) and a +B (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 will try to put +that file in C locally, unless you specify a local file +name. + +The protocol also defines several standard B 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). - ($remote) = $ftp->message =~ /unique file name:\s*(\S*)\s*\)/ - if ('STOU' eq uc $cmd); +=head1 CONSTRUCTOR - return $remote; -} +=over 4 -sub port -{ - @_ == 1 || @_ == 2 or croak 'usage: $ftp->port([PORT])'; +=item new (HOST [,OPTIONS]) - my($ftp,$port) = @_; - my $ok; +This is the constructor for a new Net::FTP object. C is the +name of the remote host to which an FTP connection is required. - delete ${*$ftp}{'net_ftp_intern_port'}; +C are passed in a hash like fashion, using key and value pairs. +Possible options are: - unless(defined $port) - { - # create a Listen socket at same address as the command socket +B - The name of a machine which acts as an FTP firewall. This can be +overridden by an environment variable C. 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. - ${*$ftp}{'net_ftp_listen'} ||= IO::Socket::INET->new(Listen => 5, - Proto => 'tcp', - LocalAddr => $ftp->sockhost, - ); - - my $listen = ${*$ftp}{'net_ftp_listen'}; +B - The type of firewall running on the machine indicated by +B. This can be overridden by an environment variable +C. For a list of permissible types, see the description of +ftp_firewall_type in L. - my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost)); +B - This is the block size that Net::FTP will use when doing +transfers. (defaults to 10240) - $port = join(',', @myaddr, $myport >> 8, $myport & 0xff); +B - The port number to connect to on the remote machine for the +FTP connection - ${*$ftp}{'net_ftp_intern_port'} = 1; - } +B - Set a timeout value (defaults to 120) - $ok = $ftp->_PORT($port); +B - debug level (see the debug method in L) - ${*$ftp}{'net_ftp_port'} = $port; +B - 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 +servers, and some firewall configurations. This can also be set by the +environment variable C. - $ok; -} +B - 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 method for you, so that hash marks +are displayed for all transfers. You can, of course, call C +explicitly whenever you'd like. -sub ls { shift->_list_cmd("NLST",@_); } -sub dir { shift->_list_cmd("LIST",@_); } +If the constructor fails undef will be returned and an error message will +be in $@ -sub pasv -{ - @_ == 1 or croak 'usage: $ftp->pasv()'; +=back - my $ftp = shift; +=head1 METHODS - delete ${*$ftp}{'net_ftp_intern_port'}; +Unless otherwise stated all methods return either a I or I +value, with I meaning that the operation was a success. When a method +states that it returns a value, failure will be returned as I or an +empty list. - $ftp->_PASV && $ftp->message =~ /(\d+(,\d+)+)/ - ? ${*$ftp}{'net_ftp_pasv'} = $1 - : undef; -} +=over 4 -sub unique_name -{ - my $ftp = shift; - ${*$ftp}{'net_ftp_unique'} || undef; -} +=item login ([LOGIN [,PASSWORD [, ACCOUNT] ] ]) -## -## Depreciated methods -## +Log into the remote FTP server with the given login information. If +no arguments are given then the C uses the C +package to lookup the login information for the connected host. +If no information is found then a login of I is used. +If no password is given and the login is I then the users +Email address will be used for a password. -sub lsl -{ - carp "Use of Net::FTP::lsl depreciated, use 'dir'" - if $^W; - goto &dir; -} +If the connection is via a firewall then the C method will +be called with no arguments. -sub authorise -{ - carp "Use of Net::FTP::authorise depreciated, use 'authorize'" - if $^W; - goto &authorize; -} +=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 uses C to do a lookup. -## -## Private methods -## +=item site (ARGS) -sub _extract_path -{ - my($ftp, $path) = @_; +Send a SITE command to the remote server and wait for a response. - $ftp->ok && - $ftp->message =~ /\s\"(.*)\"\s/o && - ($path = $1) =~ s/\"\"/\"/g; +Returns most significant digit of the response code. - $path; -} +=item type (TYPE [, ARGS]) -## -## Communication methods -## +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 _dataconn -{ - my $ftp = shift; - my $data = undef; - my $pkg = "Net::FTP::" . $ftp->type; +=item ascii ([ARGS]) binary([ARGS]) ebcdic([ARGS]) byte([ARGS]) - $pkg =~ s/ /_/g; +Synonyms for C with the first arguments set correctly - delete ${*$ftp}{'net_ftp_dataconn'}; +B ebcdic and byte are not fully supported. - if(defined ${*$ftp}{'net_ftp_pasv'}) - { - my @port = split(/,/,${*$ftp}{'net_ftp_pasv'}); +=item rename ( OLDNAME, NEWNAME ) - $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'}); - } +Rename a file on the remote FTP server from C to C. This +is done by sending the RNFR and RNTO commands. - if($data) - { - ${*$data} = ""; - $data->timeout($ftp->timeout); - ${*$ftp}{'net_ftp_dataconn'} = $data; - ${*$data}{'net_ftp_cmd'} = $ftp; - } +=item delete ( FILENAME ) - $data; -} +Send a request to the server to delete C. -sub _list_cmd -{ - my $ftp = shift; - my $cmd = uc shift; +=item cwd ( [ DIR ] ) - delete ${*$ftp}{'net_ftp_port'}; - delete ${*$ftp}{'net_ftp_pasv'}; +Attempt to change directory to the directory given in C<$dir>. If +C<$dir> is C<"..">, the FTP C 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 $data = $ftp->_data_cmd($cmd,@_); +=item cdup () - return undef - unless(defined $data); +Change directory to the parent of the current directory. - bless $data, "Net::FTP::A"; # Force ASCII mode +=item pwd () - my $databuf = ''; - my $buf = ''; +Returns the full pathname of the current directory. - while($data->read($databuf,1024)) - { - $buf .= $databuf; - } +=item restart ( WHERE ) - my $list = [ split(/\n/,$buf) ]; +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. - $data->close(); +=item rmdir ( DIR ) + +Remove the directory with the name C. + +=item mkdir ( DIR [, RECURSE ]) + +Create a new directory with the name C. If C is I then +C will attempt to create all the directories in the given path. + +Returns the full pathname to the new directory. + +=item ls ( [ DIR ] ) + +Get a directory listing of C, or the current directory. + +In an array context, returns a list of lines returned from the server. In +a scalar context, returns a reference to a list. + +=item dir ( [ DIR ] ) + +Get a directory listing of C, 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. + +=item get ( REMOTE_FILE [, LOCAL_FILE [, WHERE]] ) + +Get C from the server and store locally. C 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. + +If C is given then the first C bytes of the file will +not be transfered, and the remaining bytes will be appended to +the local file if it already exists. + +Returns C, or the generated local file name if C +is not given. If an error was encountered undef is returned. + +=item put ( LOCAL_FILE [, REMOTE_FILE ] ) + +Put a file on the remote server. C may be a name or a filehandle. +If C is a filehandle then C must be specified. If +C is not specified then the file will be stored in the current +directory with the same leafname as C. + +Returns C, or the generated remote filename if C +is not given. + +B: 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. + +=item put_unique ( LOCAL_FILE [, REMOTE_FILE ] ) + +Same as put but uses the C command. + +Returns the name of the file on the server. + +=item append ( LOCAL_FILE [, REMOTE_FILE ] ) + +Same as put but appends to the file on the remote server. + +Returns C, or the generated remote filename if C +is not given. + +=item unique_name () + +Returns the name of the last file stored on the server using the +C command. + +=item mdtm ( FILE ) + +Returns the I of the given file + +=item size ( FILE ) + +Returns the size in bytes for the given file as stored on the remote server. + +B: 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. + +=item supported ( CMD ) + +Returns TRUE if the remote server supports the given command. + +=item hash ( [FILEHANDLE_GLOB_REF],[ BYTES_PER_HASH_MARK] ) + +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. - wantarray ? @{$list} - : $list; -} +=back -sub _data_cmd -{ - my $ftp = shift; - my $cmd = uc shift; - my $ok = 1; - my $where = delete ${*$ftp}{'net_ftp_rest'} || 0; +The following methods can return different results depending on +how they are called. If the user explicitly calls either +of the C or C methods then these methods will +return a I or I value. If the user does not +call either of these methods then the result will be a +reference to a C based object. - if(${*$ftp}{'net_ftp_passive'} && - !defined ${*$ftp}{'net_ftp_pasv'} && - !defined ${*$ftp}{'net_ftp_port'}) - { - my $data = undef; +=over 4 - $ok = defined $ftp->pasv; - $ok = $ftp->_REST($where) - if $ok && $where; +=item nlst ( [ DIR ] ) - if($ok) - { - $ftp->command($cmd,@_); - $data = $ftp->_dataconn(); - $ok = CMD_INFO == $ftp->response(); - } - return $ok ? $data - : undef; - } +Send an C command to the server, with an optional parameter. - $ok = $ftp->port - unless (defined ${*$ftp}{'net_ftp_port'} || - defined ${*$ftp}{'net_ftp_pasv'}); +=item list ( [ DIR ] ) - $ok = $ftp->_REST($where) - if $ok && $where; +Same as C but using the C command - return undef - unless $ok; +=item retr ( FILE ) - $ftp->command($cmd,@_); +Begin the retrieval of a file called C from the remote server. - return 1 - if(defined ${*$ftp}{'net_ftp_pasv'}); +=item stor ( FILE ) - $ok = CMD_INFO == $ftp->response(); +Tell the server that you wish to store a file. C is the +name of the new file that should be created. - return $ok - unless exists ${*$ftp}{'net_ftp_intern_port'}; +=item stou ( FILE ) - $ok ? $ftp->_dataconn() - : undef; -} +Same as C but using the C command. The name of the unique +file which was created on the server will be available via the C +method after the data connection has been closed. -## -## Over-ride methods (Net::Cmd) -## +=item appe ( FILE ) -sub debug_text { $_[2] =~ /^(pass|resp)/i ? "$1 ....\n" : $_[2]; } +Tell the server that we want to append some data to the end of a file +called C. If this file does not exist then create it. -sub command -{ - my $ftp = shift; +=back - delete ${*$ftp}{'net_ftp_port'}; - $ftp->SUPER::command(@_); -} +If for some reason you want to have complete control over the data connection, +this includes generating it and calling the C method when required, +then the user can use these methods to do so. -sub response -{ - my $ftp = shift; - my $code = $ftp->SUPER::response(); +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, C, +C and those that do not require data connections. - delete ${*$ftp}{'net_ftp_pasv'} - if ($code != CMD_MORE && $code != CMD_INFO); +=over 4 - $code; -} +=item port ( [ PORT ] ) -## -## Allow 2 servers to talk directly -## +Send a C command to the server. If C 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. -sub pasv_xfer -{ - my($sftp,$sfile,$dftp,$dfile) = @_; +=item pasv () - ($dfile = $sfile) =~ s#.*/## - unless(defined $dfile); +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 method. - my $port = $sftp->pasv or - return undef; +=back - unless($dftp->port($port) && $sftp->retr($sfile) && $dftp->stou($dfile)) - { - $sftp->abort; - $dftp->abort; - return 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. - $dftp->pasv_wait($sftp); -} +=over 4 -sub pasv_wait -{ - @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)'; +=item pasv_xfer ( SRC_FILE, DEST_SERVER [, DEST_FILE ] ) - my($ftp, $non_pasv) = @_; - my($file,$rin,$rout); +This method will do a file transfer between two remote ftp servers. If +C is omitted then the leaf name of C will be used. - vec($rin,fileno($ftp),1) = 1; - select($rout=$rin, undef, undef, undef); +=item pasv_xfer_unique ( SRC_FILE, DEST_SERVER [, DEST_FILE ] ) - $ftp->response(); - $non_pasv->response(); +Like C but the file is stored on the remote server using +the STOU command. - return undef - unless $ftp->ok() && $non_pasv->ok(); +=item pasv_wait ( NON_PASV_SERVER ) - return $1 - if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/; +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 object for the non-passive server passed as an +argument. - return $1 - if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/; +=item abort () - return 1; -} +Abort the current data transfer. -sub cmd { shift->command(@_)->responce() } +=item quit () -######################################## -# -# RFC959 commands -# +Send the QUIT command to the remote FTP server and close the socket connection. -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() } +=back -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(@_) } +=head2 Methods for the adventurous -## -## Generic data connection package -## +C inherits from C so methods defined in C may +be used to send commands to the remote FTP server. -package Net::FTP::dataconn; +=over 4 -use Carp; -use vars qw(@ISA $timeout); -use Net::Cmd; +=item quot (CMD [,ARGS]) -@ISA = qw(IO::Socket::INET); +Send a command, that Net::FTP does not directly support, to the remote +server and wait for a response. -sub abort -{ - my $data = shift; - my $ftp = ${*$data}{'net_ftp_cmd'}; +Returns most significant digit of the response code. - $ftp->abort; # this will close me -} +B This call should only be used on commands that do not require +data connections. Misuse of this method can hang the connection. -sub close -{ - my $data = shift; - my $ftp = ${*$data}{'net_ftp_cmd'}; +=back - $data->SUPER::close(); +=head1 THE dataconn CLASS - delete ${*$ftp}{'net_ftp_dataconn'} - if exists ${*$ftp}{'net_ftp_dataconn'} && - $data == ${*$ftp}{'net_ftp_dataconn'}; +Some of the methods defined in C return an object which will +be derived from this class.The dataconn class itself is derived from +the C 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. - $ftp->response() == CMD_OK && - $ftp->message =~ /unique file name:\s*(\S*)\s*\)/ && - (${*$ftp}{'net_ftp_unique'} = $1); +=over 4 - $ftp->status == CMD_OK; -} +=item read ( BUFFER, SIZE [, TIMEOUT ] ) -sub _select -{ - my $data = shift; - local *timeout = \$_[0]; shift; - my $rw = shift; +Read C bytes of data from the server and place it into C, also +performing any translation necessary. C is optional, if not +given, the timeout value from the command connection will be used. - my($rin,$win); +Returns the number of bytes read before any translation. - return 1 unless $timeout; +=item write ( BUFFER, SIZE [, TIMEOUT ] ) - $rin = ''; - vec($rin,fileno($data),1) = 1; +Write C bytes of data from C to the server, also +performing any translation necessary. C is optional, if not +given, the timeout value from the command connection will be used. - $win = $rw ? undef : $rin; - $rin = undef unless $rw; +Returns the number of bytes written before any translation. - my $nfound = select($rin, $win, undef, $timeout); +=item bytes_read () - croak "select: $!" - if $nfound < 0; +Returns the number of bytes read so far. - return $nfound; -} +=item abort () -sub can_read -{ - my $data = shift; - local *timeout = \$_[0]; +Abort the current data transfer. - $data->_select($timeout,1); -} +=item close () -sub can_write -{ - my $data = shift; - local *timeout = \$_[0]; +Close the data connection and get a response from the FTP server. Returns +I if the connection was closed successfully and the first digit of +the response from the server was a '2'. - $data->_select($timeout,0); -} +=back -sub cmd -{ - my $ftp = shift; +=head1 UNIMPLEMENTED - ${*$ftp}{'net_ftp_cmd'}; -} +The following RFC959 commands have not been implemented: +=over 4 -@Net::FTP::L::ISA = qw(Net::FTP::I); -@Net::FTP::E::ISA = qw(Net::FTP::I); +=item B -## -## Package to read/write on ASCII data connections -## +Allocates storage for the file to be transferred. -package Net::FTP::A; +=item B -use vars qw(@ISA $buf); -use Carp; +Mount a different file system structure without changing login or +accounting information. -@ISA = qw(Net::FTP::dataconn); +=item B -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; +Ask the server for "helpful information" (that's what the RFC says) on +the commands it accepts. - croak "Bad offset" - if($offset < 0); +=item B - $offset = length $buf - if($offset > length $buf); +Specifies transfer mode (stream, block or compressed) for file to be +transferred. - ${*$data} ||= ""; - my $l = 0; +=item B - READ: - { - $data->can_read($timeout) or - croak "Timeout"; +Request remote server system identification. - my $n = sysread($data, ${*$data}, $size, length ${*$data}); +=item B - return $n - unless($n >= 0); +Request remote server status. - ${*$data} =~ s/(\015)?(?!\012)\Z//so; - my $lf = $1 || ""; +=item B - ${*$data} =~ s/\015\012/\n/sgo; +Specifies file structure for file to be transferred. - substr($buf,$offset) = ${*$data}; +=item B - $l += length(${*$data}); - $offset += length(${*$data}); +Reinitialize the connection, flushing all I/O and account information. - ${*$data} = $lf; - - redo READ - if($l == 0 && $n > 0); +=back - if($n == 0 && $l == 0) - { - substr($buf,$offset) = ${*$data}; - ${*$data} = ""; - } - } +=head1 REPORTING BUGS - return $l; -} +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. -sub write -{ - my $data = shift; - local *buf = \$_[0]; shift; - my $size = shift || croak 'write($buf,$size,[$timeout])'; - my $timeout = @_ ? shift : $data->timeout; +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 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. - $data->can_write($timeout) or - croak "Timeout"; +=head1 AUTHOR - # What is previous pkt ended in \015 or not ?? +Graham Barr - my $tmp; - ($tmp = $buf) =~ s/(?!\015)\012/\015\012/sg; +=head1 SEE ALSO - my $len = $size + length($tmp) - length($buf); - my $wrote = syswrite($data, $tmp, $len); +L +L - if($wrote >= 0) - { - $wrote = $wrote == $len ? $size - : $len - $wrote - } +ftp(1), ftpd(8), RFC 959 +http://www.cis.ohio-state.edu/htbin/rfc/rfc959.html - return $wrote; -} +=head1 USE EXAMPLES -## -## Package to read/write on BINARY data connections -## +For an example of the use of Net::FTP see -package Net::FTP::I; +=over 4 -use vars qw(@ISA $buf); -use Carp; +=item http://www.csh.rit.edu/~adam/Progs/autoftp-2.0.tar.gz -@ISA = qw(Net::FTP::dataconn); +C is a program that can retrieve, send, or list files via +the FTP protocol in a non-interactive manner. -sub read -{ - my $data = shift; - local *buf = \$_[0]; shift; - my $size = shift || croak 'read($buf,$size,[$timeout])'; - my $timeout = @_ ? shift : $data->timeout; +=back - $data->can_read($timeout) or - croak "Timeout"; +=head1 CREDITS - my $n = sysread($data, $buf, $size); +Henry Gabryjelski - for the suggestion of creating directories +recursively. - $n; -} +Nathan Torkington - for some input on the documentation. -sub write -{ - my $data = shift; - local *buf = \$_[0]; shift; - my $size = shift || croak 'write($buf,$size,[$timeout])'; - my $timeout = @_ ? shift : $data->timeout; +Roderick Schertler - for various inputs - $data->can_write($timeout) or - croak "Timeout"; +=head1 COPYRIGHT - syswrite($data, $buf, $size); -} +Copyright (c) 1995-1998 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
-1; +I<$Id: //depot/libnet/Net/FTP.pm#64 $> +=cut