X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNet%2FFTP.pm;h=aac72b2277fabbdb7637cae9928ec0862755ee16;hb=53273a086103cdbbf7ebdd5f1a18b2c0777cbc1b;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..aac72b2 100644 --- a/lib/Net/FTP.pm +++ b/lib/Net/FTP.pm @@ -1,1391 +1,1790 @@ # 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-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. +# +# Documentation (at end) improved 1996 by Nathan Torkington . 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 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 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 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 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 - 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(defined $fire) + { + $peer = $fire; + delete $arg{Port}; + $fire_type = $arg{FirewallType} + || $ENV{FTP_FIREWALL_TYPE} + || $NetConfig{firewall_type} + || undef; + } + } -B - 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 - 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 level + ${*$ftp}{'net_ftp_localaddr'} = $arg{'LocalAddr'}; -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]]) -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. +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 with the first arguments set correctly +sub quit +{ + my $ftp = shift; -B 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 to C. 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. +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, 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. +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. If C is I then -C 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, 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, 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 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. + $ok = $ftp->_USER($fwuser); -Returns C, or the generated local file name if C -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 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->_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 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, or the generated remote filename if C -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 command. + $pass = '-anonymous@' + if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o)); + } -=item mdtm ( FILE ) + $ok = $ftp->_PASS($pass || ""); + } -Returns the I 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 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. +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 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 but using the C 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 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 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 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. + 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. 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 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, C, -C 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 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. + 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 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 is omitted then the leaf name of C 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 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 inherits from C so methods defined in C 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 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 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. + 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 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. + print $hashh "\n" if $hashh; -Returns the number of bytes read before any 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 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. + return $local; +} -Returns the number of bytes written before any 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 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 +# 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 -L + # 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 - 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 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). - $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 is the +name of the remote host to which an FTP connection is required. + +C is optional. If C is not given then it may instead be +passed as the C option described below. -sub cwd -{ - @_ == 2 || @_ == 3 or croak 'usage: $ftp->cwd( [ DIR ] )'; +C are passed in a hash like fashion, using key and value pairs. +Possible options are: - my($ftp,$dir) = @_; +B - FTP host to connect to. It may be a single scalar, as defined for +the C option in L, or a reference to +an array with hosts to try in turn. The L method will return the value +which was used to connect to the host. - $dir ||= "/"; - $dir eq ".." - ? $ftp->_CDUP() - : $ftp->_CWD($dir); -} +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. -sub cdup -{ - @_ == 1 or croak 'usage: $ftp->cdup()'; - $_[0]->_CDUP; -} +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. -sub pwd -{ - @_ == 1 || croak 'usage: $ftp->pwd()'; - my $ftp = shift; +B - This is the block size that Net::FTP will use when doing +transfers. (defaults to 10240) - $ftp->_PWD(); - $ftp->_extract_path; -} +B - The port number to connect to on the remote machine for the +FTP connection -sub rmdir -{ - @_ == 2 || croak 'usage: $ftp->rmdir( DIR )'; +B - Set a timeout value (defaults to 120) - $_[0]->_RMD($_[1]); -} +B - debug level (see the debug method in L) -sub mkdir -{ - @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )'; +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. - my($ftp,$dir,$recurse) = @_; +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. - $ftp->_MKD($dir) || $recurse or - return undef; +B - Local address to use for all socket connections, this +argument will be passed to L - 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 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. - # 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 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 I +will be used for password. - $_[0]->_DELE($_[1]); -} +If the connection is via a firewall then the C 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 uses C 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: 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 to C. 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. - 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 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. If C is I then +C 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. If C is I then +C 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 argument represents the size of the file in bytes. The +C 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, 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, 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 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. - $ftp->ok && - $ftp->message =~ /\s\"(.*)\"\s/o && - ($path = $1) =~ s/\"\"/\"/g; +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. - $path; -} +Returns C, or the generated local file name if C +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 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. - $pkg =~ s/ /_/g; +Returns C, or the generated remote filename if C +is not given. - delete ${*$ftp}{'net_ftp_dataconn'}; +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. - 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 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, or the generated remote filename if C +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 command. - bless $data, "Net::FTP::A"; # Force ASCII mode +=item mdtm ( FILE ) - my $databuf = ''; - my $buf = ''; +Returns the I 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: 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 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. - $ok = $ftp->_REST($where) - if $ok && $where; +=over 4 - return undef - unless $ok; +=item nlst ( [ DIR ] ) - $ftp->command($cmd,@_); +Send an C 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 but using the C 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 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 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 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. -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. 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 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, C, +C 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 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. - $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 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 is omitted then the leaf name of C 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 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 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 inherits from C so methods defined in C 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 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 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. - 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 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 $nfound = select($rin, $win, undef, $timeout); +Returns the number of bytes read before any translation. - croak "select: $!" - if $nfound < 0; +=item write ( BUFFER, SIZE [, TIMEOUT ] ) - return $nfound; -} +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. -sub can_read -{ - my $data = shift; - local *timeout = \$_[0]; +Returns the number of bytes written before any 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 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 -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 - $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 - 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 - return $n - unless($n >= 0); +Request remote server system identification. - ${*$data} =~ s/(\015)?(?!\012)\Z//so; - my $lf = $1 || ""; +=item B - ${*$data} =~ s/\015\012/\n/sgo; +Request remote server status. - substr($buf,$offset) = ${*$data}; +=item B - $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 - 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 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 - if($wrote >= 0) - { - $wrote = $wrote == $len ? $size - : $len - $wrote - } +=head1 SEE ALSO - return $wrote; -} +L +L -## -## 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 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 - for the suggestion of creating directories +recursively. - $data->can_write($timeout) or - croak "Timeout"; +Nathan Torkington - for some input on the documentation. - syswrite($data, $buf, $size); -} +Roderick Schertler - 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