X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNet%2FFTP.pm;h=aac72b2277fabbdb7637cae9928ec0862755ee16;hb=53273a086103cdbbf7ebdd5f1a18b2c0777cbc1b;hp=999889772dc4877e51ecb35ddd5f73cf7b31750d;hpb=16f7bb68db421d28ad8e9aad0b940103189bbc43;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm index 9998897..aac72b2 100644 --- a/lib/Net/FTP.pm +++ b/lib/Net/FTP.pm @@ -1,6 +1,6 @@ # Net::FTP.pm # -# Copyright (c) 1995-8 Graham Barr . All rights reserved. +# Copyright (c) 1995-2004 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # @@ -22,7 +22,7 @@ use Net::Config; use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC); # use AutoLoader qw(AUTOLOAD); -$VERSION = "2.65"; # $Id: //depot/libnet/Net/FTP.pm#68 $ +$VERSION = "2.75"; @ISA = qw(Exporter Net::Cmd IO::Socket::INET); # Someday I will "use constant", when I am not bothered to much about @@ -50,8 +50,14 @@ BEGIN { sub new { my $pkg = shift; - my $peer = shift; - my %arg = @_; + my ($peer,%arg); + if (@_ % 2) { + $peer = shift ; + %arg = @_; + } else { + %arg = @_; + $peer=delete $arg{Host}; + } my $host = $peer; my $fire = undef; @@ -70,12 +76,14 @@ sub new delete $arg{Port}; $fire_type = $arg{FirewallType} || $ENV{FTP_FIREWALL_TYPE} + || $NetConfig{firewall_type} || undef; } } my $ftp = $pkg->SUPER::new(PeerAddr => $peer, PeerPort => $arg{Port} || 'ftp(21)', + LocalAddr => $arg{'LocalAddr'}, Proto => 'tcp', Timeout => defined $arg{Timeout} ? $arg{Timeout} @@ -86,6 +94,8 @@ sub new ${*$ftp}{'net_ftp_type'} = 'A'; # ASCII/binary/etc mode ${*$ftp}{'net_ftp_blksize'} = abs($arg{'BlockSize'} || 10240); + ${*$ftp}{'net_ftp_localaddr'} = $arg{'LocalAddr'}; + ${*$ftp}{'net_ftp_firewall'} = $fire if(defined $fire); ${*$ftp}{'net_ftp_firewall_type'} = $fire_type @@ -120,6 +130,13 @@ sub new ## User interface methods ## + +sub host { + my $me = shift; + ${*$me}{'net_ftp_host'}; +} + + sub hash { my $ftp = shift; # self @@ -202,7 +219,7 @@ sub size { my $io; if($ftp->supported("SIZE")) { return $ftp->_SIZE($file) - ? ($ftp->message =~ /(\d+)$/)[0] + ? ($ftp->message =~ /(\d+)\s*(bytes?\s*)?$/)[0] : undef; } elsif($ftp->supported("STAT")) { @@ -212,14 +229,14 @@ sub size { my $line; foreach $line (@msg) { return (split(/\s+/,$line))[4] - if $line =~ /^[-rwx]{10}/ + if $line =~ /^[-rwxSsTt]{10}/ } } else { my @files = $ftp->dir($file); if(@files) { return (split(/\s+/,$1))[4] - if $files[0] =~ /^([-rwx]{10}.*)$/; + if $files[0] =~ /^([-rwxSsTt]{10}.*)$/; } } undef; @@ -391,6 +408,23 @@ sub type $oldval; } +sub alloc +{ + my $ftp = shift; + my $size = shift; + my $oldval = ${*$ftp}{'net_ftp_allo'}; + + return $oldval + unless (defined $size); + + return undef + unless ($ftp->_ALLO($size,@_)); + + ${*$ftp}{'net_ftp_allo'} = join(" ",$size,@_); + + $oldval; +} + sub abort { my $ftp = shift; @@ -422,8 +456,8 @@ sub get croak("Bad remote filename '$remote'\n") if $remote =~ /[\r\n]/s; - ${*$ftp}{'net_ftp_rest'} = $where - if ($where); + ${*$ftp}{'net_ftp_rest'} = $where if defined $where; + my $rest = ${*$ftp}{'net_ftp_rest'}; delete ${*$ftp}{'net_ftp_port'}; delete ${*$ftp}{'net_ftp_pasv'}; @@ -439,7 +473,7 @@ sub get { $loc = \*FD; - unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($where ? O_APPEND : O_TRUNC))) + unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($rest ? O_APPEND : O_TRUNC))) { carp "Cannot open Local file $local: $!\n"; $data->abort; @@ -462,6 +496,7 @@ sub get if($ref = ${*$ftp}{'net_ftp_hash'}); my $blksize = ${*$ftp}{'net_ftp_blksize'}; + local $\; # Just in case while(1) { @@ -478,8 +513,7 @@ sub get print $hashh "#" x (int($count / $hashb)); $count %= $hashb; } - my $written = syswrite($loc,$buf,$len); - unless(defined($written) && $written == $len) + unless(print $loc $buf) { carp "Cannot write to Local file $local: $!\n"; $data->abort; @@ -560,14 +594,14 @@ sub rmdir # Try to delete the contents # Get a list of all the files in the directory - my $filelist = $ftp->ls($dir); + my @filelist = grep { !/^\.{1,2}$/ } $ftp->ls($dir); return undef - unless $filelist && @$filelist; # failed, it is probably not a directory + unless @filelist; # failed, it is probably not a directory # Go thru and delete each file or the directory my $file; - foreach $file (map { m,/, ? $_ : "$dir/$_" } @$filelist) + foreach $file (map { m,/, ? $_ : "$dir/$_" } @filelist) { next # successfully deleted the file if $ftp->delete($file); @@ -625,7 +659,7 @@ sub mkdir $path = $ftp->_extract_path($path); } - # If the creation of the last element was not sucessful, see if we + # If the creation of the last element was not successful, see if we # can cd to it, if so then return path unless($ftp->ok) @@ -683,7 +717,18 @@ sub _store_cmd require File::Basename; $remote = File::Basename::basename($local); } - + if( defined ${*$ftp}{'net_ftp_allo'} ) + { + delete ${*$ftp}{'net_ftp_allo'}; + } else + { + # if the user hasn't already invoked the alloc method since the last + # _store_cmd call, figure out if the local file is a regular file(not + # a pipe, or device) and if so get the file size from stat, and send + # an ALLO command before sending the STOR, STOU, or APPE command. + my $size = do { local $^W; -f $local && -s _ }; # no ALLO if sending data from a pipe + $ftp->_ALLO($size) if $size; + } croak("Bad remote filename '$remote'\n") if $remote =~ /[\r\n]/s; @@ -714,6 +759,9 @@ sub _store_cmd $sock = $ftp->_data_cmd($cmd, $remote) or return undef; + $remote = ($ftp->message =~ /FILE:\s*(.*)/)[0] + if 'STOU' eq uc $cmd; + my $blksize = ${*$ftp}{'net_ftp_blksize'}; my($count,$hashh,$hashb,$ref) = (0); @@ -723,7 +771,7 @@ sub _store_cmd while(1) { - last unless $len = sysread($loc,$buf="",$blksize); + last unless $len = read($loc,$buf="",$blksize); if (trEBCDIC && $ftp->type ne 'I') { @@ -904,10 +952,11 @@ sub _dataconn if(defined ${*$ftp}{'net_ftp_pasv'}) { - my @port = split(/,/,${*$ftp}{'net_ftp_pasv'}); + my @port = map { 0+$_ } split(/,/,${*$ftp}{'net_ftp_pasv'}); $data = $pkg->new(PeerAddr => join(".",@port[0..3]), PeerPort => $port[4] * 256 + $port[5], + LocalAddr => ${*$ftp}{'net_ftp_localaddr'}, Proto => 'tcp' ); } @@ -1142,6 +1191,7 @@ sub cmd { shift->command(@_)->response() } # 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 } @@ -1172,7 +1222,6 @@ sub _PASS { shift->command("PASS",@_)->response() } sub _ACCT { shift->command("ACCT",@_)->response() } sub _AUTH { shift->command("AUTH",@_)->response() } -sub _ALLO { shift->unsupported(@_) } sub _SMNT { shift->unsupported(@_) } sub _MODE { shift->unsupported(@_) } sub _SYST { shift->unsupported(@_) } @@ -1191,10 +1240,18 @@ Net::FTP - FTP Client class use Net::FTP; - $ftp = Net::FTP->new("some.host.name", Debug => 0); - $ftp->login("anonymous",'-anonymous@'); - $ftp->cwd("/pub"); - $ftp->get("that.file"); + $ftp = Net::FTP->new("some.host.name", Debug => 0) + or die "Cannot connect to some.host.name: $@"; + + $ftp->login("anonymous",'-anonymous@') + or die "Cannot login ", $ftp->message; + + $ftp->cwd("/pub") + or die "Cannot change working directory ", $ftp->message; + + $ftp->get("that.file") + or die "get failed ", $ftp->message; + $ftp->quit; =head1 DESCRIPTION @@ -1236,14 +1293,23 @@ this if you really know what you're doing). =over 4 -=item new (HOST [,OPTIONS]) +=item new ([ HOST ] [, OPTIONS ]) 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. + C are passed in a hash like fashion, using key and value pairs. Possible options are: +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. + + 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 @@ -1277,6 +1343,9 @@ 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. +B - Local address to use for all socket connections, this +argument will be passed to L + If the constructor fails undef will be returned and an error message will be in $@ @@ -1315,17 +1384,16 @@ Send a SITE command to the remote server and wait for a response. Returns most significant digit of the response code. -=item type (TYPE [, ARGS]) +=item ascii -This method will send the TYPE command to the remote FTP server -to change the type of data transfer. The return value is the previous -value. +Transfer file in ASCII. CRLF translation will be done if required -=item ascii ([ARGS]) binary([ARGS]) ebcdic([ARGS]) byte([ARGS]) +=item binary -Synonyms for C with the first arguments set correctly +Transfer file in binary mode. No transformation will be done. -B ebcdic and byte are not fully supported. +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. =item rename ( OLDNAME, NEWNAME ) @@ -1358,9 +1426,10 @@ 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. -=item rmdir ( DIR ) +=item rmdir ( DIR [, RECURSE ]) -Remove the directory with the name C. +Remove the directory with the name C. If C is I then +C will attempt to delete everything inside the directory. =item mkdir ( DIR [, RECURSE ]) @@ -1369,6 +1438,20 @@ C will attempt to create all the directories in the given path. Returns the full pathname to the new directory. +=item alloc ( SIZE [, RECORD_SIZE] ) + +The alloc command allows you to give the ftp server a hint about the size +of the file about to be transfered using the ALLO ftp command. Some storage +systems use this to make intelligent decisions about how to store the file. +The C 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. + +The size of the file will be determined, and sent to the server +automatically for normal files so that this method need only be called if +you are transfering data from a socket, named pipe, or other stream not +associated with a normal file. + =item ls ( [ DIR ] ) Get a directory listing of C, or the current directory. @@ -1619,10 +1702,6 @@ The following RFC959 commands have not been implemented: =over 4 -=item B - -Allocates storage for the file to be transferred. - =item B Mount a different file system structure without changing login or @@ -1686,7 +1765,7 @@ For an example of the use of Net::FTP see =over 4 -=item http://www.csh.rit.edu/~adam/Progs/autoftp-2.0.tar.gz +=item http://www.csh.rit.edu/~adam/Progs/ C is a program that can retrieve, send, or list files via the FTP protocol in a non-interactive manner. @@ -1704,12 +1783,8 @@ Roderick Schertler - for various inputs =head1 COPYRIGHT -Copyright (c) 1995-1998 Graham Barr. All rights reserved. +Copyright (c) 1995-2004 Graham Barr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=for html
- -I<$Id: //depot/libnet/Net/FTP.pm#68 $> - =cut