summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--MANIFEST3
-rw-r--r--lib/Net/ChangeLog.libnet72
-rw-r--r--lib/Net/Config.pm30
-rw-r--r--lib/Net/Domain.pm6
-rw-r--r--lib/Net/FTP.pm16
-rw-r--r--lib/Net/FTP/E.pm1
-rw-r--r--lib/Net/FTP/L.pm1
-rw-r--r--lib/Net/NNTP.pm4
-rw-r--r--lib/Net/POP3.pm4
-rw-r--r--lib/Net/SMTP.pm36
-rw-r--r--lib/Net/libnetFAQ.pod2
-rw-r--r--lib/Net/t/config.t45
-rw-r--r--lib/Net/t/libnet_t.pl37
-rw-r--r--lib/Net/t/time.t127
14 files changed, 361 insertions, 23 deletions
diff --git a/MANIFEST b/MANIFEST
index d83019ad98..5790403538 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1136,11 +1136,14 @@ 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
lib/Net/SMTP.pm libnet
+lib/Net/t/config.t libnet
lib/Net/t/ftp.t libnet
lib/Net/t/hostname.t libnet
+lib/Net/t/libnet_t.pl libnet
lib/Net/t/nntp.t libnet
lib/Net/t/require.t libnet
lib/Net/t/smtp.t libnet
+lib/Net/t/time.t libnet
lib/Net/Time.pm libnet
lib/newgetopt.pl A perl library supporting long option parsing
lib/NEXT.pm Pseudo-class NEXT for method redispatch
diff --git a/lib/Net/ChangeLog.libnet b/lib/Net/ChangeLog.libnet
index db4d1de5bc..8ddb94e26c 100644
--- a/lib/Net/ChangeLog.libnet
+++ b/lib/Net/ChangeLog.libnet
@@ -1,3 +1,75 @@
+Change 683 on 2001/11/20 by <gbarr@pobox.com> (Graham Barr)
+
+ Various doc cleanups
+
+Change 675 on 2001/11/20 by <gbarr@pobox.com> (Graham Barr)
+
+ t/hostname.t
+ - Add test to check that hostname() does not modify $_
+
+Change 674 on 2001/11/20 by <gbarr@pobox.com> (Graham Barr)
+
+ Net::Config
+ - Dont treat "test_hosts" as an array of host names
+
+Change 673 on 2001/11/20 by <gbarr@pobox.com> (Graham Barr)
+
+ Added test for Net::Netrc
+ patch from chromatic
+
+Change 672 on 2001/11/20 by <gbarr@pobox.com> (Graham Barr)
+
+ Net::FTP
+ - Dont send QUIT on DESTROY. Causes problems when fork() is used.
+
+Change 671 on 2001/11/20 by <gbarr@pobox.com> (Graham Barr)
+
+ Net::Domain
+ - Fix bug causing $_ to be modified
+
+Change 670 on 2001/11/20 by <gbarr@pobox.com> (Graham Barr)
+
+ Net::FTP
+ - Send -anonymous@ as the password for the anonymous user, not
+ the real username. Patch from Eduardo P?rez Ureta
+
+Change 669 on 2001/11/20 by <gbarr@pobox.com> (Graham Barr)
+
+ Add VERSION numbers to Net::FTP::L and Net::FTP::E
+
+Change 668 on 2001/11/20 by <gbarr@pobox.com> (Graham Barr)
+
+ Net::Config
+ - Read some default values using Mac::InternetConfig if we are on the Mac
+ patch from Chris Nandor
+
+Change 667 on 2001/11/20 by <gbarr@pobox.com> (Graham Barr)
+
+ Net::SMTP
+ - Add support for SASL AUTH (only PLAIN right now)
+ patch from Meng Weng Wong <mengwong@dumbo.pobox.com>
+
+Change 666 on 2001/11/20 by <gbarr@pobox.com> (Graham Barr)
+
+ t/config.t
+ - Use a fake inet_aton so we know that it will fail when expected
+
+Change 665 on 2001/11/02 by <gbarr@pobox.com> (Graham Barr)
+
+ Release 1.09
+
+Change 664 on 2001/10/29 by <gbarr@pobox.com> (Graham Barr)
+
+ Added test for Net::Config from chromatic
+
+Change 663 on 2001/10/26 by <gbarr@pobox.com> (Graham Barr)
+
+ More fixes from the core for undefs
+
+Change 662 on 2001/10/26 by <gbarr@pobox.com> (Graham Barr)
+
+ Make tests compatable with the perl core distribution
+
Change 661 on 2001/10/26 by <gbarr@pobox.com> (Graham Barr)
Add install-nomake to install libnet on machines that do not
diff --git a/lib/Net/Config.pm b/lib/Net/Config.pm
index 23db846629..c09b834fcf 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.08"; # $Id: //depot/libnet/Net/Config.pm#13 $
+$VERSION = "1.09"; # $Id: //depot/libnet/Net/Config.pm#16 $
eval { local $SIG{__DIE__}; require Net::LocalCfg };
@@ -33,6 +33,30 @@ eval { local $SIG{__DIE__}; require Net::LocalCfg };
test_exist => 1,
);
+#
+# Try to get as much configuration info as possible from InternetConfig
+#
+$^O eq 'MacOS' and eval <<'TRY_INTERNET_CONFIG';
+use Mac::InternetConfig;
+
+{
+my %nc = (
+ nntp_hosts => [ $InternetConfig{ kICNNTPHost()} ],
+ pop3_hosts => [ $InternetConfig{ kICMailAccount()} =~ /@(.*)/ ],
+ smtp_hosts => [ $InternetConfig{ kICSMTPHost()} ],
+ ftp_testhost => [ $InternetConfig{ kICFTPHost()} ],
+ ph_hosts => [ $InternetConfig{ kICPhHost()} ],
+ ftp_ext_passive => $InternetConfig{"646F676F€UsePassiveMode"} || 0,
+ ftp_int_passive => $InternetConfig{"646F676F€UsePassiveMode"} || 0,
+ socks_hosts =>
+ $InternetConfig{kICUseSocks()} ? [ $InternetConfig{kICSocksHost()} ] : [],
+ ftp_firewall =>
+ $InternetConfig{kICUseFTPProxy()} ? [ $InternetConfig{kICFTPProxyHost()} ] : [],
+);
+@NetConfig{keys %nc} = values %nc;
+}
+TRY_INTERNET_CONFIG
+
my $file = __FILE__;
my $ref;
$file =~ s/Config.pm/libnet.cfg/;
@@ -56,7 +80,7 @@ if ($< == $> and !$CONFIGURE) {
my ($k,$v);
while(($k,$v) = each %NetConfig) {
$NetConfig{$k} = [ $v ]
- if($k =~ /_hosts$/ && !ref($v));
+ if($k =~ /_hosts$/ and $k ne "test_hosts" and defined($v) and !ref($v));
}
# Take a hostname and determine if it is inside the firewall
@@ -285,6 +309,6 @@ If true then C<Configure> will check each hostname given that it exists
=for html <hr>
-I<$Id: //depot/libnet/Net/Config.pm#13 $>
+I<$Id: //depot/libnet/Net/Config.pm#16 $>
=cut
diff --git a/lib/Net/Domain.pm b/lib/Net/Domain.pm
index 62b9d96116..b79ec8fa07 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.16"; # $Id: //depot/libnet/Net/Domain.pm#18 $
+$VERSION = "2.17"; # $Id: //depot/libnet/Net/Domain.pm#19 $
my($host,$domain,$fqdn) = (undef,undef,undef);
@@ -127,6 +127,7 @@ sub _hostdomain {
# those on dialup systems.
local *RES;
+ local($_);
if(open(RES,"/etc/resolv.conf")) {
while(<RES>) {
@@ -143,7 +144,6 @@ sub _hostdomain {
my $host = _hostname();
my(@hosts);
- local($_);
@hosts = ($host,"localhost");
@@ -331,6 +331,6 @@ it under the same terms as Perl itself.
=for html <hr>
-I<$Id: //depot/libnet/Net/Domain.pm#18 $>
+I<$Id: //depot/libnet/Net/Domain.pm#19 $>
=cut
diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm
index ffa21e16af..d2780d31f6 100644
--- a/lib/Net/FTP.pm
+++ b/lib/Net/FTP.pm
@@ -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.61"; # $Id: //depot/libnet/Net/FTP.pm#61 $
+$VERSION = "2.62"; # $Id: //depot/libnet/Net/FTP.pm#64 $
@ISA = qw(Exporter Net::Cmd IO::Socket::INET);
# Someday I will "use constant", when I am not bothered to much about
@@ -142,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',@_); }
@@ -310,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));
}
@@ -1200,7 +1196,7 @@ Net::FTP - FTP Client class
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;
@@ -1517,7 +1513,7 @@ C<put_unique> and those that do not require data connections.
=item port ( [ PORT ] )
Send a C<PORT> command to the server. If C<PORT> 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 ()
@@ -1718,6 +1714,6 @@ under the same terms as Perl itself.
=for html <hr>
-I<$Id: //depot/libnet/Net/FTP.pm#61 $>
+I<$Id: //depot/libnet/Net/FTP.pm#64 $>
=cut
diff --git a/lib/Net/FTP/E.pm b/lib/Net/FTP/E.pm
index 6e458bd2b3..d480cd7295 100644
--- a/lib/Net/FTP/E.pm
+++ b/lib/Net/FTP/E.pm
@@ -3,5 +3,6 @@ package Net::FTP::E;
require Net::FTP::I;
@ISA = qw(Net::FTP::I);
+$VERSION = "0.01";
1;
diff --git a/lib/Net/FTP/L.pm b/lib/Net/FTP/L.pm
index fbb5a5a0f6..f7423cb9f9 100644
--- a/lib/Net/FTP/L.pm
+++ b/lib/Net/FTP/L.pm
@@ -3,5 +3,6 @@ package Net::FTP::L;
require Net::FTP::I;
@ISA = qw(Net::FTP::I);
+$VERSION = "0.01";
1;
diff --git a/lib/Net/NNTP.pm b/lib/Net/NNTP.pm
index 53df6e01ea..0078cf4830 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.20"; # $Id: //depot/libnet/Net/NNTP.pm#13 $
+$VERSION = "2.20"; # $Id: //depot/libnet/Net/NNTP.pm#14 $
@ISA = qw(Net::Cmd IO::Socket::INET);
sub new
@@ -1064,6 +1064,6 @@ it under the same terms as Perl itself.
=for html <hr>
-I<$Id: //depot/libnet/Net/NNTP.pm#13 $>
+I<$Id: //depot/libnet/Net/NNTP.pm#14 $>
=cut
diff --git a/lib/Net/POP3.pm b/lib/Net/POP3.pm
index f23157ccca..89f0313912 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.22"; # $Id: //depot/libnet/Net/POP3.pm#19 $
+$VERSION = "2.22"; # $Id: //depot/libnet/Net/POP3.pm#20 $
@ISA = qw(Net::Cmd IO::Socket::INET);
@@ -520,6 +520,6 @@ it under the same terms as Perl itself.
=for html <hr>
-I<$Id: //depot/libnet/Net/POP3.pm#19 $>
+I<$Id: //depot/libnet/Net/POP3.pm#20 $>
=cut
diff --git a/lib/Net/SMTP.pm b/lib/Net/SMTP.pm
index ce5777db07..627903d08b 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.17"; # $Id: //depot/libnet/Net/SMTP.pm#17 $
+$VERSION = "2.18"; # $Id: //depot/libnet/Net/SMTP.pm#19 $
@ISA = qw(Net::Cmd IO::Socket::INET);
@@ -92,6 +92,31 @@ sub etrn {
$self->_ETRN(@_);
}
+sub auth { # auth(username, password) by mengwong 20011106. the only supported mechanism at this time is PLAIN.
+ #
+ # my $auth = $smtp->supports("AUTH");
+ # $smtp->auth("username", "password") or die $smtp->message;
+ #
+
+ require MIME::Base64;
+
+ my $self = shift;
+ my ($username, $password) = @_;
+ die "auth(username, password)" if not length $username;
+
+ my $mechanisms = $self->supports('AUTH',500,["Command unknown: 'AUTH'"]);
+ return unless defined $mechanisms;
+
+ if (not grep { uc $_ eq "PLAIN" } split ' ', $mechanisms) {
+ $self->set_status(500, ["PLAIN mechanism not supported; server supports $mechanisms"]);
+ return;
+ }
+ my $authstring = MIME::Base64::encode_base64(join "\0", ($username)x2, $password);
+ $authstring =~ s/\n//g; # wrap long lines
+
+ $self->_AUTH("PLAIN $authstring");
+}
+
sub hello
{
my $me = shift;
@@ -376,6 +401,7 @@ sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
sub _DATA { shift->command("DATA")->response() == CMD_MORE }
sub _TURN { shift->unsupported(@_); }
sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
+sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
1;
@@ -503,6 +529,12 @@ normally not have to call it manually.
Request a queue run for the DOMAIN given.
+=item auth ( USERNAME, PASSWORD )
+
+Attempt SASL authentication. At this time only the PLAIN mechanism is supported.
+
+At some point in the future support for using Authen::SASL will be added
+
=item mail ( ADDRESS [, OPTIONS] )
=item send ( ADDRESS )
@@ -609,6 +641,6 @@ it under the same terms as Perl itself.
=for html <hr>
-I<$Id: //depot/libnet/Net/SMTP.pm#17 $>
+I<$Id: //depot/libnet/Net/SMTP.pm#19 $>
=cut
diff --git a/lib/Net/libnetFAQ.pod b/lib/Net/libnetFAQ.pod
index 1216ff7202..d370e8462f 100644
--- a/lib/Net/libnetFAQ.pod
+++ b/lib/Net/libnetFAQ.pod
@@ -303,5 +303,5 @@ All rights reserved.
=for html <hr>
-I<$Id: //depot/libnet/Net/libnetFAQ.pod#4 $>
+I<$Id: //depot/libnet/Net/libnetFAQ.pod#5 $>
diff --git a/lib/Net/t/config.t b/lib/Net/t/config.t
new file mode 100644
index 0000000000..95a77aad44
--- /dev/null
+++ b/lib/Net/t/config.t
@@ -0,0 +1,45 @@
+#!./perl -w
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+
+(my $libnet_t = __FILE__) =~ s/config.t/libnet_t.pl/;
+require $libnet_t;
+
+print "1..10\n";
+
+use Net::Config;
+ok( exists $INC{'Net/Config.pm'}, 'Net::Config should have been used' );
+ok( keys %NetConfig, '%NetConfig should be imported' );
+
+undef $NetConfig{'ftp_firewall'};
+is( Net::Config->requires_firewall(), 0,
+ 'requires_firewall() should return 0 without ftp_firewall defined' );
+
+$NetConfig{'ftp_firewall'} = 1;
+is( Net::Config->requires_firewall(''), -1,
+ '... should return -1 without a valid hostname' );
+
+delete $NetConfig{'local_netmask'};
+is( Net::Config->requires_firewall('127.0.0.1'), 0,
+ '... should return 0 without local_netmask defined' );
+
+$NetConfig{'local_netmask'} = '127.0.0.1/24';
+is( Net::Config->requires_firewall('127.0.0.1'), 0,
+ '... should return false if host is within netmask' );
+is( Net::Config->requires_firewall('192.168.10.0'), 1,
+ '... should return true if host is outside netmask' );
+
+# now try more netmasks
+$NetConfig{'local_netmask'} = [ '127.0.0.1/24', '10.0.0.0/8' ];
+is( Net::Config->requires_firewall('10.10.255.254'), 0,
+ '... should find success with mutiple local netmasks' );
+is( Net::Config->requires_firewall('192.168.10.0'), 1,
+ '... should handle failure with multiple local netmasks' );
+
+is( \&Net::Config::is_external, \&Net::Config::requires_firewall,
+ 'is_external() should be an alias for requires_firewall()' );
diff --git a/lib/Net/t/libnet_t.pl b/lib/Net/t/libnet_t.pl
new file mode 100644
index 0000000000..ed245e6502
--- /dev/null
+++ b/lib/Net/t/libnet_t.pl
@@ -0,0 +1,37 @@
+
+my $number = 0;
+sub ok {
+ my ($condition, $name) = @_;
+
+ my $message = $condition ? "ok " : "not ok ";
+ $message .= ++$number;
+ $message .= " # $name" if defined $name;
+ print $message, "\n";
+ return $condition;
+}
+
+sub is {
+ my ($got, $expected, $name) = @_;
+
+ for ($got, $expected) {
+ $_ = 'undef' unless defined $_;
+ }
+
+ unless (ok($got eq $expected, $name)) {
+ warn "Got: '$got'\nExpected: '$expected'\n" . join(' ', caller) . "\n";
+ }
+}
+
+sub skip {
+ my ($reason, $num) = @_;
+ $reason ||= '';
+ $number ||= 1;
+
+ for (1 .. $num) {
+ $number++;
+ print "ok $number # skip $reason\n";
+ }
+}
+
+1;
+
diff --git a/lib/Net/t/time.t b/lib/Net/t/time.t
new file mode 100644
index 0000000000..2239fba753
--- /dev/null
+++ b/lib/Net/t/time.t
@@ -0,0 +1,127 @@
+#!./perl -w
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+ $INC{'IO/Socket.pm'} = 1;
+ $INC{'IO/Select.pm'} = 1;
+ $INC{'IO/Socket/INET.pm'} = 1;
+}
+
+(my $libnet_t = __FILE__) =~ s/time.t/libnet_t.pl/;
+require $libnet_t;
+
+print "1..12\n";
+# cannot use(), otherwise it will use IO::Socket and IO::Select
+eval{ require Net::Time; };
+ok( !$@, 'should be able to require() Net::Time safely' );
+ok( exists $INC{'Net/Time.pm'}, 'should be able to use Net::Time' );
+
+# force the socket to fail
+make_fail('IO::Socket::INET', 'new');
+my $badsock = Net::Time::_socket('foo', 1, 'bar', 'baz');
+is( $badsock, undef, '_socket() should fail if Socket creation fails' );
+
+# if socket is created with protocol UDP (default), it will send a newline
+my $sock = Net::Time::_socket('foo', 2, 'bar');
+ok( $sock->isa('IO::Socket::INET'), 'should be an IO::Socket::INET object' );
+is( $sock->{sent}, "\n", 'should send \n with UDP protocol set' );
+is( $sock->{timeout}, 120, 'timeout should default to 120' );
+
+# now try it with a custom timeout and a different protocol
+$sock = Net::Time::_socket('foo', 3, 'bar', 'tcp', 11);
+ok( $sock->isa('IO::Socket::INET'), 'should be an IO::Socket::INET object' );
+is( $sock->{sent}, undef, '_socket() should send nothing unless UDP protocol' );
+is( $sock->{PeerAddr}, 'bar', '_socket() should set PeerAddr in socket' );
+is( $sock->{timeout}, 11, '_socket() should respect custom timeout value' );
+
+# inet_daytime
+# check for correct args (daytime, 13)
+IO::Socket::INET::set_message('z');
+is( Net::Time::inet_daytime('bob'), 'z', 'inet_daytime() should receive data' );
+
+# magic numbers defined in Net::Time
+my $offset = $^O eq 'MacOS' ?
+ (4 * 31536000) : (70 * 31536000 + 17 * 86400);
+
+# check for correct args (time, 13)
+# pretend it is only six seconds since the offset, create a fake message
+# inet_time
+IO::Socket::INET::set_message(pack("N", $offset + 6));
+is( Net::Time::inet_time('foo'), 6,
+ 'inet_time() should calculate time since offset for time()' );
+
+
+my %fail;
+
+sub make_fail {
+ my ($pack, $func, $num) = @_;
+ $num = 1 unless defined $num;
+
+ $fail{$pack}{$func} = $num;
+}
+
+package IO::Socket::INET;
+
+$fail{'IO::Socket::INET'} = {
+ new => 0,
+ 'send' => 0,
+};
+
+sub new {
+ my $class = shift;
+ return if $fail{$class}{new} and $fail{$class}{new}--;
+ bless( { @_ }, $class );
+}
+
+sub send {
+ my $self = shift;
+ my $class = ref($self);
+ return if $fail{$class}{'send'} and $fail{$class}{'send'}--;
+ $self->{sent} .= shift;
+}
+
+my $msg;
+sub set_message {
+ if (ref($_[0])) {
+ $_[0]->{msg} = $_[1];
+ } else {
+ $msg = shift;
+ }
+}
+
+sub do_recv {
+ my ($len, $msg) = @_[1,2];
+ $_[0] .= substr($msg, 0, $len);
+}
+
+sub recv {
+ my ($self, $buf, $length, $flags) = @_;
+ my $message = exists $self->{msg} ?
+ $self->{msg} : $msg;
+
+ if (defined($message)) {
+ do_recv($_[1], $length, $message);
+ }
+ 1;
+}
+
+package IO::Select;
+
+sub new {
+ my $class = shift;
+ return if defined $fail{$class}{new} and $fail{$class}{new}--;
+ bless({sock => shift}, $class);
+}
+
+sub can_read {
+ my ($self, $timeout) = @_;
+ my $class = ref($self);
+ return if defined $fail{$class}{can_read} and $fail{class}{can_read}--;
+ $self->{sock}{timeout} = $timeout;
+ 1;
+}
+
+1;
View Lorry Controller Status