From: Graham Barr Date: Fri, 26 Oct 2001 13:11:00 +0000 (+0000) Subject: Sync libnet modules with what will be libnet-1.08 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=302c2e6b3178d72ea1114a76af5852e6680bacc8;p=p5sagit%2Fp5-mst-13.2.git Sync libnet modules with what will be libnet-1.08 p4raw-id: //depot/perl@12679 --- diff --git a/lib/Net/ChangeLog.libnet b/lib/Net/ChangeLog.libnet index fcd4576..db4d1de 100644 --- a/lib/Net/ChangeLog.libnet +++ b/lib/Net/ChangeLog.libnet @@ -1,3 +1,111 @@ +Change 661 on 2001/10/26 by (Graham Barr) + + Add install-nomake to install libnet on machines that do not + have make available + +Change 660 on 2001/10/26 by (Graham Barr) + + Net::Cmd + - Ensure we don't insert an extra CR during LF=>CRLF when the CR already exists + +Change 659 on 2001/10/22 by (Graham Barr) + + Net::Domain + - Be more robust if no hostname or domainname + (especially the latter) + +Change 658 on 2001/10/22 by (Graham Barr) + + Net::Config + - Protect eval's from user defining $SIG{__DIE__} + +Change 657 on 2001/10/22 by (Graham Barr) + + Net::Config + - Fix handling of single values passed, when a ref to an array is wanted + +Change 656 on 2001/10/22 by (Graham Barr) + + Net::Config + - Pod updates from chromatic + +Change 655 on 2001/10/22 by (Graham Barr) + + Net::SMTP + - Don't be sensetive to extra spaces on reply to HELO + +Change 654 on 2001/10/22 by (Graham Barr) + + Net::Netrc + - Update lookup() docs to describe what happens if no .netrc file is found + +Change 653 on 2001/10/22 by (Graham Barr) + + Net::FTP + - Fix hash() to match docs (patch from Doug Wilson) + +Change 652 on 2001/09/21 by (Graham Barr) + + Net::FTP + - Fix patterns in ->size and ->supported + +Change 651 on 2001/09/21 by (Graham Barr) + + Net::Config, Net::Netrc + - Handle $home on w2k + +Change 650 on 2001/09/21 by (Graham Barr) + + Net::Domain + - Fix some potential undef warnings + +Change 649 on 2001/09/21 by (Graham Barr) + + Net::FTP + - Add FirewallType as an option to ->new + +Change 648 on 2001/09/21 by (Graham Barr) + + Net::FTP + - use sysopen instead of open so we don't get caught by special chars in the filename + +Change 630 on 2001/08/31 by (Graham Barr) + + Net::FTP::I + - Avoid uninit warning + +Change 627 on 2001/08/20 by (Graham Barr) + + Remove tests for modules removed from dist + +Change 626 on 2001/08/17 by (Graham Barr) + + Increment VERSIONs + +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 625 on 2001/08/17 by (Graham Barr) Doc updates and add cc and bcc as aliases for recipient diff --git a/lib/Net/Cmd.pm b/lib/Net/Cmd.pm index a23a437..40510e5 100644 --- a/lib/Net/Cmd.pm +++ b/lib/Net/Cmd.pm @@ -1,4 +1,4 @@ -# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#25 $ +# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#26 $ # # Copyright (c) 1995-1997 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or @@ -20,7 +20,7 @@ BEGIN { } } -$VERSION = "2.19"; +$VERSION = "2.20"; @ISA = qw(Exporter); @EXPORT = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING); @@ -403,7 +403,9 @@ sub datasend print STDERR $b,join("\n$b",split(/\n/,$line)),"\n"; } - $line =~ s/\n/\015\012/sgo; + # Translate LF => CRLF, but not if the LF is + # already preceeded by a CR + $line =~ s/\G()\n|([^\r\n])\n/$+\015\012/sgo; ${*$cmd}{'net_cmd_lastch'} ||= " "; $line = ${*$cmd}{'net_cmd_lastch'} . $line; @@ -639,6 +641,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/Cmd.pm#25 $> +I<$Id: //depot/libnet/Net/Cmd.pm#26 $> =cut diff --git a/lib/Net/Config.pm b/lib/Net/Config.pm index 9dd66ba..5a262fd 100644 --- a/lib/Net/Config.pm +++ b/lib/Net/Config.pm @@ -13,7 +13,7 @@ use strict; @EXPORT = qw(%NetConfig); @ISA = qw(Net::LocalCfg Exporter); -$VERSION = "1.05"; # $Id: //depot/libnet/Net/Config.pm#9 $ +$VERSION = "1.08"; # $Id: //depot/libnet/Net/Config.pm#13 $ eval { local $SIG{__DIE__}; require Net::LocalCfg }; @@ -37,28 +37,29 @@ my $file = __FILE__; my $ref; $file =~ s/Config.pm/libnet.cfg/; if ( -f $file ) { - $ref = eval { do $file }; + $ref = eval { local $SIG{__DIE__}; do $file }; if (ref($ref) eq 'HASH') { %NetConfig = (%NetConfig, %{ $ref }); $LIBNET_CFG = $file; } } if ($< == $> and !$CONFIGURE) { - my $home = eval { (getpwuid($>))[7] } || $ENV{HOME}; + my $home = eval { local $SIG{__DIE__}; (getpwuid($>))[7] } || $ENV{HOME}; + $home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH}||'') if defined $ENV{HOMEDRIVE}; if (defined $home) { $file = $home . "/.libnetrc"; - $ref = eval { do $file } if -f $file; + $ref = eval { local $SIG{__DIE__}; do $file } if -f $file; %NetConfig = (%NetConfig, %{ $ref }) if ref($ref) eq 'HASH'; } } my ($k,$v); while(($k,$v) = each %NetConfig) { - $v = [ $v ] - if($k =~ /_hosts$/ && !ref($v)); + $NetConfig{$k} = [ $v ] + if($k =~ /_hosts$/ && !ref($v)); } -# Take a hostname and determine if it is inside te firewall +# Take a hostname and determine if it is inside the firewall sub requires_firewall { shift; # ignore package @@ -284,6 +285,6 @@ If true then C will check each hostname given that it exists =for html
-I<$Id: //depot/libnet/Net/Config.pm#9 $> +I<$Id: //depot/libnet/Net/Config.pm#13 $> =cut diff --git a/lib/Net/Domain.pm b/lib/Net/Domain.pm index a47933d..a1c6490 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.14"; # $Id: //depot/libnet/Net/Domain.pm#15 $ +$VERSION = "2.16"; # $Id: //depot/libnet/Net/Domain.pm#17 $ my($host,$domain,$fqdn) = (undef,undef,undef); @@ -36,8 +36,8 @@ sub _hostname { my $a = shift(@addr); $host = gethostbyaddr($a,Socket::AF_INET()); last if defined $host; - } - if (defined($host) && index($host,'.') > 0) { + } + if (index($host,'.') > 0) { $fqdn = $host; ($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/; } @@ -102,7 +102,7 @@ sub _hostname { }; } - # remove garbage + # remove garbage $host =~ s/[\0\r\n]+//go; $host =~ s/(\A\.+|\.+\Z)//go; $host =~ s/\.\.+/\./go; @@ -147,7 +147,7 @@ sub _hostdomain { @hosts = ($host,"localhost"); - unless (defined($host) && $host =~ /\./) { + unless($host =~ /\./) { my $dom = undef; eval { my $tmp = "\0" x 256; ## preload scalar @@ -165,7 +165,7 @@ sub _hostdomain { }; chop($dom = `domainname 2>/dev/null`) - unless(defined $dom || $^O =~ /^(MSWin32|cygwin)$/); + unless(defined $dom || $^O =~ /^(?:cygwin|MSWin32)/); if(defined $dom) { my @h = (); @@ -179,19 +179,19 @@ sub _hostdomain { # Attempt to locate FQDN - foreach (grep {defined $_} @hosts) { + foreach (@hosts) { my @info = gethostbyname($_); next unless @info; # look at real name & aliases my $site; - foreach $site ($info[0], split(/ /,$info[1])) { + foreach $site ($info[0], split(/ /,$info[1])) { if(rindex($site,".") > 0) { # Extract domain from FQDN - ($domain = $site) =~ s/\A[^\.]+\.//; + ($domain = $site) =~ s/\A[^\.]+\.//; return $domain; } } @@ -224,14 +224,14 @@ sub domainname { # eleminate DNS lookups return $fqdn = $host . "." . $domain - if(defined $host && defined $domain && - $host !~ /\./ && $domain =~ /\./); + if(defined $host and defined $domain + and $host !~ /\./ and $domain =~ /\./); # For hosts that have no name, just an IP address - return $fqdn = $host if defined $host && $host =~ /^\d+(\.\d+){3}$/; + return $fqdn = $host if defined $host and $host =~ /^\d+(\.\d+){3}$/; my @host = defined $host ? split(/\./, $host) : ('localhost'); - my @domain = defined $domain ? split(/\./, $domain) : (); + my @domain = defined $domain ? split(/\./, $domain) : (''); my @fqdn = (); # Determine from @host & @domain the FQDN @@ -331,6 +331,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/Domain.pm#15 $> +I<$Id: //depot/libnet/Net/Domain.pm#17 $> =cut diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm index a1daedc..531ff40 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.58"; # $Id: //depot/libnet/Net/FTP.pm#57 $ +$VERSION = "2.61"; # $Id: //depot/libnet/Net/FTP.pm#61 $ @ISA = qw(Exporter Net::Cmd IO::Socket::INET); # Someday I will "use constant", when I am not bothered to much about @@ -54,6 +55,7 @@ sub new my $host = $peer; my $fire = undef; + my $fire_type = undef; if(exists($arg{Firewall}) || Net::Config->requires_firewall($peer)) { @@ -66,6 +68,9 @@ sub new { $peer = $fire; delete $arg{Port}; + $fire_type = $arg{FirewallType} + || $ENV{FTP_FIREWALL_TYPE} + || undef; } } @@ -83,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} @@ -115,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 @@ -221,14 +216,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; @@ -250,7 +245,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) { @@ -448,7 +445,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; @@ -706,7 +703,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; @@ -848,10 +845,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; @@ -1263,6 +1259,11 @@ 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. +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) @@ -1717,6 +1718,6 @@ under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/FTP.pm#57 $> +I<$Id: //depot/libnet/Net/FTP.pm#61 $> =cut diff --git a/lib/Net/FTP/I.pm b/lib/Net/FTP/I.pm index 486dc96..18005f6 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 $ +## $Id: //depot/libnet/Net/FTP/I.pm#12 $ ## 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.10"; +$VERSION = "1.11"; sub read { my $data = shift; @@ -26,7 +26,7 @@ sub read { $blksize = $size if $size > $blksize; while(($l = length(${*$data})) < $size) { - $n += ($b = sysread($data, ${*$data}, $blksize, $l)); + $n += ($b = sysread($data, ${*$data}, $blksize, $l)) || 0; last unless $b; } diff --git a/lib/Net/Netrc.pm b/lib/Net/Netrc.pm index bbd62ab..a44b6e3 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.11"; # $Id: //depot/libnet/Net/Netrc.pm#10 $ +$VERSION = "2.12"; # $Id: //depot/libnet/Net/Netrc.pm#12 $ my %netrc = (); @@ -27,6 +27,7 @@ sub _readrc } else { # Some OS's don't have `getpwuid', so we default to $ENV{HOME} $home = eval { (getpwuid($>))[7] } || $ENV{HOME}; + $home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH}||'') if defined $ENV{HOMEDRIVE}; $file = $home . "/.netrc"; } @@ -287,6 +288,9 @@ the first entry in the .netrc file for C will be returned. If a matching entry cannot be found, and a default entry exists, then a reference to the default entry is returned. +If there is no matching entry found and there is no default defined, or +no .netrc file is found, then C is returned. + =back =head1 METHODS @@ -328,6 +332,6 @@ it under the same terms as Perl itself. =for html
-$Id: //depot/libnet/Net/Netrc.pm#10 $ +$Id: //depot/libnet/Net/Netrc.pm#12 $ =cut diff --git a/lib/Net/SMTP.pm b/lib/Net/SMTP.pm index a2f2d2e..f2647b7 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.16"; # $Id: //depot/libnet/Net/SMTP.pm#16 $ +$VERSION = "2.17"; # $Id: //depot/libnet/Net/SMTP.pm#17 $ @ISA = qw(Net::Cmd IO::Socket::INET); @@ -119,7 +119,7 @@ sub hello if $ok = $me->_HELO($domain); } - $ok && $msg[0] =~ /\A(\S+)/ + $ok && $msg[0] =~ /\A\s*(\S+)/ ? $1 : undef; } @@ -609,6 +609,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/SMTP.pm#16 $> +I<$Id: //depot/libnet/Net/SMTP.pm#17 $> =cut diff --git a/lib/Net/t/ftp.t b/lib/Net/t/ftp.t index ec323d0..46304db 100644 --- a/lib/Net/t/ftp.t +++ b/lib/Net/t/ftp.t @@ -1,10 +1,5 @@ #!./perl -w -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - use Net::Config; use Net::FTP; diff --git a/lib/Net/t/hostname.t b/lib/Net/t/hostname.t index d743dd4..3e55ace 100644 --- a/lib/Net/t/hostname.t +++ b/lib/Net/t/hostname.t @@ -1,9 +1,3 @@ -#!./perl -w - -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} use Net::Domain qw(hostname domainname hostdomain); use Net::Config; diff --git a/lib/Net/t/nntp.t b/lib/Net/t/nntp.t index e7a42c1..1afb588 100644 --- a/lib/Net/t/nntp.t +++ b/lib/Net/t/nntp.t @@ -1,10 +1,5 @@ #!./perl -w -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - use Net::Config; use Net::NNTP; use Net::Cmd qw(CMD_REJECT); diff --git a/lib/Net/t/smtp.t b/lib/Net/t/smtp.t index c7c3862..55607fe 100644 --- a/lib/Net/t/smtp.t +++ b/lib/Net/t/smtp.t @@ -1,10 +1,5 @@ #!./perl -w -BEGIN { - chdir 't' if -d 't'; - @INC = '../lib'; -} - use Net::Config; use Net::SMTP;