From: Jarkko Hietaniemi Date: Fri, 17 Aug 2001 13:47:53 +0000 (+0000) Subject: Upgrade to libnet 1.0704. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=686337f3173d259f9dc05f9d6c19a8c95e2cb00b;p=p5sagit%2Fp5-mst-13.2.git Upgrade to libnet 1.0704. p4raw-id: //depot/perl@11709 --- diff --git a/MANIFEST b/MANIFEST index 4b7d052..62b940e 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1019,7 +1019,6 @@ lib/Net/demos/nntp libnet lib/Net/demos/nntp.mirror libnet lib/Net/demos/pop3 libnet lib/Net/demos/smtp.self libnet -lib/Net/demos/snpp libnet lib/Net/demos/time libnet lib/Net/Domain.pm libnet lib/Net/FTP.pm libnet @@ -1031,7 +1030,6 @@ lib/Net/FTP/L.pm libnet lib/Net/hostent.pm By-name interface to Perl's builtin gethost* lib/Net/hostent.t See if Net::hostent works lib/Net/Hostname.eg libnet -lib/Net/libnet.ppd libnet lib/Net/libnetFAQ.pod libnet lib/Net/netent.pm By-name interface to Perl's builtin getnet* lib/Net/netent.t See if Net::netent works @@ -1041,7 +1039,6 @@ lib/Net/Ping.pm Hello, anybody home? lib/Net/POP3.pm libnet lib/Net/protoent.pm By-name interface to Perl's builtin getproto* lib/Net/protoent.t See if Net::protoent works -lib/Net/README.config libnet lib/Net/README.libnet libnet lib/Net/servent.pm By-name interface to Perl's builtin getserv* lib/Net/servent.t See if Net::servtent works diff --git a/lib/Net/ChangeLog.libnet b/lib/Net/ChangeLog.libnet index ccfcac5..fcd4576 100644 --- a/lib/Net/ChangeLog.libnet +++ b/lib/Net/ChangeLog.libnet @@ -1,3 +1,138 @@ +Change 625 on 2001/08/17 by (Graham Barr) + + Doc updates and add cc and bcc as aliases for recipient + +Change 624 on 2001/08/17 by (Graham Barr) + + Don't set ENV variables + +Change 623 on 2001/08/17 by (Graham Barr) + + Support mixed case in the EHLO response + +Change 622 on 2001/08/06 by (Graham Barr) + + Documentation update + +Change 621 on 2001/08/06 by (Graham Barr) + + Set the status if command returns due to the connection being closed + +Change 620 on 2001/08/06 by (Graham Barr) + + Fix for _msg_spec when passed the same msg number twice, pass N instead of N-N + +Change 619 on 2001/05/29 by (Graham Barr) + + Remove DummyInetd + +Change 618 on 2001/05/29 by (Graham Barr) + + Move snpp into its own distribution + +Change 615 on 2001/05/29 by (Graham Barr) + + Move PH to its own dist + +Change 614 on 2001/05/29 by (Graham Barr) + + Move TFTP out of libnet + +Change 612 on 2001/03/29 by (Graham Barr) + + Support some non standard servers that return more than + just a number in response to SIZE. But the size must be + the last thing on the response line [Jeffery W Long] + +Change 603 on 2000/10/06 by (Graham Barr) + + Net::Config + - Added documentation for ftp_firewall_type + +Change 574 on 2000/08/24 by (Graham Barr) + + Net::FTP + - Make listen socket listen on same interfacce as the command connection + this fixes a problem when going via a SOCKS firewall + +Change 458 on 2000/03/29 by (Graham Barr) + + Net::Cmd, Net::FTP + - Support for os390, modified from a patch from Dan Campbell + +Change 455 on 2000/03/29 by (Graham Barr) + + Net::Domain + - silence warnings on Win32 that domainname does not exist + +Change 454 on 2000/03/29 by (Graham Barr) + + Net::FTP + - More error checking in ->get() + +Change 453 on 2000/03/29 by (Graham Barr) + + Net::FTP + - update pattern to dig out unique filename from stou + +Change 452 on 2000/03/29 by (Graham Barr) + + t/ftp.t + - silently pass if the stor to /pub fails + +Change 451 on 2000/03/29 by (Graham Barr) + + Net::FTP + - Add Timeout to listen socket + +Change 450 on 2000/03/29 by (Graham Barr) + + Makefile.PL + - only add ppd conditional on perl version + +Change 449 on 2000/03/29 by (Graham Barr) + + Fixed mput example in FAQ to use glob() + +Change 448 on 2000/03/29 by (Graham Barr) + + Update README to reflect new way Configure works + +Change 447 on 2000/03/29 by (Graham Barr) + + Net::Config + - Check that $home is defined before we use it + +Change 446 on 2000/03/29 by (Graham Barr) + + Net::FTP + - add link to autoftp example + +Change 445 on 2000/03/29 by (Graham Barr) + + Net::FTP::A, Net::FTP::I + - Move the timeout check into the loop to prevent hanging + on write. + +Change 444 on 2000/03/29 by (Graham Barr) + + Net::Cmd, Net::FTP::A, Net::FTP::I + - MacOS does not like the setting of $SIG{PIPE} so check $^O + +Change 432 on 2000/03/29 by (Graham Barr) + + POD cleanup + +Change 431 on 2000/03/29 by (Graham Barr) + + Net::NNTP + - Allow a filehandle to be passed to article, head and body + +Change 430 on 2000/03/29 by (Graham Barr) + + Net::TFTP + - There is no quit method, so don't document one + Change 402 on 2000/03/23 by (Graham Barr) Net::Config diff --git a/lib/Net/Cmd.pm b/lib/Net/Cmd.pm index 22b8d48..a23a437 100644 --- a/lib/Net/Cmd.pm +++ b/lib/Net/Cmd.pm @@ -1,4 +1,4 @@ -# Net::Cmd.pm +# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#25 $ # # Copyright (c) 1995-1997 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or @@ -13,7 +13,14 @@ use strict; use vars qw(@ISA @EXPORT $VERSION); use Carp; -$VERSION = "2.18"; +BEGIN { + if ($^O eq 'os390') { + require Convert::EBCDIC; +# Convert::EBCDIC->import; + } +} + +$VERSION = "2.19"; @ISA = qw(Exporter); @EXPORT = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING); @@ -26,6 +33,32 @@ sub CMD_PENDING { 0 } my %debug = (); +my $tr = $^O eq 'os390' ? Convert::EBCDIC->new() : undef; + +sub toebcdic +{ + my $cmd = shift; + + unless (exists ${*$cmd}{'net_cmd_asciipeer'}) + { + my $string = $_[0]; + my $ebcdicstr = $tr->toebcdic($string); + ${*$cmd}{'net_cmd_asciipeer'} = $string !~ /^\d+/ && $ebcdicstr =~ /^\d+/; + } + + ${*$cmd}{'net_cmd_asciipeer'} + ? $tr->toebcdic($_[0]) + : $_[0]; +} + +sub toascii +{ + my $cmd = shift; + ${*$cmd}{'net_cmd_asciipeer'} + ? $tr->toascii($_[0]) + : $_[0]; +} + sub _print_isa { no strict qw(refs); @@ -159,19 +192,27 @@ sub command { my $cmd = shift; - return $cmd unless defined fileno($cmd); - + unless (defined fileno($cmd)) + { + $cmd->set_status("599", "Connection closed"); + return $cmd; + } + + $cmd->dataend() if(exists ${*$cmd}{'net_cmd_lastch'}); if (scalar(@_)) { - local $SIG{PIPE} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS'; + + my $str = join(" ", map { /\n/ ? do { my $n = $_; $n =~ tr/\n/ /; $n } : $_; } @_); + $str = $cmd->toascii($str) if $tr; + $str .= "\015\012"; - my $str = join(" ", map { /\n/ ? do { my $n = $_; $n =~ tr/\n/ /; $n } : $_; } @_) . "\015\012"; my $len = length $str; my $swlen; - + $cmd->close unless (defined($swlen = syswrite($cmd,$str,$len)) && $swlen == $len); @@ -214,7 +255,7 @@ sub getline my $partial = defined(${*$cmd}{'net_cmd_partial'}) ? ${*$cmd}{'net_cmd_partial'} : ""; my $fd = fileno($cmd); - + return undef unless defined $fd; @@ -255,6 +296,14 @@ sub getline ${*$cmd}{'net_cmd_partial'} = $partial; + if ($tr) + { + foreach my $ln (@{${*$cmd}{'net_cmd_lines'}}) + { + $ln = $cmd->toebcdic($ln); + } + } + shift @{${*$cmd}{'net_cmd_lines'}}; } @@ -437,7 +486,7 @@ Net::Cmd - Network Command class (as used by FTP, SMTP etc) =head1 SYNOPSIS use Net::Cmd; - + @ISA = qw(Net::Cmd); =head1 DESCRIPTION @@ -588,4 +637,8 @@ Copyright (c) 1995-1997 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/Cmd.pm#25 $> + =cut diff --git a/lib/Net/Config.pm b/lib/Net/Config.pm index e0dd1d9..db503b5 100644 --- a/lib/Net/Config.pm +++ b/lib/Net/Config.pm @@ -1,6 +1,10 @@ +# Net::Config.pm +# +# Copyright (c) 2000 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. package Net::Config; -# $Id: //depot/libnet/Net/Config.pm#6 $ require Exporter; use vars qw(@ISA @EXPORT %NetConfig $VERSION $CONFIGURE $LIBNET_CFG); @@ -9,7 +13,7 @@ use strict; @EXPORT = qw(%NetConfig); @ISA = qw(Net::LocalCfg Exporter); -$VERSION = "1.04"; +$VERSION = "1.05"; # $Id: //depot/libnet/Net/Config.pm#9 $ eval { local $SIG{__DIE__}; require Net::LocalCfg }; @@ -40,12 +44,13 @@ if ( -f $file ) { } } if ($< == $> and !$CONFIGURE) { - use File::Spec; - my $home = eval { (getpwuid($>))[7] } || $ENV{HOME} || $ENV{HOMEDRIVE} || $ENV{HOMEPATH} || File::Spec->curdir; - $file = File::Spec->catfile($home, ".libnetrc"); - $ref = eval { do $file } if -f $file; - %NetConfig = (%NetConfig, %{ $ref }) - if ref($ref) eq 'HASH'; + my $home = eval { (getpwuid($>))[7] } || $ENV{HOME}; + if (defined $home) { + $file = $home . "/.libnetrc"; + $ref = eval { do $file } if -f $file; + %NetConfig = (%NetConfig, %{ $ref }) + if ref($ref) eq 'HASH'; + } } my ($k,$v); while(($k,$v) = each %NetConfig) { @@ -168,6 +173,73 @@ then this value should be set to the firewall hostname. If your firewall does not listen to port 21, then this value should be set to C<"hostname:port"> (eg C<"hostname:99">) +=item ftp_firewall_type + +There are many different ftp firewall products avaliable. But unfortunately there +is not standard for how to traverse a firewall. The list below shows the +sequence of commands that Net::FTP will use + + user Username for remote host + pass Password for remote host + fwuser Username for firewall + fwpass Password for firewall + remote.host The hostname of the remote ftp server + +=over 4 + +=item 0 + +There is no firewall + +=item 1 + + USER user@remote.host + PASS pass + +=item 2 + + USER fwuser + PASS fwpass + USER user@remote.host + PASS pass + +=item 3 + + USER fwuser + PASS fwpass + SITE remote.site + USER user + PASS pass + +=item 4 + + USER fwuser + PASS fwpass + OPEN remote.site + USER user + PASS pass + +=item 5 + + USER user@fwuser@remote.site + PASS pass@fwpass + +=item 6 + + USER fwuser@remote.site + PASS fwpass + USER user + PASS pass + +=item 7 + + USER user@remote.host + PASS pass + AUTH fwuser + RESP fwpass + +=back + =item ftp_ext_passive =item ftp_int_pasive @@ -210,4 +282,8 @@ If true the C will check each hostname given that it exists =back +=for html
+ +I<$Id: //depot/libnet/Net/Config.pm#9 $> + =cut diff --git a/lib/Net/Domain.pm b/lib/Net/Domain.pm index 189bb73..229bc16 100644 --- a/lib/Net/Domain.pm +++ b/lib/Net/Domain.pm @@ -16,7 +16,7 @@ use Net::Config; @ISA = qw(Exporter); @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname); -$VERSION = "2.13"; # $Id: //depot/libnet/Net/Domain.pm#10 $ +$VERSION = "2.14"; # $Id: //depot/libnet/Net/Domain.pm#15 $ my($host,$domain,$fqdn) = (undef,undef,undef); @@ -28,7 +28,7 @@ sub _hostname { return $host if(defined $host); - if ($^O eq 'MSWin32' || $^O eq 'cygwin') { + if ($^O eq 'MSWin32') { require Socket; my ($name,$alias,$type,$len,@addr) = gethostbyname($ENV{'COMPUTERNAME'}||'localhost'); while (@addr) @@ -101,7 +101,7 @@ sub _hostname { $host = ""; }; } - + # remove garbage $host =~ s/[\0\r\n]+//go; $host =~ s/(\A\.+|\.+\Z)//go; @@ -165,7 +165,7 @@ sub _hostdomain { }; chop($dom = `domainname 2>/dev/null`) - unless(defined $dom); + unless(defined $dom || $^O eq 'MSWin32'); if(defined $dom) { my @h = (); @@ -199,7 +199,7 @@ sub _hostdomain { # Look for environment variable - $domain ||= $ENV{LOCALDOMAIN} ||= $ENV{DOMAIN} || undef; + $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN}; if(defined $domain) { $domain =~ s/[\r\n\0]+//g; @@ -236,7 +236,7 @@ sub domainname { # Determine from @host & @domain the FQDN my @d = @domain; - + LOOP: while(1) { my @h = @host; @@ -328,4 +328,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/Domain.pm#15 $> + =cut diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm index dd86300..a1daedc 100644 --- a/lib/Net/FTP.pm +++ b/lib/Net/FTP.pm @@ -21,7 +21,7 @@ use Net::Cmd; use Net::Config; # use AutoLoader qw(AUTOLOAD); -$VERSION = "2.56"; # $Id:$ +$VERSION = "2.58"; # $Id: //depot/libnet/Net/FTP.pm#57 $ @ISA = qw(Exporter Net::Cmd IO::Socket::INET); # Someday I will "use constant", when I am not bothered to much about @@ -36,6 +36,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__ @@ -205,7 +211,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")) { @@ -399,7 +405,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'}; @@ -469,6 +475,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)); @@ -487,10 +500,20 @@ sub get print $hashh "\n" if $hashh; - close($loc) - unless defined $localfd; - - $data->close(); # implied $ftp->response + unless (defined $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 +565,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 +596,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 +641,7 @@ sub mkdir { my($status,$message) = ($ftp->status,$ftp->message); my $pwd = $ftp->pwd; - + if($pwd && $ftp->cwd($dir)) { $path = $dir; @@ -701,6 +736,12 @@ sub _store_cmd { last unless $len = sysread($loc,$buf="",$blksize); + if (trEBCDIC) + { + $buf = $ftp->toascii($buf); + $len = length($buf); + } + if($hashh) { $count += $len; print $hashh "#" x (int($count / $hashb)); @@ -726,8 +767,11 @@ sub _store_cmd $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 +791,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); @@ -923,6 +969,11 @@ sub _list_cmd $data->close(); + if (trEBCDIC) + { + for (@$list) { $_ = $ftp->toebcdic($_) } + } + wantarray ? @{$list} : $list; } @@ -996,9 +1047,9 @@ sub _data_cmd return $data; } - + close(delete ${*$ftp}{'net_ftp_listen'}); - + return undef; } @@ -1151,7 +1202,7 @@ 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->cwd("/pub"); @@ -1307,6 +1358,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. @@ -1343,7 +1401,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 ] ) @@ -1546,6 +1604,10 @@ given the 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 +1687,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 +1715,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#57 $> + =cut diff --git a/lib/Net/FTP/A.pm b/lib/Net/FTP/A.pm index 46791e8..764e915 100644 --- a/lib/Net/FTP/A.pm +++ b/lib/Net/FTP/A.pm @@ -1,4 +1,4 @@ -## +## $Id: //depot/libnet/Net/FTP/A.pm#16 $ ## Package to read/write on ASCII data connections ## @@ -10,7 +10,7 @@ use Carp; require Net::FTP::dataconn; @ISA = qw(Net::FTP::dataconn); -$VERSION = "1.13"; # $Id: //depot/libnet/Net/FTP/A.pm#9 $ +$VERSION = "1.15"; sub read { my $data = shift; @@ -71,23 +71,25 @@ sub write { my $size = shift || croak 'write($buf,$size,[$timeout])'; my $timeout = @_ ? shift : $data->timeout; - $data->can_write($timeout) or - croak "Timeout"; - (my $tmp = substr($buf,0,$size)) =~ s/\n/\015\012/sg; # If the remote server has closed the connection we will be signal'd # when we write. This can happen if the disk on the remote server fills up - local $SIG{PIPE} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS'; my $len = length($tmp); my $off = 0; my $wrote = 0; + my $blksize = ${*$data}{'net_ftp_blksize'}; + while($len) { + $data->can_write($timeout) or + croak "Timeout"; + $off += $wrote; - $wrote = syswrite($data, substr($tmp,$off), $len); + $wrote = syswrite($data, substr($tmp,$off), $len > $blksize ? $blksize : $len); return undef unless defined($wrote); $len -= $wrote; diff --git a/lib/Net/FTP/I.pm b/lib/Net/FTP/I.pm index 4548c12..486dc96 100644 --- a/lib/Net/FTP/I.pm +++ b/lib/Net/FTP/I.pm @@ -1,4 +1,4 @@ -## +## $Id: //depot/libnet/Net/FTP/I.pm#11 $ ## Package to read/write on BINARY data connections ## @@ -10,7 +10,7 @@ use Carp; require Net::FTP::dataconn; @ISA = qw(Net::FTP::dataconn); -$VERSION = "1.08"; # $Id: //depot/libnet/Net/FTP/I.pm#6$ +$VERSION = "1.10"; sub read { my $data = shift; @@ -47,18 +47,19 @@ sub write { my $size = shift || croak 'write($buf,$size,[$timeout])'; my $timeout = @_ ? shift : $data->timeout; - $data->can_write($timeout) or - croak "Timeout"; - # If the remote server has closed the connection we will be signal'd # when we write. This can happen if the disk on the remote server fills up - local $SIG{PIPE} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS'; my $sent = $size; my $off = 0; + my $blksize = ${*$data}{'net_ftp_blksize'}; while($sent > 0) { - my $n = syswrite($data, $buf, $sent,$off); + $data->can_write($timeout) or + croak "Timeout"; + + my $n = syswrite($data, $buf, $sent > $blksize ? $blksize : $sent ,$off); return undef unless defined($n); $sent -= $n; $off += $n; diff --git a/lib/Net/FTP/dataconn.pm b/lib/Net/FTP/dataconn.pm index e43c6e6..6ca437b 100644 --- a/lib/Net/FTP/dataconn.pm +++ b/lib/Net/FTP/dataconn.pm @@ -5,9 +5,10 @@ package Net::FTP::dataconn; use Carp; -use vars qw(@ISA $timeout); +use vars qw(@ISA $timeout $VERSION); use Net::Cmd; +$VERSION = '0.10'; @ISA = qw(IO::Socket::INET); sub reading @@ -120,4 +121,10 @@ sub cmd ${*$ftp}{'net_ftp_cmd'}; } +sub bytes_read { + my $ftp = shift; + + ${*$ftp}{'net_ftp_bytesread'} || 0; +} + 1; diff --git a/lib/Net/NNTP.pm b/lib/Net/NNTP.pm index 2644397..56c97b3 100644 --- a/lib/Net/NNTP.pm +++ b/lib/Net/NNTP.pm @@ -14,7 +14,7 @@ use Carp; use Time::Local; use Net::Config; -$VERSION = "2.19"; # $Id: //depot/libnet/Net/NNTP.pm#8$ +$VERSION = "2.20"; # $Id: //depot/libnet/Net/NNTP.pm#13 $ @ISA = qw(Net::Cmd IO::Socket::INET); sub new @@ -60,7 +60,7 @@ sub new my $c = $obj->code; my @m = $obj->message; - + unless(exists $arg{Reader} && $arg{Reader} == 0) { # if server is INN and we have transfer rights the we are currently # talking to innd not nnrpd @@ -514,9 +514,14 @@ sub _msg_arg { if(ref($spec)) { - $arg = $spec->[0] . "-"; - $arg .= $spec->[1] - if defined $spec->[1] && $spec->[1] > $spec->[0]; + $arg = $spec->[0]; + if(defined $spec->[1]) + { + $arg .= "-" + if $spec->[1] != $spec->[0]; + $arg .= $spec->[1] + if $spec->[1] > $spec->[0]; + } } else { @@ -660,7 +665,7 @@ Net::NNTP - NNTP Client class =head1 SYNOPSIS use Net::NNTP; - + $nntp = Net::NNTP->new("some.host.name"); $nntp->quit; @@ -799,8 +804,8 @@ that it will allow posting. Obtain information about all the active newsgroups. The results is a reference to a hash where the key is a group name and each value is a reference to an -array. The elements in this array are:- the first article number in the group, -the last article number in the group and any information flags about the group. +array. The elements in this array are:- the last article number in the group, +the first article number in the group and any information flags about the group. =item newgroups ( SINCE [, DISTRIBUTIONS ]) @@ -1057,4 +1062,8 @@ Copyright (c) 1995-1997 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/NNTP.pm#13 $> + =cut diff --git a/lib/Net/Netrc.pm b/lib/Net/Netrc.pm index 0c63310..bbd62ab 100644 --- a/lib/Net/Netrc.pm +++ b/lib/Net/Netrc.pm @@ -11,7 +11,7 @@ use strict; use FileHandle; use vars qw($VERSION); -$VERSION = "2.10"; # $Id: //depot/libnet/Net/Netrc.pm#4$ +$VERSION = "2.11"; # $Id: //depot/libnet/Net/Netrc.pm#10 $ my %netrc = (); @@ -19,7 +19,7 @@ sub _readrc { my $host = shift; my($home,$file); - + if($^O eq "MacOS") { $home = $ENV{HOME} || `pwd`; chomp($home); @@ -37,7 +37,10 @@ sub _readrc $netrc{default} = undef; # OS/2 and Win32 do not handle stat in a way compatable with this check :-( - unless($^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'MacOS') + unless($^O eq 'os2' + || $^O eq 'MSWin32' + || $^O eq 'MacOS' + || $^O =~ /^cygwin/) { my @stat = stat($file); @@ -199,7 +202,7 @@ Net::Netrc - OO interface to users netrc file =head1 SYNOPSIS use Net::Netrc; - + $mach = Net::Netrc->lookup('some.machine'); $login = $mach->login; ($login, $password, $account) = $mach->lpa; @@ -323,4 +326,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
+ +$Id: //depot/libnet/Net/Netrc.pm#10 $ + =cut diff --git a/lib/Net/POP3.pm b/lib/Net/POP3.pm index 6a05147..fb91916 100644 --- a/lib/Net/POP3.pm +++ b/lib/Net/POP3.pm @@ -13,7 +13,7 @@ use Net::Cmd; use Carp; use Net::Config; -$VERSION = "2.21"; # $Id$ +$VERSION = "2.22"; # $Id: //depot/libnet/Net/POP3.pm#19 $ @ISA = qw(Net::Cmd IO::Socket::INET); @@ -118,7 +118,7 @@ sub apop : ""; } - my $md = new MD5; + my $md = MD5->new; $md->add($banner,$pass); return undef @@ -159,7 +159,7 @@ sub reset return 0 unless($me->_RSET); - + if(defined ${*$me}{'net_pop3_mail'}) { local $_; @@ -215,7 +215,7 @@ sub list $me->message =~ /\d+\D+(\d+)/; return $1 || undef; } - + my $info = $me->read_until_dot or return undef; @@ -277,7 +277,7 @@ sub ping ($1 || 0, $2 || 0); } - + sub _STAT { shift->command('STAT')->response() == CMD_OK } sub _LIST { shift->command('LIST',@_)->response() == CMD_OK } sub _RETR { shift->command('RETR',$_[0])->response() == CMD_OK } @@ -353,7 +353,7 @@ Net::POP3 - Post Office Protocol 3 Client class (RFC1081) =head1 SYNOPSIS use Net::POP3; - + # Constructors $pop = Net::POP3->new('pop3host'); $pop = Net::POP3->new('pop3host', Timeout => 60); @@ -518,4 +518,8 @@ Copyright (c) 1995-1997 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/POP3.pm#19 $> + =cut diff --git a/lib/Net/README.config b/lib/Net/README.config deleted file mode 100644 index 4dc7380..0000000 --- a/lib/Net/README.config +++ /dev/null @@ -1,28 +0,0 @@ -Hopefully the next release of libnet will be release 2.00. For this -release I want to completely re-write the configuration system. - -My current thoughts are that a hash of values is not sufficient and that -Net::Config should be code. This is what I have planned, if you see any -problems or have any ideas please let me know by sending an Email -to gbarr@pobox.com - -Net::Config will become an object based interface. Methods will be called -as static methods on the package. Net::Config will inherit from -Net::LocalCfg and Net::Config::default. Net::LocalCfg is a package -that local sys-admins can write to override the defaulr behaviour of -Net::Config. - -Most of the variables that are currently stored in Net::Config will -be turned into method calls, eg $NetConfig{'nntp_hosts'} will -become Net::Config->nntp_hosts - -This approach will allow for a better implementation of the firewall code, -which currently makes a lot of assumptions. To aid this Net::Config::default -will provide a method 'reachable' which will take a single argument as -a hostname and should return true it the host is reachable directly. - -This will also allow people who have dialup accounts, and appear in different -domains at different times, to do what they need. - -Graham -gbarr@pobox.com diff --git a/lib/Net/README.libnet b/lib/Net/README.libnet index 0b6b0cd..59001ac 100644 --- a/lib/Net/README.libnet +++ b/lib/Net/README.libnet @@ -18,10 +18,6 @@ Net::NNTP RFC977 Network News Transfer Protocol Net::POP3 RFC1939 Post Office Protocol 3 Net::SNPP RFC1861 Simple Network Pager Protocol -The distribution also contains a module (Net::PH) which facilitates -comunicate with with servers using the CCSO Nameserver Server-Client -Protocol - FUTURE WORK AVAILABILITY @@ -57,11 +53,20 @@ together with libnet. These packages should be available on CPAN CONFIGURE -Normally when perl Makefile.PL is run it will run Configure which will ask some -questions about your system. The results of these questions will be stored in -the Net::Config package. If you are on a system when this script cannot be run -for some reason then the file Config.eg can be edited manually and installed -as Net::Config (Net/Comfig.pm) +Normally when perl Makefile.PL is run it will run Configure which will +ask some questions about your system. The results of these questions +will be stored in in a file called libnet.cfg which will be installed +alongside the other perl modules in this distribution. The Makefile.PL +will run Configure in an interactive mode unless these exists a file +called libnet.cfg in the build directory. + +If you are on a system which cannot run this script you can create an +empty file to make Makefile.PL skip running Configure. If you want to +keep your existing settings and not run interactivly the simple run + + Configure -d + +before running the Makefile.PL. DOCUMENTATION @@ -84,7 +89,7 @@ SUPPORT Questions about how to use this library should be directed to the comp.lang.perl.modules USENET Newsgroup. Bug reports and suggestions -for improvements can be sendt to me at . +for improvements can be sent to me at . Most of the modules in this library have an option to output a debug transcript to STDERR. When reporting bugs/problems please, if possible, @@ -92,7 +97,7 @@ include a transcript of a run. COPYRIGHT - © 1996-98 Graham Barr. All rights reserved. + © 1996-2000 Graham Barr. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/Net/SMTP.pm b/lib/Net/SMTP.pm index 8202d48..a2f2d2e 100644 --- a/lib/Net/SMTP.pm +++ b/lib/Net/SMTP.pm @@ -16,7 +16,7 @@ use IO::Socket; use Net::Cmd; use Net::Config; -$VERSION = "2.15"; # $Id$ +$VERSION = "2.16"; # $Id: //depot/libnet/Net/SMTP.pm#16 $ @ISA = qw(Net::Cmd IO::Socket::INET); @@ -109,7 +109,7 @@ sub hello my $h = ${*$me}{'net_smtp_esmtp'} = {}; my $ln; foreach $ln (@msg) { - $h->{$1} = $2 + $h->{uc $1} = $2 if $ln =~ /(\S+)\b[ \t]*([^\n]*)/; } } @@ -308,7 +308,11 @@ sub recipient return $skip_bad ? @ok : 1; } -sub to { shift->recipient(@_) } +BEGIN { + *to = \&recipient; + *cc = \&recipient; + *bcc = \&recipient; +} sub data { @@ -384,7 +388,7 @@ Net::SMTP - Simple Mail Transfer Protocol Client =head1 SYNOPSIS use Net::SMTP; - + # Constructors $smtp = Net::SMTP->new('mailhost'); $smtp = Net::SMTP->new('mailhost', Timeout => 60); @@ -406,9 +410,9 @@ The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET. This example prints the mail domain name of the SMTP server known as mailhost: #!/usr/local/bin/perl -w - + use Net::SMTP; - + $smtp = Net::SMTP->new('mailhost'); print $smtp->domain,"\n"; $smtp->quit; @@ -417,20 +421,20 @@ This example sends a small message to the postmaster at the SMTP server known as mailhost: #!/usr/local/bin/perl -w - + use Net::SMTP; - + $smtp = Net::SMTP->new('mailhost'); - + $smtp->mail($ENV{USER}); $smtp->to('postmaster'); - + $smtp->data(); $smtp->datasend("To: postmaster\n"); $smtp->datasend("\n"); $smtp->datasend("A simple test message\n"); $smtp->dataend(); - + $smtp->quit; =head1 CONSTRUCTOR @@ -467,6 +471,8 @@ Example: Debug => 1, ); +=back + =head1 METHODS Unless otherwise stated all methods return either a I or I @@ -544,9 +550,17 @@ If C is true the C will not return an error when a bad address is encountered and it will return an array of addresses that did succeed. + $smtp->recipient($recipient1,$recipient2); # Good + $smtp->recipient($recipient1,$recipient2, { SkipBad => 1 }); # Good + $smtp->recipient("$recipient,$recipient2"); # BAD + =item to ( ADDRESS [, ADDRESS [...]] ) -A synonym for C. +=item cc ( ADDRESS [, ADDRESS [...]] ) + +=item bcc ( ADDRESS [, ADDRESS [...]] ) + +Synonyms for C. =item data ( [ DATA ] ) @@ -593,4 +607,8 @@ Copyright (c) 1995-1997 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/SMTP.pm#16 $> + =cut diff --git a/lib/Net/Time.pm b/lib/Net/Time.pm index 828babf..3fad07e 100644 --- a/lib/Net/Time.pm +++ b/lib/Net/Time.pm @@ -17,7 +17,7 @@ use IO::Select; @ISA = qw(Exporter); @EXPORT_OK = qw(inet_time inet_daytime); -$VERSION = "2.08"; +$VERSION = "2.09"; # $Id: //depot/libnet/Net/Time.pm#9 $ $TIMEOUT = 120; @@ -102,11 +102,11 @@ Net::Time - time and daytime network client interface =head1 SYNOPSIS use Net::Time qw(inet_time inet_daytime); - + print inet_time(); # use default host from Net::Config print inet_time('localhost'); print inet_time('localhost', 'tcp'); - + print inet_daytime(); # use default host from Net::Config print inet_daytime('localhost'); print inet_daytime('localhost', 'tcp'); @@ -144,4 +144,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/Time.pm#9 $> + =cut diff --git a/lib/Net/demos/snpp b/lib/Net/demos/snpp deleted file mode 100755 index f046b58..0000000 --- a/lib/Net/demos/snpp +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/local/bin/perl - -use blib; -use Getopt::Long; -use Net::SNPP; - -$opt_debug = undef; -$opt_h = undef; -$opt_p = undef; - -GetOptions(qw(debug h p)); - -die "usage: $0 -h -p " - unless defined $opt_h && defined $opt_p && @ARGV; - -Net::SNPP->debug(1) - if $opt_debug; - -$snpp = Net::SNPP->new($opt_host); - -$snpp->pager_id($opt_p) || die $snpp->message; -$snpp->content(join(" ",@ARGV)) || die $snpp->message; -$snpp->send() || die $snpp->message; - -$snpp->quit; - -__END__ - -or you could dp - -$snpp = Net::SNPP->new($opt_host); - -$snpp->send( Pager => $opt_p, - Message => join(" ",@ARGV), - Alert => 1, - Hold => time + 3600 - ) || die $snpp->message; - -$snpp->quit; diff --git a/lib/Net/libnet.ppd b/lib/Net/libnet.ppd deleted file mode 100644 index ed864bc..0000000 --- a/lib/Net/libnet.ppd +++ /dev/null @@ -1,12 +0,0 @@ - - libnet - Collection of Network protocol modules - Graham Barr <gbarr@pobox.com> - - - - - - - - diff --git a/lib/Net/libnetFAQ.pod b/lib/Net/libnetFAQ.pod index 1e5af56..d9dcfaa 100644 --- a/lib/Net/libnetFAQ.pod +++ b/lib/Net/libnetFAQ.pod @@ -11,14 +11,11 @@ avaliable on the libnet web page at http://www.pobox.com/~gbarr/libnet/ - - =head2 How to contribute to this document You may mail corrections, additions, and suggestions to me gbarr@pobox.com. - =head1 Author and Copyright Information Copyright (c) 1997-1998 Graham Barr. All rights reserved. @@ -35,8 +32,6 @@ in respect of this information or its use. =head1 Obtaining and installing libnet -=over 4 - =head2 What is libnet ? libnet is a collection of perl5 modules which all related to network @@ -71,18 +66,14 @@ The latest libnet release is always on CPAN, you will find it in http://www.perl.com/CPAN/modules/by-module/Net/ - + The latest release and information is also avaliable on the libnet web page at http://www.pobox.com/~gbarr/libnet/ -=back - =head1 Using Net::FTP -=over - =head2 How do I download files from a FTP server ? An example taken from an article posted to comp.lang.perl.misc @@ -222,7 +213,7 @@ some examples how you can implement these yourself. sub mput { my($ftp,$pattern) = @_; - foreach my $file (<$pattern>) { + foreach my $file (glob($pattern)) { $ftp->put($file) or warn $ftp->message; } } @@ -235,12 +226,8 @@ sub mget { } -=back - =head1 Using Net::SMTP -=over - =head2 Why can't the part of an Email address after the @ be used as the hostname ? The part of an Email address which follows the @ is not necessarily a hostname, @@ -264,12 +251,8 @@ will suceed with something like This command will only fail if you pass it an address in a domain the the server directly delivers for, and that address does not exist. -=back - =head1 Debugging scripts -=over - =head2 How can I debug my scripts that use Net::* modules ? Most of the libnet client classes allow options to be passed to the @@ -280,9 +263,9 @@ are being sent to the remote server and what responces are being received back. #!/your/path/to/perl - + use Net::FTP; - + my $ftp = new Net::FTP($host, Debug => 1); $ftp->login('gbarr','password'); $ftp->quit; @@ -313,9 +296,12 @@ show data coming from the server or C<>>>>> to show data going to the server. The remainder of the line is the command being sent or responce being received. -=back - =head1 AUTHOR AND COPYRIGHT Copyright (c) 1997 Graham Barr. All rights reserved. + +=for html
+ +I<$Id: //depot/libnet/Net/libnetFAQ.pod#4 $> + diff --git a/lib/Net/t/ftp.t b/lib/Net/t/ftp.t index f91d76a..46304db 100644 --- a/lib/Net/t/ftp.t +++ b/lib/Net/t/ftp.t @@ -11,7 +11,7 @@ unless(defined($NetConfig{ftp_testhost}) && $NetConfig{test_hosts}) { my $t = 1; print "1..7\n"; -$ftp = Net::FTP->new($NetConfig{ftp_testhost}, Debug => 0) +$ftp = Net::FTP->new($NetConfig{ftp_testhost}) or (print("not ok 1\n"), exit); printf "ok %d\n",$t++; @@ -46,10 +46,10 @@ if ($data = $ftp->stor('libnet.tst')) { } else { - print STDERR $ftp->message,"\n"; - printf "not ok %d\n",$t++; - printf "not ok %d\n",$t++; - printf "not ok %d\n",$t++; + print "# ",$ftp->message,"\n"; + printf "ok %d\n",$t++; + printf "ok %d\n",$t++; + printf "ok %d\n",$t++; } $ftp->quit or do {