X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNet%2FFTP.pm;h=28ea97d947570a68abc0d66e4a432c534fbfce29;hb=564e2e78a483fb2c19eb2fe907d0dd36ce81fddb;hp=dd863005e8d706ec58dc6ff02567ff97ed65f87b;hpb=a816fa742590344244b344b1442f4f263e6f743e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm index dd86300..28ea97d 100644 --- a/lib/Net/FTP.pm +++ b/lib/Net/FTP.pm @@ -19,9 +19,10 @@ 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); -$VERSION = "2.56"; # $Id:$ +$VERSION = "2.64"; # $Id: //depot/libnet/Net/FTP.pm#67 $ @ISA = qw(Exporter Net::Cmd IO::Socket::INET); # Someday I will "use constant", when I am not bothered to much about @@ -36,6 +37,12 @@ sub pasv_xfer_unique { $sftp->pasv_xfer($sfile,$dftp,$dfile,1); } +BEGIN { + # make a constant so code is fast'ish + my $is_os390 = $^O eq 'os390'; + *trEBCDIC = sub () { $is_os390 } +} + 1; # Having problems with AutoLoader #__END__ @@ -48,6 +55,7 @@ sub new my $host = $peer; my $fire = undef; + my $fire_type = undef; if(exists($arg{Firewall}) || Net::Config->requires_firewall($peer)) { @@ -60,6 +68,9 @@ sub new { $peer = $fire; delete $arg{Port}; + $fire_type = $arg{FirewallType} + || $ENV{FTP_FIREWALL_TYPE} + || undef; } } @@ -77,6 +88,8 @@ sub new ${*$ftp}{'net_ftp_firewall'} = $fire if(defined $fire); + ${*$ftp}{'net_ftp_firewall_type'} = $fire_type + if(defined $fire_type); ${*$ftp}{'net_ftp_passive'} = int exists $arg{Passive} @@ -109,28 +122,16 @@ sub new sub hash { my $ftp = shift; # self - my $prev = ${*$ftp}{'net_ftp_hash'} || [\*STDERR, 0]; - unless(@_) { - return $prev; - } my($h,$b) = @_; - if(@_ == 1) { - unless($h) { - delete ${*$ftp}{'net_ftp_hash'}; - return $prev; - } - elsif(ref($h)) { - $b = 1024; - } - else { - ($h,$b) = (\*STDERR,$h); - } + 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]; - $prev; } sub quit @@ -141,11 +142,7 @@ sub quit $ftp->close; } -sub DESTROY -{ - my $ftp = shift; - defined(fileno($ftp)) && $ftp->quit -} +sub DESTROY {} sub ascii { shift->type('A',@_); } sub binary { shift->type('I',@_); } @@ -205,7 +202,7 @@ sub size { my $io; if($ftp->supported("SIZE")) { return $ftp->_SIZE($file) - ? ($ftp->message =~ /(\d+)/)[0] + ? ($ftp->message =~ /(\d+)$/)[0] : undef; } elsif($ftp->supported("STAT")) { @@ -215,14 +212,14 @@ sub size { my $line; foreach $line (@msg) { return (split(/\s+/,$line))[4] - if $line =~ /^[-rw]{10}/ + if $line =~ /^[-rwx]{10}/ } } else { my @files = $ftp->dir($file); if(@files) { return (split(/\s+/,$1))[4] - if $files[0] =~ /^([-rw]{10}.*)$/; + if $files[0] =~ /^([-rwx]{10}.*)$/; } } undef; @@ -244,7 +241,9 @@ sub login { $user ||= "anonymous"; $ruser = $user; - $fwtype = $NetConfig{'ftp_firewall_type'} || 0; + $fwtype = ${*$ftp}{'net_ftp_firewall_type'} + || $NetConfig{'ftp_firewall_type'} + || 0; if ($fwtype && defined ${*$ftp}{'net_ftp_firewall'}) { if ($fwtype == 1 || $fwtype == 7) { @@ -307,7 +306,7 @@ sub login { ($ruser,$pass,$acct) = $rc->lpa() if ($rc); - $pass = "-" . (eval { (getpwuid($>))[0] } || $ENV{NAME} ) . '@' + $pass = '-anonymous@' if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o)); } @@ -399,7 +398,7 @@ sub abort send($ftp,pack("CCC", $TELNET_IAC, $TELNET_IP, $TELNET_IAC),MSG_OOB); $ftp->command(pack("C",$TELNET_DM) . "ABOR"); - + ${*$ftp}{'net_ftp_dataconn'}->close() if defined ${*$ftp}{'net_ftp_dataconn'}; @@ -412,12 +411,10 @@ sub get { my($ftp,$remote,$local,$where) = @_; - my($loc,$len,$buf,$resp,$localfd,$data); + my($loc,$len,$buf,$resp,$data); local *FD; - $localfd = ref($local) || ref(\$local) eq "GLOB" - ? fileno($local) - : undef; + my $localfd = ref($local) || ref(\$local) eq "GLOB"; ($local = $remote) =~ s#^.*/## unless(defined $local); @@ -434,7 +431,7 @@ sub get $data = $ftp->retr($remote) or return undef; - if(defined $localfd) + if($localfd) { $loc = $local; } @@ -442,7 +439,7 @@ sub get { $loc = \*FD; - unless(($where) ? open($loc,">>$local") : open($loc,">$local")) + unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($where ? O_APPEND : O_TRUNC))) { carp "Cannot open Local file $local: $!\n"; $data->abort; @@ -469,6 +466,13 @@ sub get while(1) { last unless $len = $data->read($buf,$blksize); + + if (trEBCDIC && $ftp->type ne 'I') + { + $buf = $ftp->toebcdic($buf); + $len = length($buf); + } + if($hashh) { $count += $len; print $hashh "#" x (int($count / $hashb)); @@ -480,17 +484,27 @@ sub get carp "Cannot write to Local file $local: $!\n"; $data->abort; close($loc) - unless defined $localfd; + unless $localfd; return undef; } } print $hashh "\n" if $hashh; - close($loc) - unless defined $localfd; - - $data->close(); # implied $ftp->response + unless ($localfd) + { + unless (close($loc)) + { + carp "Cannot close file $local (perhaps disk space) $!\n"; + return undef; + } + } + + unless ($data->close()) # implied $ftp->response + { + carp "Unable to close datastream"; + return undef; + } return $local; } @@ -542,7 +556,7 @@ sub rmdir my $ok; return $ok - if $ftp->_RMD( $dir ) || !$recurse; + if $ok = $ftp->_RMD( $dir ) or !$recurse; # Try to delete the contents # Get a list of all the files in the directory @@ -573,6 +587,18 @@ sub rmdir return $ftp->_RMD($dir) ; } +sub restart +{ + @_ == 2 || croak 'usage: $ftp->restart( BYTE_OFFSET )'; + + my($ftp,$where) = @_; + + ${*$ftp}{'net_ftp_rest'} = $where; + + return undef; +} + + sub mkdir { @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )'; @@ -606,7 +632,7 @@ sub mkdir { my($status,$message) = ($ftp->status,$ftp->message); my $pwd = $ftp->pwd; - + if($pwd && $ftp->cwd($dir)) { $path = $dir; @@ -644,17 +670,15 @@ sub appe { shift->_data_cmd("APPE",@_) } sub _store_cmd { my($ftp,$cmd,$local,$remote) = @_; - my($loc,$sock,$len,$buf,$localfd); + my($loc,$sock,$len,$buf); local *FD; - $localfd = ref($local) || ref(\$local) eq "GLOB" - ? fileno($local) - : undef; + my $localfd = ref($local) || ref(\$local) eq "GLOB"; unless(defined $remote) { croak 'Must specify remote filename with stream input' - if defined $localfd; + if $localfd; require File::Basename; $remote = File::Basename::basename($local); @@ -663,7 +687,7 @@ sub _store_cmd croak("Bad remote filename '$remote'\n") if $remote =~ /[\r\n]/s; - if(defined $localfd) + if($localfd) { $loc = $local; } @@ -671,7 +695,7 @@ sub _store_cmd { $loc = \*FD; - unless(open($loc,"<$local")) + unless(sysopen($loc, $local, O_RDONLY)) { carp "Cannot open Local file $local: $!\n"; return undef; @@ -701,6 +725,12 @@ sub _store_cmd { last unless $len = sysread($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)); @@ -712,7 +742,7 @@ sub _store_cmd { $sock->abort; close($loc) - unless defined $localfd; + unless $localfd; print $hashh "\n" if $hashh; return undef; } @@ -721,13 +751,16 @@ sub _store_cmd print $hashh "\n" if $hashh; close($loc) - unless defined $localfd; + unless $localfd; $sock->close() or return undef; - ($remote) = $ftp->message =~ /unique file name:\s*(\S*)\s*\)/ - if ('STOU' eq uc $cmd); + if ('STOU' eq uc $cmd and $ftp->message =~ m/unique\ file\ name:(.*)\)|"(.*)"/) + { + require File::Basename; + $remote = File::Basename::basename($+) + } return $remote; } @@ -747,11 +780,13 @@ sub port ${*$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(/\./,$ftp->sockhost)); + my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost)); $port = join(',', @myaddr, $myport >> 8, $myport & 0xff); @@ -802,10 +837,9 @@ sub supported { my $text = $ftp->message; if($text =~ /following\s+commands/i) { $text =~ s/^.*\n//; - $text =~ s/\n/ /sog; - while($text =~ /(\w+)([* ])/g) { - $hash->{"\U$1"} = $2 eq " " ? 1 : 0; - } + while($text =~ /(\*?)(\w+)(\*?)/sg) { + $hash->{"\U$2"} = !length("$1$3"); + } } else { $hash->{$cmd} = $text !~ /unimplemented/i; @@ -923,6 +957,11 @@ sub _list_cmd $data->close(); + if (trEBCDIC) + { + for (@$list) { $_ = $ftp->toebcdic($_) } + } + wantarray ? @{$list} : $list; } @@ -996,9 +1035,9 @@ sub _data_cmd return $data; } - + close(delete ${*$ftp}{'net_ftp_listen'}); - + return undef; } @@ -1151,9 +1190,9 @@ Net::FTP - FTP Client class =head1 SYNOPSIS use Net::FTP; - + $ftp = Net::FTP->new("some.host.name", Debug => 0); - $ftp->login("anonymous",'me@here.there'); + $ftp->login("anonymous",'-anonymous@'); $ftp->cwd("/pub"); $ftp->get("that.file"); $ftp->quit; @@ -1200,17 +1239,22 @@ this if you really know what you're doing). =item new (HOST [,OPTIONS]) This is the constructor for a new Net::FTP object. C is the -name of the remote host to which a FTP connection is required. +name of the remote host to which an FTP connection is required. C are passed in a hash like fashion, using key and value pairs. Possible options are: -B - The name of a machine which acts as a FTP firewall. This can be +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 a ftp proxy. +as an ftp proxy. + +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. B - This is the block size that Net::FTP will use when doing transfers. (defaults to 10240) @@ -1253,8 +1297,8 @@ 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. +If no password is given and the login is I then I +will be used for password. If the connection is via a firewall then the C method will be called with no arguments. @@ -1307,6 +1351,13 @@ Change directory to the parent of the current directory. Returns the full pathname of the current directory. +=item restart ( WHERE ) + +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. + =item rmdir ( DIR ) Remove the directory with the name C. @@ -1335,7 +1386,7 @@ 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 the file will be stored in +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 @@ -1343,7 +1394,7 @@ 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. +is not given. If an error was encountered undef is returned. =item put ( LOCAL_FILE [, REMOTE_FILE ] ) @@ -1417,7 +1468,7 @@ reference to a C based object. =item nlst ( [ DIR ] ) -Send a C command to the server, with an optional parameter. +Send an C command to the server, with an optional parameter. =item list ( [ DIR ] ) @@ -1458,7 +1509,7 @@ C and those that do not require data connections. =item port ( [ PORT ] ) 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 +to the server. If not, then a listen socket is created and the correct information sent to the server. =item pasv () @@ -1534,7 +1585,7 @@ be performed using these. 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. +given, the timeout value from the command connection will be used. Returns the number of bytes read before any translation. @@ -1542,10 +1593,14 @@ Returns the number of bytes read before any translation. 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. +given, the timeout value from the command connection will be used. Returns the number of bytes written before any translation. +=item bytes_read () + +Returns the number of bytes read so far. + =item abort () Abort the current data transfer. @@ -1625,6 +1680,19 @@ L ftp(1), ftpd(8), RFC 959 http://www.cis.ohio-state.edu/htbin/rfc/rfc959.html +=head1 USE EXAMPLES + +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 + +C is a program that can retrieve, send, or list files via +the FTP protocol in a non-interactive manner. + +=back + =head1 CREDITS Henry Gabryjelski - for the suggestion of creating directories @@ -1640,4 +1708,8 @@ 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
+ +I<$Id: //depot/libnet/Net/FTP.pm#67 $> + =cut