summaryrefslogtreecommitdiff
path: root/lib/Net
diff options
context:
space:
mode:
authorChris Williams <chris@bingosnet.co.uk>2009-09-08 13:25:04 +0100
committerChris Williams <chris@bingosnet.co.uk>2009-09-08 13:25:04 +0100
commitcb82353cb54730fb7ae6fdbe92841cc51a6af7a8 (patch)
tree25c3d58cea955a177fd7f04daf10a34bb784094c /lib/Net
parent087f1bf3a29bd837d3103a3637ea69e4499ca06b (diff)
downloadperl-cb82353cb54730fb7ae6fdbe92841cc51a6af7a8.tar.gz
Moved libnet from lib/ to ext/
Diffstat (limited to 'lib/Net')
-rw-r--r--lib/Net/Changes68
-rw-r--r--lib/Net/Cmd.pm783
-rw-r--r--lib/Net/Config.eg49
-rw-r--r--lib/Net/Config.pm312
-rw-r--r--lib/Net/Domain.pm347
-rw-r--r--lib/Net/FTP.pm1829
-rw-r--r--lib/Net/FTP/A.pm111
-rw-r--r--lib/Net/FTP/E.pm8
-rw-r--r--lib/Net/FTP/I.pm80
-rw-r--r--lib/Net/FTP/L.pm8
-rw-r--r--lib/Net/FTP/dataconn.pm124
-rw-r--r--lib/Net/Hostname.pm.eg14
-rw-r--r--lib/Net/NNTP.pm1140
-rw-r--r--lib/Net/Netrc.pm325
-rw-r--r--lib/Net/POP3.pm742
-rw-r--r--lib/Net/README109
-rw-r--r--lib/Net/SMTP.pm867
-rw-r--r--lib/Net/Time.pm151
-rwxr-xr-xlib/Net/demos/ftp21
-rw-r--r--lib/Net/demos/inetd9
-rwxr-xr-xlib/Net/demos/nntp40
-rw-r--r--lib/Net/demos/nntp.mirror86
-rw-r--r--lib/Net/demos/pop324
-rwxr-xr-xlib/Net/demos/smtp.self80
-rw-r--r--lib/Net/demos/time13
-rw-r--r--lib/Net/libnetFAQ.pod303
-rw-r--r--lib/Net/t/config.t87
-rw-r--r--lib/Net/t/datasend.t159
-rw-r--r--lib/Net/t/ftp.t73
-rw-r--r--lib/Net/t/hostname.t61
-rw-r--r--lib/Net/t/libnet_t.pl37
-rw-r--r--lib/Net/t/netrc.t155
-rw-r--r--lib/Net/t/nntp.t59
-rw-r--r--lib/Net/t/require.t28
-rw-r--r--lib/Net/t/smtp.t38
-rw-r--r--lib/Net/t/time.t133
36 files changed, 0 insertions, 8473 deletions
diff --git a/lib/Net/Changes b/lib/Net/Changes
deleted file mode 100644
index ff26b1d8cc..0000000000
--- a/lib/Net/Changes
+++ /dev/null
@@ -1,68 +0,0 @@
-libnet 1.22 -- Sun Aug 26 07:13:18 CDT 2007
-
-Bug Fixes
- * Fix a bug in Net::Cmd that is_utf8 does not exist prior to perl 5.8.1
-
-libnet 1.21 -- Sat May 19 08:53:09 CDT 2007
-
-Bug Fixes
- * Fix bug causing utf8 encoding of 8bit strings in Net::Cmd
- * Fix precedence issue in Net::NNTP. Patch from Brendan O'Dea
- * Fixed bug causing removal of last character on the line when
- doing ASCII FTP transfers
-
-Enhancements
- * Add support for ENVID and AUTH to Net::SMTP. Patch by Mark Martinec
- * Changed default for FTP transfers to be passive
- * Added support for FTP FEAT command
-
-libnet 1.20 -- Fri Feb 2 19:42:51 CST 2007
-
-Bug Fixes
- * Fixed incorrect handling of CRLF that straddled two blocks
- * Fix bug in response() which was too liberal in what it thought was a response line
- * Silence uninitialized value warnings in Net::Cmd during testing on Win32
- * Documentations typos and updates
-
-Enhancements
- * Added support for ORCPT into Net::SMTP
- * Support for servers that expect the USER command in upper or lower case. Try USER
- first then try user if that fails
-
-libnet 1.19 -- Wed Jun 30 14:53:48 BST 2004
-
-Bug Fixes
- * Fixed datasend test to work on Win32 platform
- * Fixed Authen::SASL checking in SMTP.pm and POP3.pm
- * Fixed bug that a restarted get with Net::FTP did not append to local file
-
-libnet 1.18 -- Mon Mar 22 16:19:01 GMT 2004
-
-Bug Fixes
- * Fixed bug in CRLF translation in Net::Cmd datasend/dataend methods
- * Fixed bug in converting numbers returned by PASV command into a
- packed IP address
- * Fixed bug that caused Net::FTP->get to truncate the local file after
- the restart method had been called
- * Fixed bug in Net::FTP-.rmdir when the server returned . and .. in
- the contents of a directory
- * Fixed bug in POP3 that was sending unnecessary RSETs
-
-Enhancements
- * Added support for POP3 CAPA command
- * Added support for XVERP to Net::SMTP
- * Added Net::POP3->banner method to return the banner received from
- the server during connect
- * Added Net::POP3->auth method for performing authentication using
- SASL, requires Authen::SASL
- * Added Host option to ->new constructor of FTP, NNTP, SMTP and POP3
- which can be used instead of passing the host as the first argument
- * Added ->host method to FTP, NNTP, SMTP and POP3 to return the host
- string used for the connect. This is useful to determine which host
- was connected to when multiple hosts are specified
- * Added support for more non-standard responses to Net::FTP->size
- * Updated POD for Net::SMTP wrt. not passing a Hello parameter to the
- constructor. (Jeff Macdonald)
-
-ChangeLogs for releases prior to 1.18 may be found at
-http://svn.mutatus.co.uk/browse/libnet/tags/libnet-1.17/ChangeLog
diff --git a/lib/Net/Cmd.pm b/lib/Net/Cmd.pm
deleted file mode 100644
index 4f0e4449f8..0000000000
--- a/lib/Net/Cmd.pm
+++ /dev/null
@@ -1,783 +0,0 @@
-# Net::Cmd.pm
-#
-# Copyright (c) 1995-2006 Graham Barr <gbarr@pobox.com>. 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::Cmd;
-
-require 5.001;
-require Exporter;
-
-use strict;
-use vars qw(@ISA @EXPORT $VERSION);
-use Carp;
-use Symbol 'gensym';
-
-BEGIN {
- if ($^O eq 'os390') {
- require Convert::EBCDIC;
-
- # Convert::EBCDIC->import;
- }
-}
-
-BEGIN {
- if (!eval { require utf8 }) {
- *is_utf8 = sub { 0 };
- }
- elsif (eval { utf8::is_utf8(undef); 1 }) {
- *is_utf8 = \&utf8::is_utf8;
- }
- elsif (eval { require Encode; Encode::is_utf8(undef); 1 }) {
- *is_utf8 = \&Encode::is_utf8;
- }
- else {
- *is_utf8 = sub { $_[0] =~ /[^\x00-\xff]/ };
- }
-}
-
-$VERSION = "2.29";
-@ISA = qw(Exporter);
-@EXPORT = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
-
-
-sub CMD_INFO {1}
-sub CMD_OK {2}
-sub CMD_MORE {3}
-sub CMD_REJECT {4}
-sub CMD_ERROR {5}
-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);
-
- my $pkg = shift;
- my $cmd = $pkg;
-
- $debug{$pkg} ||= 0;
-
- my %done = ();
- my @do = ($pkg);
- my %spc = ($pkg, "");
-
- while ($pkg = shift @do) {
- next if defined $done{$pkg};
-
- $done{$pkg} = 1;
-
- my $v =
- defined ${"${pkg}::VERSION"}
- ? "(" . ${"${pkg}::VERSION"} . ")"
- : "";
-
- my $spc = $spc{$pkg};
- $cmd->debug_print(1, "${spc}${pkg}${v}\n");
-
- if (@{"${pkg}::ISA"}) {
- @spc{@{"${pkg}::ISA"}} = (" " . $spc{$pkg}) x @{"${pkg}::ISA"};
- unshift(@do, @{"${pkg}::ISA"});
- }
- }
-}
-
-
-sub debug {
- @_ == 1 or @_ == 2 or croak 'usage: $obj->debug([LEVEL])';
-
- my ($cmd, $level) = @_;
- my $pkg = ref($cmd) || $cmd;
- my $oldval = 0;
-
- if (ref($cmd)) {
- $oldval = ${*$cmd}{'net_cmd_debug'} || 0;
- }
- else {
- $oldval = $debug{$pkg} || 0;
- }
-
- return $oldval
- unless @_ == 2;
-
- $level = $debug{$pkg} || 0
- unless defined $level;
-
- _print_isa($pkg)
- if ($level && !exists $debug{$pkg});
-
- if (ref($cmd)) {
- ${*$cmd}{'net_cmd_debug'} = $level;
- }
- else {
- $debug{$pkg} = $level;
- }
-
- $oldval;
-}
-
-
-sub message {
- @_ == 1 or croak 'usage: $obj->message()';
-
- my $cmd = shift;
-
- wantarray
- ? @{${*$cmd}{'net_cmd_resp'}}
- : join("", @{${*$cmd}{'net_cmd_resp'}});
-}
-
-
-sub debug_text { $_[2] }
-
-
-sub debug_print {
- my ($cmd, $out, $text) = @_;
- print STDERR $cmd, ($out ? '>>> ' : '<<< '), $cmd->debug_text($out, $text);
-}
-
-
-sub code {
- @_ == 1 or croak 'usage: $obj->code()';
-
- my $cmd = shift;
-
- ${*$cmd}{'net_cmd_code'} = "000"
- unless exists ${*$cmd}{'net_cmd_code'};
-
- ${*$cmd}{'net_cmd_code'};
-}
-
-
-sub status {
- @_ == 1 or croak 'usage: $obj->status()';
-
- my $cmd = shift;
-
- substr(${*$cmd}{'net_cmd_code'}, 0, 1);
-}
-
-
-sub set_status {
- @_ == 3 or croak 'usage: $obj->set_status(CODE, MESSAGE)';
-
- my $cmd = shift;
- my ($code, $resp) = @_;
-
- $resp = [$resp]
- unless ref($resp);
-
- (${*$cmd}{'net_cmd_code'}, ${*$cmd}{'net_cmd_resp'}) = ($code, $resp);
-
- 1;
-}
-
-
-sub command {
- my $cmd = shift;
-
- unless (defined fileno($cmd)) {
- $cmd->set_status("599", "Connection closed");
- return $cmd;
- }
-
-
- $cmd->dataend()
- if (exists ${*$cmd}{'net_cmd_last_ch'});
-
- if (scalar(@_)) {
- 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 $len = length $str;
- my $swlen;
-
- $cmd->close
- unless (defined($swlen = syswrite($cmd, $str, $len)) && $swlen == $len);
-
- $cmd->debug_print(1, $str)
- if ($cmd->debug);
-
- ${*$cmd}{'net_cmd_resp'} = []; # the response
- ${*$cmd}{'net_cmd_code'} = "000"; # Made this one up :-)
- }
-
- $cmd;
-}
-
-
-sub ok {
- @_ == 1 or croak 'usage: $obj->ok()';
-
- my $code = $_[0]->code;
- 0 < $code && $code < 400;
-}
-
-
-sub unsupported {
- my $cmd = shift;
-
- ${*$cmd}{'net_cmd_resp'} = ['Unsupported command'];
- ${*$cmd}{'net_cmd_code'} = 580;
- 0;
-}
-
-
-sub getline {
- my $cmd = shift;
-
- ${*$cmd}{'net_cmd_lines'} ||= [];
-
- return shift @{${*$cmd}{'net_cmd_lines'}}
- if scalar(@{${*$cmd}{'net_cmd_lines'}});
-
- my $partial = defined(${*$cmd}{'net_cmd_partial'}) ? ${*$cmd}{'net_cmd_partial'} : "";
- my $fd = fileno($cmd);
-
- return undef
- unless defined $fd;
-
- my $rin = "";
- vec($rin, $fd, 1) = 1;
-
- my $buf;
-
- until (scalar(@{${*$cmd}{'net_cmd_lines'}})) {
- my $timeout = $cmd->timeout || undef;
- my $rout;
-
- my $select_ret = select($rout = $rin, undef, undef, $timeout);
- if ($select_ret > 0) {
- unless (sysread($cmd, $buf = "", 1024)) {
- carp(ref($cmd) . ": Unexpected EOF on command channel")
- if $cmd->debug;
- $cmd->close;
- return undef;
- }
-
- substr($buf, 0, 0) = $partial; ## prepend from last sysread
-
- my @buf = split(/\015?\012/, $buf, -1); ## break into lines
-
- $partial = pop @buf;
-
- push(@{${*$cmd}{'net_cmd_lines'}}, map {"$_\n"} @buf);
-
- }
- else {
- my $msg = $select_ret ? "Error or Interrupted: $!" : "Timeout";
- carp("$cmd: $msg") if ($cmd->debug);
- return undef;
- }
- }
-
- ${*$cmd}{'net_cmd_partial'} = $partial;
-
- if ($tr) {
- foreach my $ln (@{${*$cmd}{'net_cmd_lines'}}) {
- $ln = $cmd->toebcdic($ln);
- }
- }
-
- shift @{${*$cmd}{'net_cmd_lines'}};
-}
-
-
-sub ungetline {
- my ($cmd, $str) = @_;
-
- ${*$cmd}{'net_cmd_lines'} ||= [];
- unshift(@{${*$cmd}{'net_cmd_lines'}}, $str);
-}
-
-
-sub parse_response {
- return ()
- unless $_[1] =~ s/^(\d\d\d)(.?)//o;
- ($1, $2 eq "-");
-}
-
-
-sub response {
- my $cmd = shift;
- my ($code, $more) = (undef) x 2;
-
- ${*$cmd}{'net_cmd_resp'} ||= [];
-
- while (1) {
- my $str = $cmd->getline();
-
- return CMD_ERROR
- unless defined($str);
-
- $cmd->debug_print(0, $str)
- if ($cmd->debug);
-
- ($code, $more) = $cmd->parse_response($str);
- unless (defined $code) {
- $cmd->ungetline($str);
- last;
- }
-
- ${*$cmd}{'net_cmd_code'} = $code;
-
- push(@{${*$cmd}{'net_cmd_resp'}}, $str);
-
- last unless ($more);
- }
-
- substr($code, 0, 1);
-}
-
-
-sub read_until_dot {
- my $cmd = shift;
- my $fh = shift;
- my $arr = [];
-
- while (1) {
- my $str = $cmd->getline() or return undef;
-
- $cmd->debug_print(0, $str)
- if ($cmd->debug & 4);
-
- last if ($str =~ /^\.\r?\n/o);
-
- $str =~ s/^\.\././o;
-
- if (defined $fh) {
- print $fh $str;
- }
- else {
- push(@$arr, $str);
- }
- }
-
- $arr;
-}
-
-
-sub datasend {
- my $cmd = shift;
- my $arr = @_ == 1 && ref($_[0]) ? $_[0] : \@_;
- my $line = join("", @$arr);
-
- # encode to individual utf8 bytes if
- # $line is a string (in internal UTF-8)
- utf8::encode($line) if is_utf8($line);
-
- return 0 unless defined(fileno($cmd));
-
- my $last_ch = ${*$cmd}{'net_cmd_last_ch'};
- $last_ch = ${*$cmd}{'net_cmd_last_ch'} = "\012" unless defined $last_ch;
-
- return 1 unless length $line;
-
- if ($cmd->debug) {
- foreach my $b (split(/\n/, $line)) {
- $cmd->debug_print(1, "$b\n");
- }
- }
-
- $line =~ tr/\r\n/\015\012/ unless "\r" eq "\015";
-
- my $first_ch = '';
-
- if ($last_ch eq "\015") {
- $first_ch = "\012" if $line =~ s/^\012//;
- }
- elsif ($last_ch eq "\012") {
- $first_ch = "." if $line =~ /^\./;
- }
-
- $line =~ s/\015?\012(\.?)/\015\012$1$1/sg;
-
- substr($line, 0, 0) = $first_ch;
-
- ${*$cmd}{'net_cmd_last_ch'} = substr($line, -1, 1);
-
- my $len = length($line);
- my $offset = 0;
- my $win = "";
- vec($win, fileno($cmd), 1) = 1;
- my $timeout = $cmd->timeout || undef;
-
- local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
-
- while ($len) {
- my $wout;
- my $s = select(undef, $wout = $win, undef, $timeout);
- if ((defined $s and $s > 0) or -f $cmd) # -f for testing on win32
- {
- my $w = syswrite($cmd, $line, $len, $offset);
- unless (defined($w)) {
- carp("$cmd: $!") if $cmd->debug;
- return undef;
- }
- $len -= $w;
- $offset += $w;
- }
- else {
- carp("$cmd: Timeout") if ($cmd->debug);
- return undef;
- }
- }
-
- 1;
-}
-
-
-sub rawdatasend {
- my $cmd = shift;
- my $arr = @_ == 1 && ref($_[0]) ? $_[0] : \@_;
- my $line = join("", @$arr);
-
- return 0 unless defined(fileno($cmd));
-
- return 1
- unless length($line);
-
- if ($cmd->debug) {
- my $b = "$cmd>>> ";
- print STDERR $b, join("\n$b", split(/\n/, $line)), "\n";
- }
-
- my $len = length($line);
- my $offset = 0;
- my $win = "";
- vec($win, fileno($cmd), 1) = 1;
- my $timeout = $cmd->timeout || undef;
-
- local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
- while ($len) {
- my $wout;
- if (select(undef, $wout = $win, undef, $timeout) > 0) {
- my $w = syswrite($cmd, $line, $len, $offset);
- unless (defined($w)) {
- carp("$cmd: $!") if $cmd->debug;
- return undef;
- }
- $len -= $w;
- $offset += $w;
- }
- else {
- carp("$cmd: Timeout") if ($cmd->debug);
- return undef;
- }
- }
-
- 1;
-}
-
-
-sub dataend {
- my $cmd = shift;
-
- return 0 unless defined(fileno($cmd));
-
- my $ch = ${*$cmd}{'net_cmd_last_ch'};
- my $tosend;
-
- if (!defined $ch) {
- return 1;
- }
- elsif ($ch ne "\012") {
- $tosend = "\015\012";
- }
-
- $tosend .= ".\015\012";
-
- local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS';
-
- $cmd->debug_print(1, ".\n")
- if ($cmd->debug);
-
- syswrite($cmd, $tosend, length $tosend);
-
- delete ${*$cmd}{'net_cmd_last_ch'};
-
- $cmd->response() == CMD_OK;
-}
-
-# read and write to tied filehandle
-sub tied_fh {
- my $cmd = shift;
- ${*$cmd}{'net_cmd_readbuf'} = '';
- my $fh = gensym();
- tie *$fh, ref($cmd), $cmd;
- return $fh;
-}
-
-# tie to myself
-sub TIEHANDLE {
- my $class = shift;
- my $cmd = shift;
- return $cmd;
-}
-
-# Tied filehandle read. Reads requested data length, returning
-# end-of-file when the dot is encountered.
-sub READ {
- my $cmd = shift;
- my ($len, $offset) = @_[1, 2];
- return unless exists ${*$cmd}{'net_cmd_readbuf'};
- my $done = 0;
- while (!$done and length(${*$cmd}{'net_cmd_readbuf'}) < $len) {
- ${*$cmd}{'net_cmd_readbuf'} .= $cmd->getline() or return;
- $done++ if ${*$cmd}{'net_cmd_readbuf'} =~ s/^\.\r?\n\Z//m;
- }
-
- $_[0] = '';
- substr($_[0], $offset + 0) = substr(${*$cmd}{'net_cmd_readbuf'}, 0, $len);
- substr(${*$cmd}{'net_cmd_readbuf'}, 0, $len) = '';
- delete ${*$cmd}{'net_cmd_readbuf'} if $done;
-
- return length $_[0];
-}
-
-
-sub READLINE {
- my $cmd = shift;
-
- # in this context, we use the presence of readbuf to
- # indicate that we have not yet reached the eof
- return unless exists ${*$cmd}{'net_cmd_readbuf'};
- my $line = $cmd->getline;
- return if $line =~ /^\.\r?\n/;
- $line;
-}
-
-
-sub PRINT {
- my $cmd = shift;
- my ($buf, $len, $offset) = @_;
- $len ||= length($buf);
- $offset += 0;
- return unless $cmd->datasend(substr($buf, $offset, $len));
- ${*$cmd}{'net_cmd_sending'}++; # flag that we should call dataend()
- return $len;
-}
-
-
-sub CLOSE {
- my $cmd = shift;
- my $r = exists(${*$cmd}{'net_cmd_sending'}) ? $cmd->dataend : 1;
- delete ${*$cmd}{'net_cmd_readbuf'};
- delete ${*$cmd}{'net_cmd_sending'};
- $r;
-}
-
-1;
-
-__END__
-
-
-=head1 NAME
-
-Net::Cmd - Network Command class (as used by FTP, SMTP etc)
-
-=head1 SYNOPSIS
-
- use Net::Cmd;
-
- @ISA = qw(Net::Cmd);
-
-=head1 DESCRIPTION
-
-C<Net::Cmd> is a collection of methods that can be inherited by a sub class
-of C<IO::Handle>. These methods implement the functionality required for a
-command based protocol, for example FTP and SMTP.
-
-=head1 USER METHODS
-
-These methods provide a user interface to the C<Net::Cmd> object.
-
-=over 4
-
-=item debug ( VALUE )
-
-Set the level of debug information for this object. If C<VALUE> is not given
-then the current state is returned. Otherwise the state is changed to
-C<VALUE> and the previous state returned.
-
-Different packages
-may implement different levels of debug but a non-zero value results in
-copies of all commands and responses also being sent to STDERR.
-
-If C<VALUE> is C<undef> then the debug level will be set to the default
-debug level for the class.
-
-This method can also be called as a I<static> method to set/get the default
-debug level for a given class.
-
-=item message ()
-
-Returns the text message returned from the last command
-
-=item code ()
-
-Returns the 3-digit code from the last command. If a command is pending
-then the value 0 is returned
-
-=item ok ()
-
-Returns non-zero if the last code value was greater than zero and
-less than 400. This holds true for most command servers. Servers
-where this does not hold may override this method.
-
-=item status ()
-
-Returns the most significant digit of the current status code. If a command
-is pending then C<CMD_PENDING> is returned.
-
-=item datasend ( DATA )
-
-Send data to the remote server, converting LF to CRLF. Any line starting
-with a '.' will be prefixed with another '.'.
-C<DATA> may be an array or a reference to an array.
-
-=item dataend ()
-
-End the sending of data to the remote server. This is done by ensuring that
-the data already sent ends with CRLF then sending '.CRLF' to end the
-transmission. Once this data has been sent C<dataend> calls C<response> and
-returns true if C<response> returns CMD_OK.
-
-=back
-
-=head1 CLASS METHODS
-
-These methods are not intended to be called by the user, but used or
-over-ridden by a sub-class of C<Net::Cmd>
-
-=over 4
-
-=item debug_print ( DIR, TEXT )
-
-Print debugging information. C<DIR> denotes the direction I<true> being
-data being sent to the server. Calls C<debug_text> before printing to
-STDERR.
-
-=item debug_text ( TEXT )
-
-This method is called to print debugging information. TEXT is
-the text being sent. The method should return the text to be printed
-
-This is primarily meant for the use of modules such as FTP where passwords
-are sent, but we do not want to display them in the debugging information.
-
-=item command ( CMD [, ARGS, ... ])
-
-Send a command to the command server. All arguments a first joined with
-a space character and CRLF is appended, this string is then sent to the
-command server.
-
-Returns undef upon failure
-
-=item unsupported ()
-
-Sets the status code to 580 and the response text to 'Unsupported command'.
-Returns zero.
-
-=item response ()
-
-Obtain a response from the server. Upon success the most significant digit
-of the status code is returned. Upon failure, timeout etc., I<undef> is
-returned.
-
-=item parse_response ( TEXT )
-
-This method is called by C<response> as a method with one argument. It should
-return an array of 2 values, the 3-digit status code and a flag which is true
-when this is part of a multi-line response and this line is not the list.
-
-=item getline ()
-
-Retrieve one line, delimited by CRLF, from the remote server. Returns I<undef>
-upon failure.
-
-B<NOTE>: If you do use this method for any reason, please remember to add
-some C<debug_print> calls into your method.
-
-=item ungetline ( TEXT )
-
-Unget a line of text from the server.
-
-=item rawdatasend ( DATA )
-
-Send data to the remote server without performing any conversions. C<DATA>
-is a scalar.
-
-=item read_until_dot ()
-
-Read data from the remote server until a line consisting of a single '.'.
-Any lines starting with '..' will have one of the '.'s removed.
-
-Returns a reference to a list containing the lines, or I<undef> upon failure.
-
-=item tied_fh ()
-
-Returns a filehandle tied to the Net::Cmd object. After issuing a
-command, you may read from this filehandle using read() or <>. The
-filehandle will return EOF when the final dot is encountered.
-Similarly, you may write to the filehandle in order to send data to
-the server after issuing a command that expects data to be written.
-
-See the Net::POP3 and Net::SMTP modules for examples of this.
-
-=back
-
-=head1 EXPORTS
-
-C<Net::Cmd> exports six subroutines, five of these, C<CMD_INFO>, C<CMD_OK>,
-C<CMD_MORE>, C<CMD_REJECT> and C<CMD_ERROR>, correspond to possible results
-of C<response> and C<status>. The sixth is C<CMD_PENDING>.
-
-=head1 AUTHOR
-
-Graham Barr <gbarr@pobox.com>
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995-2006 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.
-
-=cut
diff --git a/lib/Net/Config.eg b/lib/Net/Config.eg
deleted file mode 100644
index 77dc1f138b..0000000000
--- a/lib/Net/Config.eg
+++ /dev/null
@@ -1,49 +0,0 @@
-package Net::Config;
-
-require Exporter;
-use vars qw(@ISA @EXPORT %NetConfig);
-use strict;
-
-@EXPORT = qw(%NetConfig);
-@ISA = qw(Exporter);
-
-# WARNING WARNING WARNING WARNING WARNING WARNING WARNING
-# WARNING WARNING WARNING WARNING WARNING WARNING WARNING
-#
-# Below this line is auto-generated, *ANY* changes will be lost
-
-%NetConfig = (
- # the followinf parameters are all lists of hosts for the
- # respective protocols.
- nntp_hosts => [],
- snpp_hosts => [],
- pop3_hosts => [],
- smtp_hosts => [],
- ph_hosts => [],
- daytime_hosts => [],
- time_hosts => [],
-
- # your internet domain
- inet_domain => undef,
-
- # If you have an ftp proxy firewall (not an http firewall)
- # then set this to the name of the firewall
- ftp_firewall => undef,
-
- # set if all connections done via the firewall should use
- # passive data connections
- ftp_ext_passive => 0,
-
- # set if all connections not done via the firewall should use
- # passive data connections
- ftp_int_passive => 0,
-
- # If set the make test will attempt to connect to the hosts above
- test_hosts => 0,
-
- # Used during Configure (which you are not using) to do
- # DNS lookups to ensure hosts exist
- test_exist => 0,
-
-);
-1;
diff --git a/lib/Net/Config.pm b/lib/Net/Config.pm
deleted file mode 100644
index db51c1fc0d..0000000000
--- a/lib/Net/Config.pm
+++ /dev/null
@@ -1,312 +0,0 @@
-# Net::Config.pm
-#
-# Copyright (c) 2000 Graham Barr <gbarr@pobox.com>. 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;
-
-require Exporter;
-use vars qw(@ISA @EXPORT %NetConfig $VERSION $CONFIGURE $LIBNET_CFG);
-use Socket qw(inet_aton inet_ntoa);
-use strict;
-
-@EXPORT = qw(%NetConfig);
-@ISA = qw(Net::LocalCfg Exporter);
-$VERSION = "1.11";
-
-eval { local $SIG{__DIE__}; require Net::LocalCfg };
-
-%NetConfig = (
- nntp_hosts => [],
- snpp_hosts => [],
- pop3_hosts => [],
- smtp_hosts => [],
- ph_hosts => [],
- daytime_hosts => [],
- time_hosts => [],
- inet_domain => undef,
- ftp_firewall => undef,
- ftp_ext_passive => 1,
- ftp_int_passive => 1,
- test_hosts => 1,
- 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() } ? \$InternetConfig{ kICFTPHost()} : undef,
- ph_hosts => [ \$InternetConfig{ kICPhHost() } ],
- ftp_ext_passive => \$InternetConfig{"646F676F\xA5UsePassiveMode"} || 0,
- ftp_int_passive => \$InternetConfig{"646F676F\xA5UsePassiveMode"} || 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/;
-if (-f $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 { local $SIG{__DIE__}; (getpwuid($>))[7] } || $ENV{HOME};
- $home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH} || '') if defined $ENV{HOMEDRIVE};
- if (defined $home) {
- $file = $home . "/.libnetrc";
- $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) {
- $NetConfig{$k} = [$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
-
-
-sub requires_firewall {
- shift; # ignore package
- my $host = shift;
-
- return 0 unless defined $NetConfig{'ftp_firewall'};
-
- $host = inet_aton($host) or return -1;
- $host = inet_ntoa($host);
-
- if (exists $NetConfig{'local_netmask'}) {
- my $quad = unpack("N", pack("C*", split(/\./, $host)));
- my $list = $NetConfig{'local_netmask'};
- $list = [$list] unless ref($list);
- foreach (@$list) {
- my ($net, $bits) = (m#^(\d+\.\d+\.\d+\.\d+)/(\d+)$#) or next;
- my $mask = ~0 << (32 - $bits);
- my $addr = unpack("N", pack("C*", split(/\./, $net)));
-
- return 0 if (($addr & $mask) == ($quad & $mask));
- }
- return 1;
- }
-
- return 0;
-}
-
-use vars qw(*is_external);
-*is_external = \&requires_firewall;
-
-1;
-
-__END__
-
-=head1 NAME
-
-Net::Config - Local configuration data for libnet
-
-=head1 SYNOPSYS
-
- use Net::Config qw(%NetConfig);
-
-=head1 DESCRIPTION
-
-C<Net::Config> holds configuration data for the modules in the libnet
-distribution. During installation you will be asked for these values.
-
-The configuration data is held globally in a file in the perl installation
-tree, but a user may override any of these values by providing their own. This
-can be done by having a C<.libnetrc> file in their home directory. This file
-should return a reference to a HASH containing the keys described below.
-For example
-
- # .libnetrc
- {
- nntp_hosts => [ "my_preferred_host" ],
- ph_hosts => [ "my_ph_server" ],
- }
- __END__
-
-=head1 METHODS
-
-C<Net::Config> defines the following methods. They are methods as they are
-invoked as class methods. This is because C<Net::Config> inherits from
-C<Net::LocalCfg> so you can override these methods if you want.
-
-=over 4
-
-=item requires_firewall HOST
-
-Attempts to determine if a given host is outside your firewall. Possible
-return values are.
-
- -1 Cannot lookup hostname
- 0 Host is inside firewall (or there is no ftp_firewall entry)
- 1 Host is outside the firewall
-
-This is done by using hostname lookup and the C<local_netmask> entry in
-the configuration data.
-
-=back
-
-=head1 NetConfig VALUES
-
-=over 4
-
-=item nntp_hosts
-
-=item snpp_hosts
-
-=item pop3_hosts
-
-=item smtp_hosts
-
-=item ph_hosts
-
-=item daytime_hosts
-
-=item time_hosts
-
-Each is a reference to an array of hostnames (in order of preference),
-which should be used for the given protocol
-
-=item inet_domain
-
-Your internet domain name
-
-=item ftp_firewall
-
-If you have an FTP proxy firewall (B<NOT> an HTTP or SOCKS firewall)
-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 available. But unfortunately
-there is no 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_passive
-
-FTP servers can work in passive or active mode. Active mode is when
-you want to transfer data you have to tell the server the address and
-port to connect to. Passive mode is when the server provide the
-address and port and you establish the connection.
-
-With some firewalls active mode does not work as the server cannot
-connect to your machine (because you are behind a firewall) and the firewall
-does not re-write the command. In this case you should set C<ftp_ext_passive>
-to a I<true> value.
-
-Some servers are configured to only work in passive mode. If you have
-one of these you can force C<Net::FTP> to always transfer in passive
-mode; when not going via a firewall, by setting C<ftp_int_passive> to
-a I<true> value.
-
-=item local_netmask
-
-A reference to a list of netmask strings in the form C<"134.99.4.0/24">.
-These are used by the C<requires_firewall> function to determine if a given
-host is inside or outside your firewall.
-
-=back
-
-The following entries are used during installation & testing on the
-libnet package
-
-=over 4
-
-=item test_hosts
-
-If true then C<make test> may attempt to connect to hosts given in the
-configuration.
-
-=item test_exists
-
-If true then C<Configure> will check each hostname given that it exists
-
-=back
-
-=cut
diff --git a/lib/Net/Domain.pm b/lib/Net/Domain.pm
deleted file mode 100644
index 330909da49..0000000000
--- a/lib/Net/Domain.pm
+++ /dev/null
@@ -1,347 +0,0 @@
-# Net::Domain.pm
-#
-# Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. 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::Domain;
-
-require Exporter;
-
-use Carp;
-use strict;
-use vars qw($VERSION @ISA @EXPORT_OK);
-use Net::Config;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
-
-$VERSION = "2.20";
-
-my ($host, $domain, $fqdn) = (undef, undef, undef);
-
-# Try every conceivable way to get hostname.
-
-
-sub _hostname {
-
- # we already know it
- return $host
- if (defined $host);
-
- if ($^O eq 'MSWin32') {
- require Socket;
- my ($name, $alias, $type, $len, @addr) = gethostbyname($ENV{'COMPUTERNAME'} || 'localhost');
- while (@addr) {
- my $a = shift(@addr);
- $host = gethostbyaddr($a, Socket::AF_INET());
- last if defined $host;
- }
- if (defined($host) && index($host, '.') > 0) {
- $fqdn = $host;
- ($host, $domain) = $fqdn =~ /^([^\.]+)\.(.*)$/;
- }
- return $host;
- }
- elsif ($^O eq 'MacOS') {
- chomp($host = `hostname`);
- }
- elsif ($^O eq 'VMS') { ## multiple varieties of net s/w makes this hard
- $host = $ENV{'UCX$INET_HOST'} if defined($ENV{'UCX$INET_HOST'});
- $host = $ENV{'MULTINET_HOST_NAME'} if defined($ENV{'MULTINET_HOST_NAME'});
- if (index($host, '.') > 0) {
- $fqdn = $host;
- ($host, $domain) = $fqdn =~ /^([^\.]+)\.(.*)$/;
- }
- return $host;
- }
- else {
- local $SIG{'__DIE__'};
-
- # syscall is preferred since it avoids tainting problems
- eval {
- my $tmp = "\0" x 256; ## preload scalar
- eval {
- package main;
- require "syscall.ph";
- defined(&main::SYS_gethostname);
- }
- || eval {
- package main;
- require "sys/syscall.ph";
- defined(&main::SYS_gethostname);
- }
- and $host =
- (syscall(&main::SYS_gethostname, $tmp, 256) == 0)
- ? $tmp
- : undef;
- }
-
- # POSIX
- || eval {
- require POSIX;
- $host = (POSIX::uname())[1];
- }
-
- # trusty old hostname command
- || eval {
- chop($host = `(hostname) 2>/dev/null`); # BSD'ish
- }
-
- # sysV/POSIX uname command (may truncate)
- || eval {
- chop($host = `uname -n 2>/dev/null`); ## SYSV'ish && POSIX'ish
- }
-
- # Apollo pre-SR10
- || eval { $host = (split(/[:\. ]/, `/com/host`, 6))[0]; }
-
- || eval { $host = ""; };
- }
-
- # remove garbage
- $host =~ s/[\0\r\n]+//go;
- $host =~ s/(\A\.+|\.+\Z)//go;
- $host =~ s/\.\.+/\./go;
-
- $host;
-}
-
-
-sub _hostdomain {
-
- # we already know it
- return $domain
- if (defined $domain);
-
- local $SIG{'__DIE__'};
-
- return $domain = $NetConfig{'inet_domain'}
- if defined $NetConfig{'inet_domain'};
-
- # try looking in /etc/resolv.conf
- # putting this here and assuming that it is correct, eliminates
- # calls to gethostbyname, and therefore DNS lookups. This helps
- # those on dialup systems.
-
- local *RES;
- local ($_);
-
- if (open(RES, "/etc/resolv.conf")) {
- while (<RES>) {
- $domain = $1
- if (/\A\s*(?:domain|search)\s+(\S+)/);
- }
- close(RES);
-
- return $domain
- if (defined $domain);
- }
-
- # just try hostname and system calls
-
- my $host = _hostname();
- my (@hosts);
-
- @hosts = ($host, "localhost");
-
- unless (defined($host) && $host =~ /\./) {
- my $dom = undef;
- eval {
- my $tmp = "\0" x 256; ## preload scalar
- eval {
- package main;
- require "syscall.ph";
- }
- || eval {
- package main;
- require "sys/syscall.ph";
- }
- and $dom =
- (syscall(&main::SYS_getdomainname, $tmp, 256) == 0)
- ? $tmp
- : undef;
- };
-
- if ($^O eq 'VMS') {
- $dom ||= $ENV{'TCPIP$INET_DOMAIN'}
- || $ENV{'UCX$INET_DOMAIN'};
- }
-
- chop($dom = `domainname 2>/dev/null`)
- unless (defined $dom || $^O =~ /^(?:cygwin|MSWin32)/);
-
- if (defined $dom) {
- my @h = ();
- $dom =~ s/^\.+//;
- while (length($dom)) {
- push(@h, "$host.$dom");
- $dom =~ s/^[^.]+.+// or last;
- }
- unshift(@hosts, @h);
- }
- }
-
- # Attempt to locate FQDN
-
- foreach (grep { defined $_ } @hosts) {
- my @info = gethostbyname($_);
-
- next unless @info;
-
- # look at real name & aliases
- my $site;
- foreach $site ($info[0], split(/ /, $info[1])) {
- if (rindex($site, ".") > 0) {
-
- # Extract domain from FQDN
-
- ($domain = $site) =~ s/\A[^\.]+\.//;
- return $domain;
- }
- }
- }
-
- # Look for environment variable
-
- $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN};
-
- if (defined $domain) {
- $domain =~ s/[\r\n\0]+//g;
- $domain =~ s/(\A\.+|\.+\Z)//g;
- $domain =~ s/\.\.+/\./g;
- }
-
- $domain;
-}
-
-
-sub domainname {
-
- return $fqdn
- if (defined $fqdn);
-
- _hostname();
- _hostdomain();
-
- # Assumption: If the host name does not contain a period
- # and the domain name does, then assume that they are correct
- # this helps to eliminate calls to gethostbyname, and therefore
- # eleminate DNS lookups
-
- return $fqdn = $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 and $host =~ /^\d+(\.\d+){3}$/;
-
- my @host = defined $host ? split(/\./, $host) : ('localhost');
- my @domain = defined $domain ? split(/\./, $domain) : ();
- my @fqdn = ();
-
- # Determine from @host & @domain the FQDN
-
- my @d = @domain;
-
-LOOP:
- while (1) {
- my @h = @host;
- while (@h) {
- my $tmp = join(".", @h, @d);
- if ((gethostbyname($tmp))[0]) {
- @fqdn = (@h, @d);
- $fqdn = $tmp;
- last LOOP;
- }
- pop @h;
- }
- last unless shift @d;
- }
-
- if (@fqdn) {
- $host = shift @fqdn;
- until ((gethostbyname($host))[0]) {
- $host .= "." . shift @fqdn;
- }
- $domain = join(".", @fqdn);
- }
- else {
- undef $host;
- undef $domain;
- undef $fqdn;
- }
-
- $fqdn;
-}
-
-
-sub hostfqdn { domainname() }
-
-
-sub hostname {
- domainname()
- unless (defined $host);
- return $host;
-}
-
-
-sub hostdomain {
- domainname()
- unless (defined $domain);
- return $domain;
-}
-
-1; # Keep require happy
-
-__END__
-
-=head1 NAME
-
-Net::Domain - Attempt to evaluate the current host's internet name and domain
-
-=head1 SYNOPSIS
-
- use Net::Domain qw(hostname hostfqdn hostdomain domainname);
-
-=head1 DESCRIPTION
-
-Using various methods B<attempt> to find the Fully Qualified Domain Name (FQDN)
-of the current host. From this determine the host-name and the host-domain.
-
-Each of the functions will return I<undef> if the FQDN cannot be determined.
-
-=over 4
-
-=item hostfqdn ()
-
-Identify and return the FQDN of the current host.
-
-=item domainname ()
-
-An alias for hostfqdn ().
-
-=item hostname ()
-
-Returns the smallest part of the FQDN which can be used to identify the host.
-
-=item hostdomain ()
-
-Returns the remainder of the FQDN after the I<hostname> has been removed.
-
-=back
-
-=head1 AUTHOR
-
-Graham Barr <gbarr@pobox.com>.
-Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
-
-=head1 COPYRIGHT
-
-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.
-
-=cut
diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm
deleted file mode 100644
index 9ed6d385d9..0000000000
--- a/lib/Net/FTP.pm
+++ /dev/null
@@ -1,1829 +0,0 @@
-# Net::FTP.pm
-#
-# Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-#
-# Documentation (at end) improved 1996 by Nathan Torkington <gnat@frii.com>.
-
-package Net::FTP;
-
-require 5.001;
-
-use strict;
-use vars qw(@ISA $VERSION);
-use Carp;
-
-use Socket 1.3;
-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);
-
-$VERSION = '2.77';
-@ISA = qw(Exporter Net::Cmd IO::Socket::INET);
-
-# Someday I will "use constant", when I am not bothered to much about
-# compatability with older releases of perl
-
-use vars qw($TELNET_IAC $TELNET_IP $TELNET_DM);
-($TELNET_IAC, $TELNET_IP, $TELNET_DM) = (255, 244, 242);
-
-
-BEGIN {
-
- # make a constant so code is fast'ish
- my $is_os390 = $^O eq 'os390';
- *trEBCDIC = sub () {$is_os390}
-}
-
-
-sub new {
- my $pkg = shift;
- my ($peer, %arg);
- if (@_ % 2) {
- $peer = shift;
- %arg = @_;
- }
- else {
- %arg = @_;
- $peer = delete $arg{Host};
- }
-
- my $host = $peer;
- my $fire = undef;
- my $fire_type = undef;
-
- if (exists($arg{Firewall}) || Net::Config->requires_firewall($peer)) {
- $fire = $arg{Firewall}
- || $ENV{FTP_FIREWALL}
- || $NetConfig{ftp_firewall}
- || undef;
-
- if (defined $fire) {
- $peer = $fire;
- 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}
- : 120
- )
- or return undef;
-
- ${*$ftp}{'net_ftp_host'} = $host; # Remote hostname
- ${*$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
- if (defined $fire_type);
-
- ${*$ftp}{'net_ftp_passive'} =
- int exists $arg{Passive} ? $arg{Passive}
- : exists $ENV{FTP_PASSIVE} ? $ENV{FTP_PASSIVE}
- : defined $fire ? $NetConfig{ftp_ext_passive}
- : $NetConfig{ftp_int_passive}; # Whew! :-)
-
- $ftp->hash(exists $arg{Hash} ? $arg{Hash} : 0, 1024);
-
- $ftp->autoflush(1);
-
- $ftp->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-
- unless ($ftp->response() == CMD_OK) {
- $ftp->close();
- $@ = $ftp->message;
- undef $ftp;
- }
-
- $ftp;
-}
-
-##
-## User interface methods
-##
-
-
-sub host {
- my $me = shift;
- ${*$me}{'net_ftp_host'};
-}
-
-
-sub hash {
- my $ftp = shift; # self
-
- my ($h, $b) = @_;
- 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];
-}
-
-
-sub quit {
- my $ftp = shift;
-
- $ftp->_QUIT;
- $ftp->close;
-}
-
-
-sub DESTROY { }
-
-
-sub ascii { shift->type('A', @_); }
-sub binary { shift->type('I', @_); }
-
-
-sub ebcdic {
- carp "TYPE E is unsupported, shall default to I";
- shift->type('E', @_);
-}
-
-
-sub byte {
- carp "TYPE L is unsupported, shall default to I";
- shift->type('L', @_);
-}
-
-# Allow the user to send a command directly, BE CAREFUL !!
-
-
-sub quot {
- my $ftp = shift;
- my $cmd = shift;
-
- $ftp->command(uc $cmd, @_);
- $ftp->response();
-}
-
-
-sub site {
- my $ftp = shift;
-
- $ftp->command("SITE", @_);
- $ftp->response();
-}
-
-
-sub mdtm {
- my $ftp = shift;
- my $file = shift;
-
- # Server Y2K bug workaround
- #
- # sigh; some idiotic FTP servers use ("19%d",tm.tm_year) instead of
- # ("%d",tm.tm_year+1900). This results in an extra digit in the
- # string returned. To account for this we allow an optional extra
- # digit in the year. Then if the first two digits are 19 we use the
- # remainder, otherwise we subtract 1900 from the whole year.
-
- $ftp->_MDTM($file)
- && $ftp->message =~ /((\d\d)(\d\d\d?))(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
- ? timegm($8, $7, $6, $5, $4 - 1, $2 eq '19' ? $3 : ($1 - 1900))
- : undef;
-}
-
-
-sub size {
- my $ftp = shift;
- my $file = shift;
- my $io;
- if ($ftp->supported("SIZE")) {
- return $ftp->_SIZE($file)
- ? ($ftp->message =~ /(\d+)\s*(bytes?\s*)?$/)[0]
- : undef;
- }
- elsif ($ftp->supported("STAT")) {
- my @msg;
- return undef
- unless $ftp->_STAT($file) && (@msg = $ftp->message) == 3;
- my $line;
- foreach $line (@msg) {
- return (split(/\s+/, $line))[4]
- if $line =~ /^[-rwxSsTt]{10}/;
- }
- }
- else {
- my @files = $ftp->dir($file);
- if (@files) {
- return (split(/\s+/, $1))[4]
- if $files[0] =~ /^([-rwxSsTt]{10}.*)$/;
- }
- }
- undef;
-}
-
-
-sub login {
- my ($ftp, $user, $pass, $acct) = @_;
- my ($ok, $ruser, $fwtype);
-
- unless (defined $user) {
- require Net::Netrc;
-
- my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'});
-
- ($user, $pass, $acct) = $rc->lpa()
- if ($rc);
- }
-
- $user ||= "anonymous";
- $ruser = $user;
-
- $fwtype = ${*$ftp}{'net_ftp_firewall_type'}
- || $NetConfig{'ftp_firewall_type'}
- || 0;
-
- if ($fwtype && defined ${*$ftp}{'net_ftp_firewall'}) {
- if ($fwtype == 1 || $fwtype == 7) {
- $user .= '@' . ${*$ftp}{'net_ftp_host'};
- }
- else {
- require Net::Netrc;
-
- my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
-
- my ($fwuser, $fwpass, $fwacct) = $rc ? $rc->lpa() : ();
-
- if ($fwtype == 5) {
- $user = join('@', $user, $fwuser, ${*$ftp}{'net_ftp_host'});
- $pass = $pass . '@' . $fwpass;
- }
- else {
- if ($fwtype == 2) {
- $user .= '@' . ${*$ftp}{'net_ftp_host'};
- }
- elsif ($fwtype == 6) {
- $fwuser .= '@' . ${*$ftp}{'net_ftp_host'};
- }
-
- $ok = $ftp->_USER($fwuser);
-
- return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
-
- $ok = $ftp->_PASS($fwpass || "");
-
- return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
-
- $ok = $ftp->_ACCT($fwacct)
- if defined($fwacct);
-
- if ($fwtype == 3) {
- $ok = $ftp->command("SITE", ${*$ftp}{'net_ftp_host'})->response;
- }
- elsif ($fwtype == 4) {
- $ok = $ftp->command("OPEN", ${*$ftp}{'net_ftp_host'})->response;
- }
-
- return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
- }
- }
- }
-
- $ok = $ftp->_USER($user);
-
- # Some dumb firewalls don't prefix the connection messages
- $ok = $ftp->response()
- if ($ok == CMD_OK && $ftp->code == 220 && $user =~ /\@/);
-
- if ($ok == CMD_MORE) {
- unless (defined $pass) {
- require Net::Netrc;
-
- my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser);
-
- ($ruser, $pass, $acct) = $rc->lpa()
- if ($rc);
-
- $pass = '-anonymous@'
- if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o));
- }
-
- $ok = $ftp->_PASS($pass || "");
- }
-
- $ok = $ftp->_ACCT($acct)
- if (defined($acct) && ($ok == CMD_MORE || $ok == CMD_OK));
-
- if ($fwtype == 7 && $ok == CMD_OK && defined ${*$ftp}{'net_ftp_firewall'}) {
- my ($f, $auth, $resp) = _auth_id($ftp);
- $ftp->authorize($auth, $resp) if defined($resp);
- }
-
- $ok == CMD_OK;
-}
-
-
-sub account {
- @_ == 2 or croak 'usage: $ftp->account( ACCT )';
- my $ftp = shift;
- my $acct = shift;
- $ftp->_ACCT($acct) == CMD_OK;
-}
-
-
-sub _auth_id {
- my ($ftp, $auth, $resp) = @_;
-
- unless (defined $resp) {
- require Net::Netrc;
-
- $auth ||= eval { (getpwuid($>))[0] } || $ENV{NAME};
-
- my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}, $auth)
- || Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
-
- ($auth, $resp) = $rc->lpa()
- if ($rc);
- }
- ($ftp, $auth, $resp);
-}
-
-
-sub authorize {
- @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize( [AUTH [, RESP]])';
-
- my ($ftp, $auth, $resp) = &_auth_id;
-
- my $ok = $ftp->_AUTH($auth || "");
-
- $ok = $ftp->_RESP($resp || "")
- if ($ok == CMD_MORE);
-
- $ok == CMD_OK;
-}
-
-
-sub rename {
- @_ == 3 or croak 'usage: $ftp->rename(FROM, TO)';
-
- my ($ftp, $from, $to) = @_;
-
- $ftp->_RNFR($from)
- && $ftp->_RNTO($to);
-}
-
-
-sub type {
- my $ftp = shift;
- my $type = shift;
- my $oldval = ${*$ftp}{'net_ftp_type'};
-
- return $oldval
- unless (defined $type);
-
- return undef
- unless ($ftp->_TYPE($type, @_));
-
- ${*$ftp}{'net_ftp_type'} = join(" ", $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;
-
- 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'};
-
- $ftp->response();
-
- $ftp->status == CMD_OK;
-}
-
-
-sub get {
- my ($ftp, $remote, $local, $where) = @_;
-
- my ($loc, $len, $buf, $resp, $data);
- local *FD;
-
- my $localfd = ref($local) || ref(\$local) eq "GLOB";
-
- ($local = $remote) =~ s#^.*/##
- unless (defined $local);
-
- croak("Bad remote filename '$remote'\n")
- if $remote =~ /[\r\n]/s;
-
- ${*$ftp}{'net_ftp_rest'} = $where if defined $where;
- my $rest = ${*$ftp}{'net_ftp_rest'};
-
- delete ${*$ftp}{'net_ftp_port'};
- delete ${*$ftp}{'net_ftp_pasv'};
-
- $data = $ftp->retr($remote)
- or return undef;
-
- if ($localfd) {
- $loc = $local;
- }
- else {
- $loc = \*FD;
-
- unless (sysopen($loc, $local, O_CREAT | O_WRONLY | ($rest ? O_APPEND: O_TRUNC))) {
- carp "Cannot open Local file $local: $!\n";
- $data->abort;
- return undef;
- }
- }
-
- if ($ftp->type eq 'I' && !binmode($loc)) {
- carp "Cannot binmode Local file $local: $!\n";
- $data->abort;
- close($loc) unless $localfd;
- return undef;
- }
-
- $buf = '';
- my ($count, $hashh, $hashb, $ref) = (0);
-
- ($hashh, $hashb) = @$ref
- if ($ref = ${*$ftp}{'net_ftp_hash'});
-
- my $blksize = ${*$ftp}{'net_ftp_blksize'};
- local $\; # Just in case
-
- 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));
- $count %= $hashb;
- }
- unless (print $loc $buf) {
- carp "Cannot write to Local file $local: $!\n";
- $data->abort;
- close($loc)
- unless $localfd;
- return undef;
- }
- }
-
- print $hashh "\n" if $hashh;
-
- 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;
-}
-
-
-sub cwd {
- @_ == 1 || @_ == 2 or croak 'usage: $ftp->cwd( [ DIR ] )';
-
- my ($ftp, $dir) = @_;
-
- $dir = "/" unless defined($dir) && $dir =~ /\S/;
-
- $dir eq ".."
- ? $ftp->_CDUP()
- : $ftp->_CWD($dir);
-}
-
-
-sub cdup {
- @_ == 1 or croak 'usage: $ftp->cdup()';
- $_[0]->_CDUP;
-}
-
-
-sub pwd {
- @_ == 1 || croak 'usage: $ftp->pwd()';
- my $ftp = shift;
-
- $ftp->_PWD();
- $ftp->_extract_path;
-}
-
-# rmdir( $ftp, $dir, [ $recurse ] )
-#
-# Removes $dir on remote host via FTP.
-# $ftp is handle for remote host
-#
-# If $recurse is TRUE, the directory and deleted recursively.
-# This means all of its contents and subdirectories.
-#
-# Initial version contributed by Dinkum Software
-#
-sub rmdir {
- @_ == 2 || @_ == 3 or croak('usage: $ftp->rmdir( DIR [, RECURSE ] )');
-
- # Pick off the args
- my ($ftp, $dir, $recurse) = @_;
- my $ok;
-
- return $ok
- if $ok = $ftp->_RMD($dir)
- or !$recurse;
-
- # Try to delete the contents
- # Get a list of all the files in the directory
- my @filelist = grep { !/^\.{1,2}$/ } $ftp->ls($dir);
-
- return undef
- 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) {
- next # successfully deleted the file
- if $ftp->delete($file);
-
- # Failed to delete it, assume its a directory
- # Recurse and ignore errors, the final rmdir() will
- # fail on any errors here
- return $ok
- unless $ok = $ftp->rmdir($file, 1);
- }
-
- # Directory should be empty
- # Try to remove the directory again
- # Pass results directly to caller
- # If any of the prior deletes failed, this
- # rmdir() will fail because directory is not empty
- 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 ] )';
-
- my ($ftp, $dir, $recurse) = @_;
-
- $ftp->_MKD($dir) || $recurse
- or return undef;
-
- my $path = $dir;
-
- unless ($ftp->ok) {
- my @path = split(m#(?=/+)#, $dir);
-
- $path = "";
-
- while (@path) {
- $path .= shift @path;
-
- $ftp->_MKD($path);
-
- $path = $ftp->_extract_path($path);
- }
-
- # 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) {
- my ($status, $message) = ($ftp->status, $ftp->message);
- my $pwd = $ftp->pwd;
-
- if ($pwd && $ftp->cwd($dir)) {
- $path = $dir;
- $ftp->cwd($pwd);
- }
- else {
- undef $path;
- }
- $ftp->set_status($status, $message);
- }
- }
-
- $path;
-}
-
-
-sub delete {
- @_ == 2 || croak 'usage: $ftp->delete( FILENAME )';
-
- $_[0]->_DELE($_[1]);
-}
-
-
-sub put { shift->_store_cmd("stor", @_) }
-sub put_unique { shift->_store_cmd("stou", @_) }
-sub append { shift->_store_cmd("appe", @_) }
-
-
-sub nlst { shift->_data_cmd("NLST", @_) }
-sub list { shift->_data_cmd("LIST", @_) }
-sub retr { shift->_data_cmd("RETR", @_) }
-sub stor { shift->_data_cmd("STOR", @_) }
-sub stou { shift->_data_cmd("STOU", @_) }
-sub appe { shift->_data_cmd("APPE", @_) }
-
-
-sub _store_cmd {
- my ($ftp, $cmd, $local, $remote) = @_;
- my ($loc, $sock, $len, $buf);
- local *FD;
-
- my $localfd = ref($local) || ref(\$local) eq "GLOB";
-
- unless (defined $remote) {
- croak 'Must specify remote filename with stream input'
- if $localfd;
-
- 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;
-
- if ($localfd) {
- $loc = $local;
- }
- else {
- $loc = \*FD;
-
- unless (sysopen($loc, $local, O_RDONLY)) {
- carp "Cannot open Local file $local: $!\n";
- return undef;
- }
- }
-
- if ($ftp->type eq 'I' && !binmode($loc)) {
- carp "Cannot binmode Local file $local: $!\n";
- return undef;
- }
-
- delete ${*$ftp}{'net_ftp_port'};
- delete ${*$ftp}{'net_ftp_pasv'};
-
- $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);
-
- ($hashh, $hashb) = @$ref
- if ($ref = ${*$ftp}{'net_ftp_hash'});
-
- while (1) {
- last unless $len = read($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));
- $count %= $hashb;
- }
-
- my $wlen;
- unless (defined($wlen = $sock->write($buf, $len)) && $wlen == $len) {
- $sock->abort;
- close($loc)
- unless $localfd;
- print $hashh "\n" if $hashh;
- return undef;
- }
- }
-
- print $hashh "\n" if $hashh;
-
- close($loc)
- unless $localfd;
-
- $sock->close()
- or return undef;
-
- if ('STOU' eq uc $cmd and $ftp->message =~ m/unique\s+file\s*name\s*:\s*(.*)\)|"(.*)"/) {
- require File::Basename;
- $remote = File::Basename::basename($+);
- }
-
- return $remote;
-}
-
-
-sub port {
- @_ == 1 || @_ == 2 or croak 'usage: $ftp->port([PORT])';
-
- my ($ftp, $port) = @_;
- my $ok;
-
- delete ${*$ftp}{'net_ftp_intern_port'};
-
- unless (defined $port) {
-
- # create a Listen socket at same address as the command socket
-
- ${*$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(/\./, $listen->sockhost));
-
- $port = join(',', @myaddr, $myport >> 8, $myport & 0xff);
-
- ${*$ftp}{'net_ftp_intern_port'} = 1;
- }
-
- $ok = $ftp->_PORT($port);
-
- ${*$ftp}{'net_ftp_port'} = $port;
-
- $ok;
-}
-
-
-sub ls { shift->_list_cmd("NLST", @_); }
-sub dir { shift->_list_cmd("LIST", @_); }
-
-
-sub pasv {
- @_ == 1 or croak 'usage: $ftp->pasv()';
-
- my $ftp = shift;
-
- delete ${*$ftp}{'net_ftp_intern_port'};
-
- $ftp->_PASV && $ftp->message =~ /(\d+(,\d+)+)/
- ? ${*$ftp}{'net_ftp_pasv'} = $1
- : undef;
-}
-
-
-sub unique_name {
- my $ftp = shift;
- ${*$ftp}{'net_ftp_unique'} || undef;
-}
-
-
-sub supported {
- @_ == 2 or croak 'usage: $ftp->supported( CMD )';
- my $ftp = shift;
- my $cmd = uc shift;
- my $hash = ${*$ftp}{'net_ftp_supported'} ||= {};
-
- return $hash->{$cmd}
- if exists $hash->{$cmd};
-
- return $hash->{$cmd} = 0
- unless $ftp->_HELP($cmd);
-
- my $text = $ftp->message;
- if ($text =~ /following\s+commands/i) {
- $text =~ s/^.*\n//;
- while ($text =~ /(\*?)(\w+)(\*?)/sg) {
- $hash->{"\U$2"} = !length("$1$3");
- }
- }
- else {
- $hash->{$cmd} = $text !~ /unimplemented/i;
- }
-
- $hash->{$cmd} ||= 0;
-}
-
-##
-## Deprecated methods
-##
-
-
-sub lsl {
- carp "Use of Net::FTP::lsl deprecated, use 'dir'"
- if $^W;
- goto &dir;
-}
-
-
-sub authorise {
- carp "Use of Net::FTP::authorise deprecated, use 'authorize'"
- if $^W;
- goto &authorize;
-}
-
-
-##
-## Private methods
-##
-
-
-sub _extract_path {
- my ($ftp, $path) = @_;
-
- # This tries to work both with and without the quote doubling
- # convention (RFC 959 requires it, but the first 3 servers I checked
- # didn't implement it). It will fail on a server which uses a quote in
- # the message which isn't a part of or surrounding the path.
- $ftp->ok
- && $ftp->message =~ /(?:^|\s)\"(.*)\"(?:$|\s)/
- && ($path = $1) =~ s/\"\"/\"/g;
-
- $path;
-}
-
-##
-## Communication methods
-##
-
-
-sub _dataconn {
- my $ftp = shift;
- my $data = undef;
- my $pkg = "Net::FTP::" . $ftp->type;
-
- eval "require " . $pkg;
-
- $pkg =~ s/ /_/g;
-
- delete ${*$ftp}{'net_ftp_dataconn'};
-
- if (defined ${*$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'
- );
- }
- elsif (defined ${*$ftp}{'net_ftp_listen'}) {
- $data = ${*$ftp}{'net_ftp_listen'}->accept($pkg);
- close(delete ${*$ftp}{'net_ftp_listen'});
- }
-
- if ($data) {
- ${*$data} = "";
- $data->timeout($ftp->timeout);
- ${*$ftp}{'net_ftp_dataconn'} = $data;
- ${*$data}{'net_ftp_cmd'} = $ftp;
- ${*$data}{'net_ftp_blksize'} = ${*$ftp}{'net_ftp_blksize'};
- }
-
- $data;
-}
-
-
-sub _list_cmd {
- my $ftp = shift;
- my $cmd = uc shift;
-
- delete ${*$ftp}{'net_ftp_port'};
- delete ${*$ftp}{'net_ftp_pasv'};
-
- my $data = $ftp->_data_cmd($cmd, @_);
-
- return
- unless (defined $data);
-
- require Net::FTP::A;
- bless $data, "Net::FTP::A"; # Force ASCII mode
-
- my $databuf = '';
- my $buf = '';
- my $blksize = ${*$ftp}{'net_ftp_blksize'};
-
- while ($data->read($databuf, $blksize)) {
- $buf .= $databuf;
- }
-
- my $list = [split(/\n/, $buf)];
-
- $data->close();
-
- if (trEBCDIC) {
- for (@$list) { $_ = $ftp->toebcdic($_) }
- }
-
- wantarray
- ? @{$list}
- : $list;
-}
-
-
-sub _data_cmd {
- my $ftp = shift;
- my $cmd = uc shift;
- my $ok = 1;
- my $where = delete ${*$ftp}{'net_ftp_rest'} || 0;
- my $arg;
-
- for $arg (@_) {
- croak("Bad argument '$arg'\n")
- if $arg =~ /[\r\n]/s;
- }
-
- if ( ${*$ftp}{'net_ftp_passive'}
- && !defined ${*$ftp}{'net_ftp_pasv'}
- && !defined ${*$ftp}{'net_ftp_port'})
- {
- my $data = undef;
-
- $ok = defined $ftp->pasv;
- $ok = $ftp->_REST($where)
- if $ok && $where;
-
- if ($ok) {
- $ftp->command($cmd, @_);
- $data = $ftp->_dataconn();
- $ok = CMD_INFO == $ftp->response();
- if ($ok) {
- $data->reading
- if $data && $cmd =~ /RETR|LIST|NLST/;
- return $data;
- }
- $data->_close
- if $data;
- }
- return undef;
- }
-
- $ok = $ftp->port
- unless (defined ${*$ftp}{'net_ftp_port'}
- || defined ${*$ftp}{'net_ftp_pasv'});
-
- $ok = $ftp->_REST($where)
- if $ok && $where;
-
- return undef
- unless $ok;
-
- $ftp->command($cmd, @_);
-
- return 1
- if (defined ${*$ftp}{'net_ftp_pasv'});
-
- $ok = CMD_INFO == $ftp->response();
-
- return $ok
- unless exists ${*$ftp}{'net_ftp_intern_port'};
-
- if ($ok) {
- my $data = $ftp->_dataconn();
-
- $data->reading
- if $data && $cmd =~ /RETR|LIST|NLST/;
-
- return $data;
- }
-
-
- close(delete ${*$ftp}{'net_ftp_listen'});
-
- return undef;
-}
-
-##
-## Over-ride methods (Net::Cmd)
-##
-
-
-sub debug_text { $_[2] =~ /^(pass|resp|acct)/i ? "$1 ....\n" : $_[2]; }
-
-
-sub command {
- my $ftp = shift;
-
- delete ${*$ftp}{'net_ftp_port'};
- $ftp->SUPER::command(@_);
-}
-
-
-sub response {
- my $ftp = shift;
- my $code = $ftp->SUPER::response();
-
- delete ${*$ftp}{'net_ftp_pasv'}
- if ($code != CMD_MORE && $code != CMD_INFO);
-
- $code;
-}
-
-
-sub parse_response {
- return ($1, $2 eq "-")
- if $_[1] =~ s/^(\d\d\d)([- ]?)//o;
-
- my $ftp = shift;
-
- # Darn MS FTP server is a load of CRAP !!!!
- return ()
- unless ${*$ftp}{'net_cmd_code'} + 0;
-
- (${*$ftp}{'net_cmd_code'}, 1);
-}
-
-##
-## Allow 2 servers to talk directly
-##
-
-
-sub pasv_xfer_unique {
- my ($sftp, $sfile, $dftp, $dfile) = @_;
- $sftp->pasv_xfer($sfile, $dftp, $dfile, 1);
-}
-
-
-sub pasv_xfer {
- my ($sftp, $sfile, $dftp, $dfile, $unique) = @_;
-
- ($dfile = $sfile) =~ s#.*/##
- unless (defined $dfile);
-
- my $port = $sftp->pasv
- or return undef;
-
- $dftp->port($port)
- or return undef;
-
- return undef
- unless ($unique ? $dftp->stou($dfile) : $dftp->stor($dfile));
-
- unless ($sftp->retr($sfile) && $sftp->response == CMD_INFO) {
- $sftp->retr($sfile);
- $dftp->abort;
- $dftp->response();
- return undef;
- }
-
- $dftp->pasv_wait($sftp);
-}
-
-
-sub pasv_wait {
- @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)';
-
- my ($ftp, $non_pasv) = @_;
- my ($file, $rin, $rout);
-
- vec($rin = '', fileno($ftp), 1) = 1;
- select($rout = $rin, undef, undef, undef);
-
- $ftp->response();
- $non_pasv->response();
-
- return undef
- unless $ftp->ok() && $non_pasv->ok();
-
- return $1
- if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/;
-
- return $1
- if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/;
-
- return 1;
-}
-
-
-sub feature {
- @_ == 2 or croak 'usage: $ftp->feature( NAME )';
- my ($ftp, $feat) = @_;
-
- my $feature = ${*$ftp}{net_ftp_feature} ||= do {
- my @feat;
-
- # Example response
- # 211-Features:
- # MDTM
- # REST STREAM
- # SIZE
- # 211 End
-
- @feat = map { /^\s+(.*\S)/ } $ftp->message
- if $ftp->_FEAT;
-
- \@feat;
- };
-
- return grep { /^\Q$feat\E\b/i } @$feature;
-}
-
-
-sub cmd { shift->command(@_)->response() }
-
-########################################
-#
-# RFC959 commands
-#
-
-
-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 }
-sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
-sub _DELE { shift->command("DELE", @_)->response() == CMD_OK }
-sub _CWD { shift->command("CWD", @_)->response() == CMD_OK }
-sub _PORT { shift->command("PORT", @_)->response() == CMD_OK }
-sub _RMD { shift->command("RMD", @_)->response() == CMD_OK }
-sub _MKD { shift->command("MKD", @_)->response() == CMD_OK }
-sub _PWD { shift->command("PWD", @_)->response() == CMD_OK }
-sub _TYPE { shift->command("TYPE", @_)->response() == CMD_OK }
-sub _RNTO { shift->command("RNTO", @_)->response() == CMD_OK }
-sub _RESP { shift->command("RESP", @_)->response() == CMD_OK }
-sub _MDTM { shift->command("MDTM", @_)->response() == CMD_OK }
-sub _SIZE { shift->command("SIZE", @_)->response() == CMD_OK }
-sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
-sub _STAT { shift->command("STAT", @_)->response() == CMD_OK }
-sub _FEAT { shift->command("FEAT", @_)->response() == CMD_OK }
-sub _APPE { shift->command("APPE", @_)->response() == CMD_INFO }
-sub _LIST { shift->command("LIST", @_)->response() == CMD_INFO }
-sub _NLST { shift->command("NLST", @_)->response() == CMD_INFO }
-sub _RETR { shift->command("RETR", @_)->response() == CMD_INFO }
-sub _STOR { shift->command("STOR", @_)->response() == CMD_INFO }
-sub _STOU { shift->command("STOU", @_)->response() == CMD_INFO }
-sub _RNFR { shift->command("RNFR", @_)->response() == CMD_MORE }
-sub _REST { shift->command("REST", @_)->response() == CMD_MORE }
-sub _PASS { shift->command("PASS", @_)->response() }
-sub _ACCT { shift->command("ACCT", @_)->response() }
-sub _AUTH { shift->command("AUTH", @_)->response() }
-
-
-sub _USER {
- my $ftp = shift;
- my $ok = $ftp->command("USER", @_)->response();
-
- # A certain brain dead firewall :-)
- $ok = $ftp->command("user", @_)->response()
- unless $ok == CMD_MORE or $ok == CMD_OK;
-
- $ok;
-}
-
-
-sub _SMNT { shift->unsupported(@_) }
-sub _MODE { shift->unsupported(@_) }
-sub _SYST { shift->unsupported(@_) }
-sub _STRU { shift->unsupported(@_) }
-sub _REIN { shift->unsupported(@_) }
-
-1;
-
-__END__
-
-=head1 NAME
-
-Net::FTP - FTP Client class
-
-=head1 SYNOPSIS
-
- use Net::FTP;
-
- $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
-
-C<Net::FTP> is a class implementing a simple FTP client in Perl as
-described in RFC959. It provides wrappers for a subset of the RFC959
-commands.
-
-=head1 OVERVIEW
-
-FTP stands for File Transfer Protocol. It is a way of transferring
-files between networked machines. The protocol defines a client
-(whose commands are provided by this module) and a server (not
-implemented in this module). Communication is always initiated by the
-client, and the server responds with a message and a status code (and
-sometimes with data).
-
-The FTP protocol allows files to be sent to or fetched from the
-server. Each transfer involves a B<local file> (on the client) and a
-B<remote file> (on the server). In this module, the same file name
-will be used for both local and remote if only one is specified. This
-means that transferring remote file C</path/to/file> will try to put
-that file in C</path/to/file> locally, unless you specify a local file
-name.
-
-The protocol also defines several standard B<translations> which the
-file can undergo during transfer. These are ASCII, EBCDIC, binary,
-and byte. ASCII is the default type, and indicates that the sender of
-files will translate the ends of lines to a standard representation
-which the receiver will then translate back into their local
-representation. EBCDIC indicates the file being transferred is in
-EBCDIC format. Binary (also known as image) format sends the data as
-a contiguous bit stream. Byte format transfers the data as bytes, the
-values of which remain the same regardless of differences in byte size
-between the two machines (in theory - in practice you should only use
-this if you really know what you're doing).
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new ([ HOST ] [, OPTIONS ])
-
-This is the constructor for a new Net::FTP object. C<HOST> is the
-name of the remote host to which an FTP connection is required.
-
-C<HOST> is optional. If C<HOST> is not given then it may instead be
-passed as the C<Host> option described below.
-
-C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
-Possible options are:
-
-B<Host> - FTP host to connect to. It may be a single scalar, as defined for
-the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
-an array with hosts to try in turn. The L</host> method will return the value
-which was used to connect to the host.
-
-
-B<Firewall> - The name of a machine which acts as an FTP firewall. This can be
-overridden by an environment variable C<FTP_FIREWALL>. 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 referred to
-as an ftp proxy.
-
-B<FirewallType> - The type of firewall running on the machine indicated by
-B<Firewall>. This can be overridden by an environment variable
-C<FTP_FIREWALL_TYPE>. For a list of permissible types, see the description of
-ftp_firewall_type in L<Net::Config>.
-
-B<BlockSize> - This is the block size that Net::FTP will use when doing
-transfers. (defaults to 10240)
-
-B<Port> - The port number to connect to on the remote machine for the
-FTP connection
-
-B<Timeout> - Set a timeout value (defaults to 120)
-
-B<Debug> - debug level (see the debug method in L<Net::Cmd>)
-
-B<Passive> - If set to a non-zero value then all data transfers will
-be done using passive mode. If set to zero then data transfers will be
-done using active mode. If the machine is connected to the Internet
-directly, both passive and active mode should work equally well.
-Behind most firewall and NAT configurations passive mode has a better
-chance of working. However, in some rare firewall configurations,
-active mode actually works when passive mode doesn't. Some really old
-FTP servers might not implement passive transfers. If not specified,
-then the transfer mode is set by the environment variable
-C<FTP_PASSIVE> or if that one is not set by the settings done by the
-F<libnetcfg> utility. If none of these apply then passive mode is
-used.
-
-B<Hash> - If given a reference to a file handle (e.g., C<\*STDERR>),
-print hash marks (#) on that filehandle every 1024 bytes. This
-simply invokes the C<hash()> method for you, so that hash marks
-are displayed for all transfers. You can, of course, call C<hash()>
-explicitly whenever you'd like.
-
-B<LocalAddr> - Local address to use for all socket connections, this
-argument will be passed to L<IO::Socket::INET>
-
-If the constructor fails undef will be returned and an error message will
-be in $@
-
-=back
-
-=head1 METHODS
-
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, failure will be returned as I<undef> or an
-empty list.
-
-=over 4
-
-=item login ([LOGIN [,PASSWORD [, ACCOUNT] ] ])
-
-Log into the remote FTP server with the given login information. If
-no arguments are given then the C<Net::FTP> uses the C<Net::Netrc>
-package to lookup the login information for the connected host.
-If no information is found then a login of I<anonymous> is used.
-If no password is given and the login is I<anonymous> then I<anonymous@>
-will be used for password.
-
-If the connection is via a firewall then the C<authorize> method will
-be called with no arguments.
-
-=item authorize ( [AUTH [, RESP]])
-
-This is a protocol used by some firewall ftp proxies. It is used
-to authorise the user to send data out. If both arguments are not specified
-then C<authorize> uses C<Net::Netrc> to do a lookup.
-
-=item site (ARGS)
-
-Send a SITE command to the remote server and wait for a response.
-
-Returns most significant digit of the response code.
-
-=item ascii
-
-Transfer file in ASCII. CRLF translation will be done if required
-
-=item binary
-
-Transfer file in binary mode. No transformation will be done.
-
-B<Hint>: 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 )
-
-Rename a file on the remote FTP server from C<OLDNAME> to C<NEWNAME>. This
-is done by sending the RNFR and RNTO commands.
-
-=item delete ( FILENAME )
-
-Send a request to the server to delete C<FILENAME>.
-
-=item cwd ( [ DIR ] )
-
-Attempt to change directory to the directory given in C<$dir>. If
-C<$dir> is C<"..">, the FTP C<CDUP> command is used to attempt to
-move up one directory. If no directory is given then an attempt is made
-to change the directory to the root directory.
-
-=item cdup ()
-
-Change directory to the parent of the current directory.
-
-=item pwd ()
-
-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 [, RECURSE ])
-
-Remove the directory with the name C<DIR>. If C<RECURSE> is I<true> then
-C<rmdir> will attempt to delete everything inside the directory.
-
-=item mkdir ( DIR [, RECURSE ])
-
-Create a new directory with the name C<DIR>. If C<RECURSE> is I<true> then
-C<mkdir> 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 transferred using the ALLO ftp command. Some storage
-systems use this to make intelligent decisions about how to store the file.
-The C<SIZE> argument represents the size of the file in bytes. The
-C<RECORD_SIZE> argument indicates a maximum 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 transferring data from a socket, named pipe, or other stream not
-associated with a normal file.
-
-=item ls ( [ DIR ] )
-
-Get a directory listing of C<DIR>, or the current directory.
-
-In an array context, returns a list of lines returned from the server. In
-a scalar context, returns a reference to a list.
-
-=item dir ( [ DIR ] )
-
-Get a directory listing of C<DIR>, or the current directory in long format.
-
-In an array context, returns a list of lines returned from the server. In
-a scalar context, returns a reference to a list.
-
-=item get ( REMOTE_FILE [, LOCAL_FILE [, WHERE]] )
-
-Get C<REMOTE_FILE> from the server and store locally. C<LOCAL_FILE> may be
-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<WHERE> is given then the first C<WHERE> bytes of the file will
-not be transferred, and the remaining bytes will be appended to
-the local file if it already exists.
-
-Returns C<LOCAL_FILE>, or the generated local file name if C<LOCAL_FILE>
-is not given. If an error was encountered undef is returned.
-
-=item put ( LOCAL_FILE [, REMOTE_FILE ] )
-
-Put a file on the remote server. C<LOCAL_FILE> may be a name or a filehandle.
-If C<LOCAL_FILE> is a filehandle then C<REMOTE_FILE> must be specified. If
-C<REMOTE_FILE> is not specified then the file will be stored in the current
-directory with the same leafname as C<LOCAL_FILE>.
-
-Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
-is not given.
-
-B<NOTE>: If for some reason the transfer does not complete and an error is
-returned then the contents that had been transferred will not be remove
-automatically.
-
-=item put_unique ( LOCAL_FILE [, REMOTE_FILE ] )
-
-Same as put but uses the C<STOU> command.
-
-Returns the name of the file on the server.
-
-=item append ( LOCAL_FILE [, REMOTE_FILE ] )
-
-Same as put but appends to the file on the remote server.
-
-Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
-is not given.
-
-=item unique_name ()
-
-Returns the name of the last file stored on the server using the
-C<STOU> command.
-
-=item mdtm ( FILE )
-
-Returns the I<modification time> of the given file
-
-=item size ( FILE )
-
-Returns the size in bytes for the given file as stored on the remote server.
-
-B<NOTE>: The size reported is the size of the stored file on the remote server.
-If the file is subsequently transferred from the server in ASCII mode
-and the remote server and local machine have different ideas about
-"End Of Line" then the size of file on the local machine after transfer
-may be different.
-
-=item supported ( CMD )
-
-Returns TRUE if the remote server supports the given command.
-
-=item hash ( [FILEHANDLE_GLOB_REF],[ BYTES_PER_HASH_MARK] )
-
-Called without parameters, or with the first argument false, hash marks
-are suppressed. If the first argument is true but not a reference to a
-file handle glob, then \*STDERR is used. The second argument is the number
-of bytes per hash mark printed, and defaults to 1024. In all cases the
-return value is a reference to an array of two: the filehandle glob reference
-and the bytes per hash mark.
-
-=item feature ( NAME )
-
-Determine if the server supports the specified feature. The return
-value is a list of lines the server responded with to describe the
-options that it supports for the given feature. If the feature is
-unsupported then the empty list is returned.
-
- if ($ftp->feature( 'MDTM' )) {
- # Do something
- }
-
- if (grep { /\bTLS\b/ } $ftp->feature('AUTH')) {
- # Server supports TLS
- }
-
-=back
-
-The following methods can return different results depending on
-how they are called. If the user explicitly calls either
-of the C<pasv> or C<port> methods then these methods will
-return a I<true> or I<false> value. If the user does not
-call either of these methods then the result will be a
-reference to a C<Net::FTP::dataconn> based object.
-
-=over 4
-
-=item nlst ( [ DIR ] )
-
-Send an C<NLST> command to the server, with an optional parameter.
-
-=item list ( [ DIR ] )
-
-Same as C<nlst> but using the C<LIST> command
-
-=item retr ( FILE )
-
-Begin the retrieval of a file called C<FILE> from the remote server.
-
-=item stor ( FILE )
-
-Tell the server that you wish to store a file. C<FILE> is the
-name of the new file that should be created.
-
-=item stou ( FILE )
-
-Same as C<stor> but using the C<STOU> command. The name of the unique
-file which was created on the server will be available via the C<unique_name>
-method after the data connection has been closed.
-
-=item appe ( FILE )
-
-Tell the server that we want to append some data to the end of a file
-called C<FILE>. If this file does not exist then create it.
-
-=back
-
-If for some reason you want to have complete control over the data connection,
-this includes generating it and calling the C<response> method when required,
-then the user can use these methods to do so.
-
-However calling these methods only affects the use of the methods above that
-can return a data connection. They have no effect on methods C<get>, C<put>,
-C<put_unique> and those that do not require data connections.
-
-=over 4
-
-=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, then a listen socket is created and the correct information
-sent to the server.
-
-=item pasv ()
-
-Tell the server to go into passive mode. Returns the text that represents the
-port on which the server is listening, this text is in a suitable form to
-sent to another ftp server using the C<port> method.
-
-=back
-
-The following methods can be used to transfer files between two remote
-servers, providing that these two servers can connect directly to each other.
-
-=over 4
-
-=item pasv_xfer ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
-
-This method will do a file transfer between two remote ftp servers. If
-C<DEST_FILE> is omitted then the leaf name of C<SRC_FILE> will be used.
-
-=item pasv_xfer_unique ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
-
-Like C<pasv_xfer> but the file is stored on the remote server using
-the STOU command.
-
-=item pasv_wait ( NON_PASV_SERVER )
-
-This method can be used to wait for a transfer to complete between a passive
-server and a non-passive server. The method should be called on the passive
-server with the C<Net::FTP> object for the non-passive server passed as an
-argument.
-
-=item abort ()
-
-Abort the current data transfer.
-
-=item quit ()
-
-Send the QUIT command to the remote FTP server and close the socket connection.
-
-=back
-
-=head2 Methods for the adventurous
-
-C<Net::FTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
-be used to send commands to the remote FTP server.
-
-=over 4
-
-=item quot (CMD [,ARGS])
-
-Send a command, that Net::FTP does not directly support, to the remote
-server and wait for a response.
-
-Returns most significant digit of the response code.
-
-B<WARNING> This call should only be used on commands that do not require
-data connections. Misuse of this method can hang the connection.
-
-=back
-
-=head1 THE dataconn CLASS
-
-Some of the methods defined in C<Net::FTP> return an object which will
-be derived from this class.The dataconn class itself is derived from
-the C<IO::Socket::INET> class, so any normal IO operations can be performed.
-However the following methods are defined in the dataconn class and IO should
-be performed using these.
-
-=over 4
-
-=item read ( BUFFER, SIZE [, TIMEOUT ] )
-
-Read C<SIZE> bytes of data from the server and place it into C<BUFFER>, also
-performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
-given, the timeout value from the command connection will be used.
-
-Returns the number of bytes read before any <CRLF> translation.
-
-=item write ( BUFFER, SIZE [, TIMEOUT ] )
-
-Write C<SIZE> bytes of data from C<BUFFER> to the server, also
-performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
-given, the timeout value from the command connection will be used.
-
-Returns the number of bytes written before any <CRLF> translation.
-
-=item bytes_read ()
-
-Returns the number of bytes read so far.
-
-=item abort ()
-
-Abort the current data transfer.
-
-=item close ()
-
-Close the data connection and get a response from the FTP server. Returns
-I<true> if the connection was closed successfully and the first digit of
-the response from the server was a '2'.
-
-=back
-
-=head1 UNIMPLEMENTED
-
-The following RFC959 commands have not been implemented:
-
-=over 4
-
-=item B<SMNT>
-
-Mount a different file system structure without changing login or
-accounting information.
-
-=item B<HELP>
-
-Ask the server for "helpful information" (that's what the RFC says) on
-the commands it accepts.
-
-=item B<MODE>
-
-Specifies transfer mode (stream, block or compressed) for file to be
-transferred.
-
-=item B<SYST>
-
-Request remote server system identification.
-
-=item B<STAT>
-
-Request remote server status.
-
-=item B<STRU>
-
-Specifies file structure for file to be transferred.
-
-=item B<REIN>
-
-Reinitialize the connection, flushing all I/O and account information.
-
-=back
-
-=head1 REPORTING BUGS
-
-When reporting bugs/problems please include as much information as possible.
-It may be difficult for me to reproduce the problem as almost every setup
-is different.
-
-A small script which yields the problem will probably be of help. It would
-also be useful if this script was run with the extra options C<Debug => 1>
-passed to the constructor, and the output sent with the bug report. If you
-cannot include a small script then please include a Debug trace from a
-run of your program which does yield the problem.
-
-=head1 AUTHOR
-
-Graham Barr <gbarr@pobox.com>
-
-=head1 SEE ALSO
-
-L<Net::Netrc>
-L<Net::Cmd>
-
-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/
-
-C<autoftp> is a program that can retrieve, send, or list files via
-the FTP protocol in a non-interactive manner.
-
-=back
-
-=head1 CREDITS
-
-Henry Gabryjelski <henryg@WPI.EDU> - for the suggestion of creating directories
-recursively.
-
-Nathan Torkington <gnat@frii.com> - for some input on the documentation.
-
-Roderick Schertler <roderick@gate.net> - for various inputs
-
-=head1 COPYRIGHT
-
-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.
-
-=cut
diff --git a/lib/Net/FTP/A.pm b/lib/Net/FTP/A.pm
deleted file mode 100644
index 427d02b19e..0000000000
--- a/lib/Net/FTP/A.pm
+++ /dev/null
@@ -1,111 +0,0 @@
-##
-## Package to read/write on ASCII data connections
-##
-
-package Net::FTP::A;
-use strict;
-use vars qw(@ISA $buf $VERSION);
-use Carp;
-
-require Net::FTP::dataconn;
-
-@ISA = qw(Net::FTP::dataconn);
-$VERSION = "1.18";
-
-
-sub read {
- my $data = shift;
- local *buf = \$_[0];
- shift;
- my $size = shift || croak 'read($buf,$size,[$offset])';
- my $timeout = @_ ? shift: $data->timeout;
-
- if (length(${*$data}) < $size && !${*$data}{'net_ftp_eof'}) {
- my $blksize = ${*$data}{'net_ftp_blksize'};
- $blksize = $size if $size > $blksize;
-
- my $l = 0;
- my $n;
-
- READ:
- {
- my $readbuf = defined(${*$data}{'net_ftp_cr'}) ? "\015" : '';
-
- $data->can_read($timeout)
- or croak "Timeout";
-
- if ($n = sysread($data, $readbuf, $blksize, length $readbuf)) {
- ${*$data}{'net_ftp_bytesread'} += $n;
- ${*$data}{'net_ftp_cr'} =
- substr($readbuf, -1) eq "\015"
- ? chop($readbuf)
- : undef;
- }
- else {
- return undef
- unless defined $n;
-
- ${*$data}{'net_ftp_eof'} = 1;
- }
-
- $readbuf =~ s/\015\012/\n/sgo;
- ${*$data} .= $readbuf;
-
- unless (length(${*$data})) {
-
- redo READ
- if ($n > 0);
-
- $size = length(${*$data})
- if ($n == 0);
- }
- }
- }
-
- $buf = substr(${*$data}, 0, $size);
- substr(${*$data}, 0, $size) = '';
-
- length $buf;
-}
-
-
-sub write {
- my $data = shift;
- local *buf = \$_[0];
- shift;
- my $size = shift || croak 'write($buf,$size,[$timeout])';
- my $timeout = @_ ? shift: $data->timeout;
-
- my $nr = (my $tmp = substr($buf, 0, $size)) =~ tr/\r\n/\015\012/;
- $tmp =~ s/([^\015])\012/$1\015\012/sg if $nr;
- $tmp =~ s/^\012/\015\012/ unless ${*$data}{'net_ftp_outcr'};
- ${*$data}{'net_ftp_outcr'} = substr($tmp, -1) eq "\015";
-
- # 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'
- unless ($SIG{PIPE} || '') eq 'IGNORE'
- or $^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 > $blksize ? $blksize : $len);
- return undef
- unless defined($wrote);
- $len -= $wrote;
- }
-
- $size;
-}
-
-1;
diff --git a/lib/Net/FTP/E.pm b/lib/Net/FTP/E.pm
deleted file mode 100644
index d480cd7295..0000000000
--- a/lib/Net/FTP/E.pm
+++ /dev/null
@@ -1,8 +0,0 @@
-package Net::FTP::E;
-
-require Net::FTP::I;
-
-@ISA = qw(Net::FTP::I);
-$VERSION = "0.01";
-
-1;
diff --git a/lib/Net/FTP/I.pm b/lib/Net/FTP/I.pm
deleted file mode 100644
index 449bb99eab..0000000000
--- a/lib/Net/FTP/I.pm
+++ /dev/null
@@ -1,80 +0,0 @@
-##
-## Package to read/write on BINARY data connections
-##
-
-package Net::FTP::I;
-
-use vars qw(@ISA $buf $VERSION);
-use Carp;
-
-require Net::FTP::dataconn;
-
-@ISA = qw(Net::FTP::dataconn);
-$VERSION = "1.12";
-
-
-sub read {
- my $data = shift;
- local *buf = \$_[0];
- shift;
- my $size = shift || croak 'read($buf,$size,[$timeout])';
- my $timeout = @_ ? shift: $data->timeout;
-
- my $n;
-
- if ($size > length ${*$data} and !${*$data}{'net_ftp_eof'}) {
- $data->can_read($timeout)
- or croak "Timeout";
-
- my $blksize = ${*$data}{'net_ftp_blksize'};
- $blksize = $size if $size > $blksize;
-
- unless ($n = sysread($data, ${*$data}, $blksize, length ${*$data})) {
- return undef unless defined $n;
- ${*$data}{'net_ftp_eof'} = 1;
- }
- }
-
- $buf = substr(${*$data}, 0, $size);
-
- $n = length($buf);
-
- substr(${*$data}, 0, $n) = '';
-
- ${*$data}{'net_ftp_bytesread'} += $n;
-
- $n;
-}
-
-
-sub write {
- my $data = shift;
- local *buf = \$_[0];
- shift;
- my $size = shift || croak 'write($buf,$size,[$timeout])';
- my $timeout = @_ ? shift: $data->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'
- unless ($SIG{PIPE} || '') eq 'IGNORE'
- or $^O eq 'MacOS';
- my $sent = $size;
- my $off = 0;
-
- my $blksize = ${*$data}{'net_ftp_blksize'};
- while ($sent > 0) {
- $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;
- }
-
- $size;
-}
-
-1;
diff --git a/lib/Net/FTP/L.pm b/lib/Net/FTP/L.pm
deleted file mode 100644
index f7423cb9f9..0000000000
--- a/lib/Net/FTP/L.pm
+++ /dev/null
@@ -1,8 +0,0 @@
-package Net::FTP::L;
-
-require Net::FTP::I;
-
-@ISA = qw(Net::FTP::I);
-$VERSION = "0.01";
-
-1;
diff --git a/lib/Net/FTP/dataconn.pm b/lib/Net/FTP/dataconn.pm
deleted file mode 100644
index e7645cbd93..0000000000
--- a/lib/Net/FTP/dataconn.pm
+++ /dev/null
@@ -1,124 +0,0 @@
-##
-## Generic data connection package
-##
-
-package Net::FTP::dataconn;
-
-use Carp;
-use vars qw(@ISA $timeout $VERSION);
-use Net::Cmd;
-use Errno;
-
-$VERSION = '0.11';
-@ISA = qw(IO::Socket::INET);
-
-
-sub reading {
- my $data = shift;
- ${*$data}{'net_ftp_bytesread'} = 0;
-}
-
-
-sub abort {
- my $data = shift;
- my $ftp = ${*$data}{'net_ftp_cmd'};
-
- # no need to abort if we have finished the xfer
- return $data->close
- if ${*$data}{'net_ftp_eof'};
-
- # for some reason if we continously open RETR connections and not
- # read a single byte, then abort them after a while the server will
- # close our connection, this prevents the unexpected EOF on the
- # command channel -- GMB
- if (exists ${*$data}{'net_ftp_bytesread'}
- && (${*$data}{'net_ftp_bytesread'} == 0))
- {
- my $buf = "";
- my $timeout = $data->timeout;
- $data->can_read($timeout) && sysread($data, $buf, 1);
- }
-
- ${*$data}{'net_ftp_eof'} = 1; # fake
-
- $ftp->abort; # this will close me
-}
-
-
-sub _close {
- my $data = shift;
- my $ftp = ${*$data}{'net_ftp_cmd'};
-
- $data->SUPER::close();
-
- delete ${*$ftp}{'net_ftp_dataconn'}
- if exists ${*$ftp}{'net_ftp_dataconn'}
- && $data == ${*$ftp}{'net_ftp_dataconn'};
-}
-
-
-sub close {
- my $data = shift;
- my $ftp = ${*$data}{'net_ftp_cmd'};
-
- if (exists ${*$data}{'net_ftp_bytesread'} && !${*$data}{'net_ftp_eof'}) {
- my $junk;
- $data->read($junk, 1, 0);
- return $data->abort unless ${*$data}{'net_ftp_eof'};
- }
-
- $data->_close;
-
- $ftp->response() == CMD_OK
- && $ftp->message =~ /unique file name:\s*(\S*)\s*\)/
- && (${*$ftp}{'net_ftp_unique'} = $1);
-
- $ftp->status == CMD_OK;
-}
-
-
-sub _select {
- my ($data, $timeout, $do_read) = @_;
- my ($rin, $rout, $win, $wout, $tout, $nfound);
-
- vec($rin = '', fileno($data), 1) = 1;
-
- ($win, $rin) = ($rin, $win) unless $do_read;
-
- while (1) {
- $nfound = select($rout = $rin, $wout = $win, undef, $tout = $timeout);
-
- last if $nfound >= 0;
-
- croak "select: $!"
- unless $!{EINTR};
- }
-
- $nfound;
-}
-
-
-sub can_read {
- _select(@_[0, 1], 1);
-}
-
-
-sub can_write {
- _select(@_[0, 1], 0);
-}
-
-
-sub cmd {
- my $ftp = shift;
-
- ${*$ftp}{'net_ftp_cmd'};
-}
-
-
-sub bytes_read {
- my $ftp = shift;
-
- ${*$ftp}{'net_ftp_bytesread'} || 0;
-}
-
-1;
diff --git a/lib/Net/Hostname.pm.eg b/lib/Net/Hostname.pm.eg
deleted file mode 100644
index 4736c1a6ef..0000000000
--- a/lib/Net/Hostname.pm.eg
+++ /dev/null
@@ -1,14 +0,0 @@
-#
-
-package Sys::Hostname;
-
-use Net::Domain qw(hostname);
-use Carp;
-
-require Exporter;
-@ISA = qw(Exporter);
-@EXPORT = qw(hostname);
-
-carp "deprecated package 'Sys::Hostname', use Net::Domain" if $^W;
-
-1;
diff --git a/lib/Net/NNTP.pm b/lib/Net/NNTP.pm
deleted file mode 100644
index a742aed04c..0000000000
--- a/lib/Net/NNTP.pm
+++ /dev/null
@@ -1,1140 +0,0 @@
-# Net::NNTP.pm
-#
-# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. 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::NNTP;
-
-use strict;
-use vars qw(@ISA $VERSION $debug);
-use IO::Socket;
-use Net::Cmd;
-use Carp;
-use Time::Local;
-use Net::Config;
-
-$VERSION = "2.24";
-@ISA = qw(Net::Cmd IO::Socket::INET);
-
-
-sub new {
- my $self = shift;
- my $type = ref($self) || $self;
- my ($host, %arg);
- if (@_ % 2) {
- $host = shift;
- %arg = @_;
- }
- else {
- %arg = @_;
- $host = delete $arg{Host};
- }
- my $obj;
-
- $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST};
-
- my $hosts = defined $host ? [$host] : $NetConfig{nntp_hosts};
-
- @{$hosts} = qw(news)
- unless @{$hosts};
-
- my $h;
- foreach $h (@{$hosts}) {
- $obj = $type->SUPER::new(
- PeerAddr => ($host = $h),
- PeerPort => $arg{Port} || 'nntp(119)',
- Proto => 'tcp',
- Timeout => defined $arg{Timeout}
- ? $arg{Timeout}
- : 120
- )
- and last;
- }
-
- return undef
- unless defined $obj;
-
- ${*$obj}{'net_nntp_host'} = $host;
-
- $obj->autoflush(1);
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-
- unless ($obj->response() == CMD_OK) {
- $obj->close;
- return undef;
- }
-
- 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
- if ($obj->reader) {
-
- # If reader suceeds the we need to consider this code to determine postok
- $c = $obj->code;
- }
- else {
-
- # I want to ignore this failure, so restore the previous status.
- $obj->set_status($c, \@m);
- }
- }
-
- ${*$obj}{'net_nntp_post'} = $c == 200 ? 1 : 0;
-
- $obj;
-}
-
-
-sub host {
- my $me = shift;
- ${*$me}{'net_nntp_host'};
-}
-
-
-sub debug_text {
- my $nntp = shift;
- my $inout = shift;
- my $text = shift;
-
- if ( (ref($nntp) and $nntp->code == 350 and $text =~ /^(\S+)/)
- || ($text =~ /^(authinfo\s+pass)/io))
- {
- $text = "$1 ....\n";
- }
-
- $text;
-}
-
-
-sub postok {
- @_ == 1 or croak 'usage: $nntp->postok()';
- my $nntp = shift;
- ${*$nntp}{'net_nntp_post'} || 0;
-}
-
-
-sub article {
- @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->article( [ MSGID ], [ FH ] )';
- my $nntp = shift;
- my @fh;
-
- @fh = (pop) if @_ == 2 || (@_ && (ref($_[0]) || ref(\$_[0]) eq 'GLOB'));
-
- $nntp->_ARTICLE(@_)
- ? $nntp->read_until_dot(@fh)
- : undef;
-}
-
-
-sub articlefh {
- @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->articlefh( [ MSGID ] )';
- my $nntp = shift;
-
- return unless $nntp->_ARTICLE(@_);
- return $nntp->tied_fh;
-}
-
-
-sub authinfo {
- @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
- my ($nntp, $user, $pass) = @_;
-
- $nntp->_AUTHINFO("USER", $user) == CMD_MORE
- && $nntp->_AUTHINFO("PASS", $pass) == CMD_OK;
-}
-
-
-sub authinfo_simple {
- @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
- my ($nntp, $user, $pass) = @_;
-
- $nntp->_AUTHINFO('SIMPLE') == CMD_MORE
- && $nntp->command($user, $pass)->response == CMD_OK;
-}
-
-
-sub body {
- @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->body( [ MSGID ], [ FH ] )';
- my $nntp = shift;
- my @fh;
-
- @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
-
- $nntp->_BODY(@_)
- ? $nntp->read_until_dot(@fh)
- : undef;
-}
-
-
-sub bodyfh {
- @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->bodyfh( [ MSGID ] )';
- my $nntp = shift;
- return unless $nntp->_BODY(@_);
- return $nntp->tied_fh;
-}
-
-
-sub head {
- @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head( [ MSGID ], [ FH ] )';
- my $nntp = shift;
- my @fh;
-
- @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
-
- $nntp->_HEAD(@_)
- ? $nntp->read_until_dot(@fh)
- : undef;
-}
-
-
-sub headfh {
- @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->headfh( [ MSGID ] )';
- my $nntp = shift;
- return unless $nntp->_HEAD(@_);
- return $nntp->tied_fh;
-}
-
-
-sub nntpstat {
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )';
- my $nntp = shift;
-
- $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o
- ? $1
- : undef;
-}
-
-
-sub group {
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )';
- my $nntp = shift;
- my $grp = ${*$nntp}{'net_nntp_group'} || undef;
-
- return $grp
- unless (@_ || wantarray);
-
- my $newgrp = shift;
-
- return wantarray ? () : undef
- unless $nntp->_GROUP($newgrp || $grp || "")
- && $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/;
-
- my ($count, $first, $last, $group) = ($1, $2, $3, $4);
-
- # group may be replied as '(current group)'
- $group = ${*$nntp}{'net_nntp_group'}
- if $group =~ /\(/;
-
- ${*$nntp}{'net_nntp_group'} = $group;
-
- wantarray
- ? ($count, $first, $last, $group)
- : $group;
-}
-
-
-sub help {
- @_ == 1 or croak 'usage: $nntp->help()';
- my $nntp = shift;
-
- $nntp->_HELP
- ? $nntp->read_until_dot
- : undef;
-}
-
-
-sub ihave {
- @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])';
- my $nntp = shift;
- my $mid = shift;
-
- $nntp->_IHAVE($mid) && $nntp->datasend(@_)
- ? @_ == 0 || $nntp->dataend
- : undef;
-}
-
-
-sub last {
- @_ == 1 or croak 'usage: $nntp->last()';
- my $nntp = shift;
-
- $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o
- ? $1
- : undef;
-}
-
-
-sub list {
- @_ == 1 or croak 'usage: $nntp->list()';
- my $nntp = shift;
-
- $nntp->_LIST
- ? $nntp->_grouplist
- : undef;
-}
-
-
-sub newgroups {
- @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])';
- my $nntp = shift;
- my $time = _timestr(shift);
- my $dist = shift || "";
-
- $dist = join(",", @{$dist})
- if ref($dist);
-
- $nntp->_NEWGROUPS($time, $dist)
- ? $nntp->_grouplist
- : undef;
-}
-
-
-sub newnews {
- @_ >= 2 && @_ <= 4
- or croak 'usage: $nntp->newnews( SINCE [, GROUPS [, DISTRIBUTIONS ]])';
- my $nntp = shift;
- my $time = _timestr(shift);
- my $grp = @_ ? shift: $nntp->group;
- my $dist = shift || "";
-
- $grp ||= "*";
- $grp = join(",", @{$grp})
- if ref($grp);
-
- $dist = join(",", @{$dist})
- if ref($dist);
-
- $nntp->_NEWNEWS($grp, $time, $dist)
- ? $nntp->_articlelist
- : undef;
-}
-
-
-sub next {
- @_ == 1 or croak 'usage: $nntp->next()';
- my $nntp = shift;
-
- $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o
- ? $1
- : undef;
-}
-
-
-sub post {
- @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )';
- my $nntp = shift;
-
- $nntp->_POST() && $nntp->datasend(@_)
- ? @_ == 0 || $nntp->dataend
- : undef;
-}
-
-
-sub postfh {
- my $nntp = shift;
- return unless $nntp->_POST();
- return $nntp->tied_fh;
-}
-
-
-sub quit {
- @_ == 1 or croak 'usage: $nntp->quit()';
- my $nntp = shift;
-
- $nntp->_QUIT;
- $nntp->close;
-}
-
-
-sub slave {
- @_ == 1 or croak 'usage: $nntp->slave()';
- my $nntp = shift;
-
- $nntp->_SLAVE;
-}
-
-##
-## The following methods are not implemented by all servers
-##
-
-
-sub active {
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )';
- my $nntp = shift;
-
- $nntp->_LIST('ACTIVE', @_)
- ? $nntp->_grouplist
- : undef;
-}
-
-
-sub active_times {
- @_ == 1 or croak 'usage: $nntp->active_times()';
- my $nntp = shift;
-
- $nntp->_LIST('ACTIVE.TIMES')
- ? $nntp->_grouplist
- : undef;
-}
-
-
-sub distributions {
- @_ == 1 or croak 'usage: $nntp->distributions()';
- my $nntp = shift;
-
- $nntp->_LIST('DISTRIBUTIONS')
- ? $nntp->_description
- : undef;
-}
-
-
-sub distribution_patterns {
- @_ == 1 or croak 'usage: $nntp->distributions()';
- my $nntp = shift;
-
- my $arr;
- local $_;
-
- $nntp->_LIST('DISTRIB.PATS')
- && ($arr = $nntp->read_until_dot)
- ? [grep { /^\d/ && (chomp, $_ = [split /:/]) } @$arr]
- : undef;
-}
-
-
-sub newsgroups {
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )';
- my $nntp = shift;
-
- $nntp->_LIST('NEWSGROUPS', @_)
- ? $nntp->_description
- : undef;
-}
-
-
-sub overview_fmt {
- @_ == 1 or croak 'usage: $nntp->overview_fmt()';
- my $nntp = shift;
-
- $nntp->_LIST('OVERVIEW.FMT')
- ? $nntp->_articlelist
- : undef;
-}
-
-
-sub subscriptions {
- @_ == 1 or croak 'usage: $nntp->subscriptions()';
- my $nntp = shift;
-
- $nntp->_LIST('SUBSCRIPTIONS')
- ? $nntp->_articlelist
- : undef;
-}
-
-
-sub listgroup {
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )';
- my $nntp = shift;
-
- $nntp->_LISTGROUP(@_)
- ? $nntp->_articlelist
- : undef;
-}
-
-
-sub reader {
- @_ == 1 or croak 'usage: $nntp->reader()';
- my $nntp = shift;
-
- $nntp->_MODE('READER');
-}
-
-
-sub xgtitle {
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )';
- my $nntp = shift;
-
- $nntp->_XGTITLE(@_)
- ? $nntp->_description
- : undef;
-}
-
-
-sub xhdr {
- @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-SPEC ] )';
- my $nntp = shift;
- my $hdr = shift;
- my $arg = _msg_arg(@_);
-
- $nntp->_XHDR($hdr, $arg)
- ? $nntp->_description
- : undef;
-}
-
-
-sub xover {
- @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( MESSAGE-SPEC )';
- my $nntp = shift;
- my $arg = _msg_arg(@_);
-
- $nntp->_XOVER($arg)
- ? $nntp->_fieldlist
- : undef;
-}
-
-
-sub xpat {
- @_ == 4 || @_ == 5 or croak '$nntp->xpat( HEADER, PATTERN, MESSAGE-SPEC )';
- my $nntp = shift;
- my $hdr = shift;
- my $pat = shift;
- my $arg = _msg_arg(@_);
-
- $pat = join(" ", @$pat)
- if ref($pat);
-
- $nntp->_XPAT($hdr, $arg, $pat)
- ? $nntp->_description
- : undef;
-}
-
-
-sub xpath {
- @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )';
- my ($nntp, $mid) = @_;
-
- return undef
- unless $nntp->_XPATH($mid);
-
- my $m;
- ($m = $nntp->message) =~ s/^\d+\s+//o;
- my @p = split /\s+/, $m;
-
- wantarray ? @p : $p[0];
-}
-
-
-sub xrover {
- @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( MESSAGE-SPEC )';
- my $nntp = shift;
- my $arg = _msg_arg(@_);
-
- $nntp->_XROVER($arg)
- ? $nntp->_description
- : undef;
-}
-
-
-sub date {
- @_ == 1 or croak 'usage: $nntp->date()';
- my $nntp = shift;
-
- $nntp->_DATE
- && $nntp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
- ? timegm($6, $5, $4, $3, $2 - 1, $1 - 1900)
- : undef;
-}
-
-
-##
-## Private subroutines
-##
-
-
-sub _msg_arg {
- my $spec = shift;
- my $arg = "";
-
- if (@_) {
- carp "Depriciated passing of two message numbers, " . "pass a reference"
- if $^W;
- $spec = [$spec, $_[0]];
- }
-
- if (defined $spec) {
- if (ref($spec)) {
- $arg = $spec->[0];
- if (defined $spec->[1]) {
- $arg .= "-"
- if $spec->[1] != $spec->[0];
- $arg .= $spec->[1]
- if $spec->[1] > $spec->[0];
- }
- }
- else {
- $arg = $spec;
- }
- }
-
- $arg;
-}
-
-
-sub _timestr {
- my $time = shift;
- my @g = reverse((gmtime($time))[0 .. 5]);
- $g[1] += 1;
- $g[0] %= 100;
- sprintf "%02d%02d%02d %02d%02d%02d GMT", @g;
-}
-
-
-sub _grouplist {
- my $nntp = shift;
- my $arr = $nntp->read_until_dot
- or return undef;
-
- my $hash = {};
- my $ln;
-
- foreach $ln (@$arr) {
- my @a = split(/[\s\n]+/, $ln);
- $hash->{$a[0]} = [@a[1, 2, 3]];
- }
-
- $hash;
-}
-
-
-sub _fieldlist {
- my $nntp = shift;
- my $arr = $nntp->read_until_dot
- or return undef;
-
- my $hash = {};
- my $ln;
-
- foreach $ln (@$arr) {
- my @a = split(/[\t\n]/, $ln);
- my $m = shift @a;
- $hash->{$m} = [@a];
- }
-
- $hash;
-}
-
-
-sub _articlelist {
- my $nntp = shift;
- my $arr = $nntp->read_until_dot;
-
- chomp(@$arr)
- if $arr;
-
- $arr;
-}
-
-
-sub _description {
- my $nntp = shift;
- my $arr = $nntp->read_until_dot
- or return undef;
-
- my $hash = {};
- my $ln;
-
- foreach $ln (@$arr) {
- chomp($ln);
-
- $hash->{$1} = $ln
- if $ln =~ s/^\s*(\S+)\s*//o;
- }
-
- $hash;
-
-}
-
-##
-## The commands
-##
-
-
-sub _ARTICLE { shift->command('ARTICLE', @_)->response == CMD_OK }
-sub _AUTHINFO { shift->command('AUTHINFO', @_)->response }
-sub _BODY { shift->command('BODY', @_)->response == CMD_OK }
-sub _DATE { shift->command('DATE')->response == CMD_INFO }
-sub _GROUP { shift->command('GROUP', @_)->response == CMD_OK }
-sub _HEAD { shift->command('HEAD', @_)->response == CMD_OK }
-sub _HELP { shift->command('HELP', @_)->response == CMD_INFO }
-sub _IHAVE { shift->command('IHAVE', @_)->response == CMD_MORE }
-sub _LAST { shift->command('LAST')->response == CMD_OK }
-sub _LIST { shift->command('LIST', @_)->response == CMD_OK }
-sub _LISTGROUP { shift->command('LISTGROUP', @_)->response == CMD_OK }
-sub _NEWGROUPS { shift->command('NEWGROUPS', @_)->response == CMD_OK }
-sub _NEWNEWS { shift->command('NEWNEWS', @_)->response == CMD_OK }
-sub _NEXT { shift->command('NEXT')->response == CMD_OK }
-sub _POST { shift->command('POST', @_)->response == CMD_MORE }
-sub _QUIT { shift->command('QUIT', @_)->response == CMD_OK }
-sub _SLAVE { shift->command('SLAVE', @_)->response == CMD_OK }
-sub _STAT { shift->command('STAT', @_)->response == CMD_OK }
-sub _MODE { shift->command('MODE', @_)->response == CMD_OK }
-sub _XGTITLE { shift->command('XGTITLE', @_)->response == CMD_OK }
-sub _XHDR { shift->command('XHDR', @_)->response == CMD_OK }
-sub _XPAT { shift->command('XPAT', @_)->response == CMD_OK }
-sub _XPATH { shift->command('XPATH', @_)->response == CMD_OK }
-sub _XOVER { shift->command('XOVER', @_)->response == CMD_OK }
-sub _XROVER { shift->command('XROVER', @_)->response == CMD_OK }
-sub _XTHREAD { shift->unsupported }
-sub _XSEARCH { shift->unsupported }
-sub _XINDEX { shift->unsupported }
-
-##
-## IO/perl methods
-##
-
-
-sub DESTROY {
- my $nntp = shift;
- defined(fileno($nntp)) && $nntp->quit;
-}
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-Net::NNTP - NNTP Client class
-
-=head1 SYNOPSIS
-
- use Net::NNTP;
-
- $nntp = Net::NNTP->new("some.host.name");
- $nntp->quit;
-
-=head1 DESCRIPTION
-
-C<Net::NNTP> is a class implementing a simple NNTP client in Perl as described
-in RFC977. C<Net::NNTP> inherits its communication methods from C<Net::Cmd>
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new ( [ HOST ] [, OPTIONS ])
-
-This is the constructor for a new Net::NNTP object. C<HOST> is the
-name of the remote host to which a NNTP connection is required. If not
-given then it may be passed as the C<Host> option described below. If no host is passed
-then two environment variables are checked, first C<NNTPSERVER> then
-C<NEWSHOST>, then C<Net::Config> is checked, and if a host is not found
-then C<news> is used.
-
-C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
-Possible options are:
-
-B<Host> - NNTP host to connect to. It may be a single scalar, as defined for
-the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
-an array with hosts to try in turn. The L</host> method will return the value
-which was used to connect to the host.
-
-B<Timeout> - Maximum time, in seconds, to wait for a response from the
-NNTP server, a value of zero will cause all IO operations to block.
-(default: 120)
-
-B<Debug> - Enable the printing of debugging information to STDERR
-
-B<Reader> - If the remote server is INN then initially the connection
-will be to nnrpd, by default C<Net::NNTP> will issue a C<MODE READER> command
-so that the remote server becomes innd. If the C<Reader> option is given
-with a value of zero, then this command will not be sent and the
-connection will be left talking to nnrpd.
-
-=back
-
-=head1 METHODS
-
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, failure will be returned as I<undef> or an
-empty list.
-
-=over 4
-
-=item article ( [ MSGID|MSGNUM ], [FH] )
-
-Retrieve the header, a blank line, then the body (text) of the
-specified article.
-
-If C<FH> is specified then it is expected to be a valid filehandle
-and the result will be printed to it, on success a true value will be
-returned. If C<FH> is not specified then the return value, on success,
-will be a reference to an array containing the article requested, each
-entry in the array will contain one line of the article.
-
-If no arguments are passed then the current article in the currently
-selected newsgroup is fetched.
-
-C<MSGNUM> is a numeric id of an article in the current newsgroup, and
-will change the current article pointer. C<MSGID> is the message id of
-an article as shown in that article's header. It is anticipated that the
-client will obtain the C<MSGID> from a list provided by the C<newnews>
-command, from references contained within another article, or from the
-message-id provided in the response to some other commands.
-
-If there is an error then C<undef> will be returned.
-
-=item body ( [ MSGID|MSGNUM ], [FH] )
-
-Like C<article> but only fetches the body of the article.
-
-=item head ( [ MSGID|MSGNUM ], [FH] )
-
-Like C<article> but only fetches the headers for the article.
-
-=item articlefh ( [ MSGID|MSGNUM ] )
-
-=item bodyfh ( [ MSGID|MSGNUM ] )
-
-=item headfh ( [ MSGID|MSGNUM ] )
-
-These are similar to article(), body() and head(), but rather than
-returning the requested data directly, they return a tied filehandle
-from which to read the article.
-
-=item nntpstat ( [ MSGID|MSGNUM ] )
-
-The C<nntpstat> command is similar to the C<article> command except that no
-text is returned. When selecting by message number within a group,
-the C<nntpstat> command serves to set the "current article pointer" without
-sending text.
-
-Using the C<nntpstat> command to
-select by message-id is valid but of questionable value, since a
-selection by message-id does B<not> alter the "current article pointer".
-
-Returns the message-id of the "current article".
-
-=item group ( [ GROUP ] )
-
-Set and/or get the current group. If C<GROUP> is not given then information
-is returned on the current group.
-
-In a scalar context it returns the group name.
-
-In an array context the return value is a list containing, the number
-of articles in the group, the number of the first article, the number
-of the last article and the group name.
-
-=item ihave ( MSGID [, MESSAGE ])
-
-The C<ihave> command informs the server that the client has an article
-whose id is C<MSGID>. If the server desires a copy of that
-article, and C<MESSAGE> has been given the it will be sent.
-
-Returns I<true> if the server desires the article and C<MESSAGE> was
-successfully sent,if specified.
-
-If C<MESSAGE> is not specified then the message must be sent using the
-C<datasend> and C<dataend> methods from L<Net::Cmd>
-
-C<MESSAGE> can be either an array of lines or a reference to an array.
-
-=item last ()
-
-Set the "current article pointer" to the previous article in the current
-newsgroup.
-
-Returns the message-id of the article.
-
-=item date ()
-
-Returns the date on the remote server. This date will be in a UNIX time
-format (seconds since 1970)
-
-=item postok ()
-
-C<postok> will return I<true> if the servers initial response indicated
-that it will allow posting.
-
-=item authinfo ( USER, PASS )
-
-Authenticates to the server (using AUTHINFO USER / AUTHINFO PASS)
-using the supplied username and password. Please note that the
-password is sent in clear text to the server. This command should not
-be used with valuable passwords unless the connection to the server is
-somehow protected.
-
-=item list ()
-
-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 last article number in the group,
-the first article number in the group and any information flags about the group.
-
-=item newgroups ( SINCE [, DISTRIBUTIONS ])
-
-C<SINCE> is a time value and C<DISTRIBUTIONS> is either a distribution
-pattern or a reference to a list of distribution patterns.
-The result is the same as C<list>, but the
-groups return will be limited to those created after C<SINCE> and, if
-specified, in one of the distribution areas in C<DISTRIBUTIONS>.
-
-=item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]])
-
-C<SINCE> is a time value. C<GROUPS> is either a group pattern or a reference
-to a list of group patterns. C<DISTRIBUTIONS> is either a distribution
-pattern or a reference to a list of distribution patterns.
-
-Returns a reference to a list which contains the message-ids of all news posted
-after C<SINCE>, that are in a groups which matched C<GROUPS> and a
-distribution which matches C<DISTRIBUTIONS>.
-
-=item next ()
-
-Set the "current article pointer" to the next article in the current
-newsgroup.
-
-Returns the message-id of the article.
-
-=item post ( [ MESSAGE ] )
-
-Post a new article to the news server. If C<MESSAGE> is specified and posting
-is allowed then the message will be sent.
-
-If C<MESSAGE> is not specified then the message must be sent using the
-C<datasend> and C<dataend> methods from L<Net::Cmd>
-
-C<MESSAGE> can be either an array of lines or a reference to an array.
-
-The message, either sent via C<datasend> or as the C<MESSAGE>
-parameter, must be in the format as described by RFC822 and must
-contain From:, Newsgroups: and Subject: headers.
-
-=item postfh ()
-
-Post a new article to the news server using a tied filehandle. If
-posting is allowed, this method will return a tied filehandle that you
-can print() the contents of the article to be posted. You must
-explicitly close() the filehandle when you are finished posting the
-article, and the return value from the close() call will indicate
-whether the message was successfully posted.
-
-=item slave ()
-
-Tell the remote server that I am not a user client, but probably another
-news server.
-
-=item quit ()
-
-Quit the remote server and close the socket connection.
-
-=back
-
-=head2 Extension methods
-
-These methods use commands that are not part of the RFC977 documentation. Some
-servers may not support all of them.
-
-=over 4
-
-=item newsgroups ( [ PATTERN ] )
-
-Returns a reference to a hash where the keys are all the group names which
-match C<PATTERN>, or all of the groups if no pattern is specified, and
-each value contains the description text for the group.
-
-=item distributions ()
-
-Returns a reference to a hash where the keys are all the possible
-distribution names and the values are the distribution descriptions.
-
-=item subscriptions ()
-
-Returns a reference to a list which contains a list of groups which
-are recommended for a new user to subscribe to.
-
-=item overview_fmt ()
-
-Returns a reference to an array which contain the names of the fields returned
-by C<xover>.
-
-=item active_times ()
-
-Returns a reference to a hash where the keys are the group names and each
-value is a reference to an array containing the time the groups was created
-and an identifier, possibly an Email address, of the creator.
-
-=item active ( [ PATTERN ] )
-
-Similar to C<list> but only active groups that match the pattern are returned.
-C<PATTERN> can be a group pattern.
-
-=item xgtitle ( PATTERN )
-
-Returns a reference to a hash where the keys are all the group names which
-match C<PATTERN> and each value is the description text for the group.
-
-=item xhdr ( HEADER, MESSAGE-SPEC )
-
-Obtain the header field C<HEADER> for all the messages specified.
-
-The return value will be a reference
-to a hash where the keys are the message numbers and each value contains
-the text of the requested header for that message.
-
-=item xover ( MESSAGE-SPEC )
-
-The return value will be a reference
-to a hash where the keys are the message numbers and each value contains
-a reference to an array which contains the overview fields for that
-message.
-
-The names of the fields can be obtained by calling C<overview_fmt>.
-
-=item xpath ( MESSAGE-ID )
-
-Returns the path name to the file on the server which contains the specified
-message.
-
-=item xpat ( HEADER, PATTERN, MESSAGE-SPEC)
-
-The result is the same as C<xhdr> except the is will be restricted to
-headers where the text of the header matches C<PATTERN>
-
-=item xrover
-
-The XROVER command returns reference information for the article(s)
-specified.
-
-Returns a reference to a HASH where the keys are the message numbers and the
-values are the References: lines from the articles
-
-=item listgroup ( [ GROUP ] )
-
-Returns a reference to a list of all the active messages in C<GROUP>, or
-the current group if C<GROUP> is not specified.
-
-=item reader
-
-Tell the server that you are a reader and not another server.
-
-This is required by some servers. For example if you are connecting to
-an INN server and you have transfer permission your connection will
-be connected to the transfer daemon, not the NNTP daemon. Issuing
-this command will cause the transfer daemon to hand over control
-to the NNTP daemon.
-
-Some servers do not understand this command, but issuing it and ignoring
-the response is harmless.
-
-=back
-
-=head1 UNSUPPORTED
-
-The following NNTP command are unsupported by the package, and there are
-no plans to do so.
-
- AUTHINFO GENERIC
- XTHREAD
- XSEARCH
- XINDEX
-
-=head1 DEFINITIONS
-
-=over 4
-
-=item MESSAGE-SPEC
-
-C<MESSAGE-SPEC> is either a single message-id, a single message number, or
-a reference to a list of two message numbers.
-
-If C<MESSAGE-SPEC> is a reference to a list of two message numbers and the
-second number in a range is less than or equal to the first then the range
-represents all messages in the group after the first message number.
-
-B<NOTE> For compatibility reasons only with earlier versions of Net::NNTP
-a message spec can be passed as a list of two numbers, this is deprecated
-and a reference to the list should now be passed
-
-=item PATTERN
-
-The C<NNTP> protocol uses the C<WILDMAT> format for patterns.
-The WILDMAT format was first developed by Rich Salz based on
-the format used in the UNIX "find" command to articulate
-file names. It was developed to provide a uniform mechanism
-for matching patterns in the same manner that the UNIX shell
-matches filenames.
-
-Patterns are implicitly anchored at the
-beginning and end of each string when testing for a match.
-
-There are five pattern matching operations other than a strict
-one-to-one match between the pattern and the source to be
-checked for a match.
-
-The first is an asterisk C<*> to match any sequence of zero or more
-characters.
-
-The second is a question mark C<?> to match any single character. The
-third specifies a specific set of characters.
-
-The set is specified as a list of characters, or as a range of characters
-where the beginning and end of the range are separated by a minus (or dash)
-character, or as any combination of lists and ranges. The dash can
-also be included in the set as a character it if is the beginning
-or end of the set. This set is enclosed in square brackets. The
-close square bracket C<]> may be used in a set if it is the first
-character in the set.
-
-The fourth operation is the same as the
-logical not of the third operation and is specified the same
-way as the third with the addition of a caret character C<^> at
-the beginning of the test string just inside the open square
-bracket.
-
-The final operation uses the backslash character to
-invalidate the special meaning of an open square bracket C<[>,
-the asterisk, backslash or the question mark. Two backslashes in
-sequence will result in the evaluation of the backslash as a
-character with no special meaning.
-
-=over 4
-
-=item Examples
-
-=item C<[^]-]>
-
-matches any single character other than a close square
-bracket or a minus sign/dash.
-
-=item C<*bdc>
-
-matches any string that ends with the string "bdc"
-including the string "bdc" (without quotes).
-
-=item C<[0-9a-zA-Z]>
-
-matches any single printable alphanumeric ASCII character.
-
-=item C<a??d>
-
-matches any four character string which begins
-with a and ends with d.
-
-=back
-
-=back
-
-=head1 SEE ALSO
-
-L<Net::Cmd>
-
-=head1 AUTHOR
-
-Graham Barr <gbarr@pobox.com>
-
-=head1 COPYRIGHT
-
-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.
-
-=cut
diff --git a/lib/Net/Netrc.pm b/lib/Net/Netrc.pm
deleted file mode 100644
index 28c826b38c..0000000000
--- a/lib/Net/Netrc.pm
+++ /dev/null
@@ -1,325 +0,0 @@
-# Net::Netrc.pm
-#
-# Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. 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::Netrc;
-
-use Carp;
-use strict;
-use FileHandle;
-use vars qw($VERSION);
-
-$VERSION = "2.12";
-
-my %netrc = ();
-
-
-sub _readrc {
- my $host = shift;
- my ($home, $file);
-
- if ($^O eq "MacOS") {
- $home = $ENV{HOME} || `pwd`;
- chomp($home);
- $file = ($home =~ /:$/ ? $home . "netrc" : $home . ":netrc");
- }
- 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";
- }
-
- my ($login, $pass, $acct) = (undef, undef, undef);
- my $fh;
- local $_;
-
- $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'
- || $^O =~ /^cygwin/)
- {
- my @stat = stat($file);
-
- if (@stat) {
- if ($stat[2] & 077) {
- carp "Bad permissions: $file";
- return;
- }
- if ($stat[4] != $<) {
- carp "Not owner: $file";
- return;
- }
- }
- }
-
- if ($fh = FileHandle->new($file, "r")) {
- my ($mach, $macdef, $tok, @tok) = (0, 0);
-
- while (<$fh>) {
- undef $macdef if /\A\n\Z/;
-
- if ($macdef) {
- push(@$macdef, $_);
- next;
- }
-
- s/^\s*//;
- chomp;
-
- while (length && s/^("((?:[^"]+|\\.)*)"|((?:[^\\\s]+|\\.)*))\s*//) {
- (my $tok = $+) =~ s/\\(.)/$1/g;
- push(@tok, $tok);
- }
-
- TOKEN:
- while (@tok) {
- if ($tok[0] eq "default") {
- shift(@tok);
- $mach = bless {};
- $netrc{default} = [$mach];
-
- next TOKEN;
- }
-
- last TOKEN
- unless @tok > 1;
-
- $tok = shift(@tok);
-
- if ($tok eq "machine") {
- my $host = shift @tok;
- $mach = bless {machine => $host};
-
- $netrc{$host} = []
- unless exists($netrc{$host});
- push(@{$netrc{$host}}, $mach);
- }
- elsif ($tok =~ /^(login|password|account)$/) {
- next TOKEN unless $mach;
- my $value = shift @tok;
-
- # Following line added by rmerrell to remove '/' escape char in .netrc
- $value =~ s/\/\\/\\/g;
- $mach->{$1} = $value;
- }
- elsif ($tok eq "macdef") {
- next TOKEN unless $mach;
- my $value = shift @tok;
- $mach->{macdef} = {}
- unless exists $mach->{macdef};
- $macdef = $mach->{machdef}{$value} = [];
- }
- }
- }
- $fh->close();
- }
-}
-
-
-sub lookup {
- my ($pkg, $mach, $login) = @_;
-
- _readrc()
- unless exists $netrc{default};
-
- $mach ||= 'default';
- undef $login
- if $mach eq 'default';
-
- if (exists $netrc{$mach}) {
- if (defined $login) {
- my $m;
- foreach $m (@{$netrc{$mach}}) {
- return $m
- if (exists $m->{login} && $m->{login} eq $login);
- }
- return undef;
- }
- return $netrc{$mach}->[0];
- }
-
- return $netrc{default}->[0]
- if defined $netrc{default};
-
- return undef;
-}
-
-
-sub login {
- my $me = shift;
-
- exists $me->{login}
- ? $me->{login}
- : undef;
-}
-
-
-sub account {
- my $me = shift;
-
- exists $me->{account}
- ? $me->{account}
- : undef;
-}
-
-
-sub password {
- my $me = shift;
-
- exists $me->{password}
- ? $me->{password}
- : undef;
-}
-
-
-sub lpa {
- my $me = shift;
- ($me->login, $me->password, $me->account);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-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;
-
-=head1 DESCRIPTION
-
-C<Net::Netrc> is a class implementing a simple interface to the .netrc file
-used as by the ftp program.
-
-C<Net::Netrc> also implements security checks just like the ftp program,
-these checks are, first that the .netrc file must be owned by the user and
-second the ownership permissions should be such that only the owner has
-read and write access. If these conditions are not met then a warning is
-output and the .netrc file is not read.
-
-=head1 THE .netrc FILE
-
-The .netrc file contains login and initialization information used by the
-auto-login process. It resides in the user's home directory. The following
-tokens are recognized; they may be separated by spaces, tabs, or new-lines:
-
-=over 4
-
-=item machine name
-
-Identify a remote machine name. The auto-login process searches
-the .netrc file for a machine token that matches the remote machine
-specified. Once a match is made, the subsequent .netrc tokens
-are processed, stopping when the end of file is reached or an-
-other machine or a default token is encountered.
-
-=item default
-
-This is the same as machine name except that default matches
-any name. There can be only one default token, and it must be
-after all machine tokens. This is normally used as:
-
- default login anonymous password user@site
-
-thereby giving the user automatic anonymous login to machines
-not specified in .netrc.
-
-=item login name
-
-Identify a user on the remote machine. If this token is present,
-the auto-login process will initiate a login using the
-specified name.
-
-=item password string
-
-Supply a password. If this token is present, the auto-login
-process will supply the specified string if the remote server
-requires a password as part of the login process.
-
-=item account string
-
-Supply an additional account password. If this token is present,
-the auto-login process will supply the specified string
-if the remote server requires an additional account password.
-
-=item macdef name
-
-Define a macro. C<Net::Netrc> only parses this field to be compatible
-with I<ftp>.
-
-=back
-
-=head1 CONSTRUCTOR
-
-The constructor for a C<Net::Netrc> object is not called new as it does not
-really create a new object. But instead is called C<lookup> as this is
-essentially what it does.
-
-=over 4
-
-=item lookup ( MACHINE [, LOGIN ])
-
-Lookup and return a reference to the entry for C<MACHINE>. If C<LOGIN> is given
-then the entry returned will have the given login. If C<LOGIN> is not given then
-the first entry in the .netrc file for C<MACHINE> 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<undef> is returned.
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item login ()
-
-Return the login id for the netrc entry
-
-=item password ()
-
-Return the password for the netrc entry
-
-=item account ()
-
-Return the account information for the netrc entry
-
-=item lpa ()
-
-Return a list of login, password and account information fir the netrc entry
-
-=back
-
-=head1 AUTHOR
-
-Graham Barr <gbarr@pobox.com>
-
-=head1 SEE ALSO
-
-L<Net::Netrc>
-L<Net::Cmd>
-
-=head1 COPYRIGHT
-
-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.
-
-=cut
diff --git a/lib/Net/POP3.pm b/lib/Net/POP3.pm
deleted file mode 100644
index 8381c81815..0000000000
--- a/lib/Net/POP3.pm
+++ /dev/null
@@ -1,742 +0,0 @@
-# Net::POP3.pm
-#
-# Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. 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::POP3;
-
-use strict;
-use IO::Socket;
-use vars qw(@ISA $VERSION $debug);
-use Net::Cmd;
-use Carp;
-use Net::Config;
-
-$VERSION = "2.29";
-
-@ISA = qw(Net::Cmd IO::Socket::INET);
-
-
-sub new {
- my $self = shift;
- my $type = ref($self) || $self;
- my ($host, %arg);
- if (@_ % 2) {
- $host = shift;
- %arg = @_;
- }
- else {
- %arg = @_;
- $host = delete $arg{Host};
- }
- my $hosts = defined $host ? [$host] : $NetConfig{pop3_hosts};
- my $obj;
- my @localport = exists $arg{ResvPort} ? (LocalPort => $arg{ResvPort}) : ();
-
- my $h;
- foreach $h (@{$hosts}) {
- $obj = $type->SUPER::new(
- PeerAddr => ($host = $h),
- PeerPort => $arg{Port} || 'pop3(110)',
- Proto => 'tcp',
- @localport,
- Timeout => defined $arg{Timeout}
- ? $arg{Timeout}
- : 120
- )
- and last;
- }
-
- return undef
- unless defined $obj;
-
- ${*$obj}{'net_pop3_host'} = $host;
-
- $obj->autoflush(1);
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-
- unless ($obj->response() == CMD_OK) {
- $obj->close();
- return undef;
- }
-
- ${*$obj}{'net_pop3_banner'} = $obj->message;
-
- $obj;
-}
-
-
-sub host {
- my $me = shift;
- ${*$me}{'net_pop3_host'};
-}
-
-##
-## We don't want people sending me their passwords when they report problems
-## now do we :-)
-##
-
-
-sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; }
-
-
-sub login {
- @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )';
- my ($me, $user, $pass) = @_;
-
- if (@_ <= 2) {
- ($user, $pass) = $me->_lookup_credentials($user);
- }
-
- $me->user($user)
- and $me->pass($pass);
-}
-
-
-sub apop {
- @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
- my ($me, $user, $pass) = @_;
- my $banner;
- my $md;
-
- if (eval { local $SIG{__DIE__}; require Digest::MD5 }) {
- $md = Digest::MD5->new();
- }
- elsif (eval { local $SIG{__DIE__}; require MD5 }) {
- $md = MD5->new();
- }
- else {
- carp "You need to install Digest::MD5 or MD5 to use the APOP command";
- return undef;
- }
-
- return undef
- unless ($banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0]);
-
- if (@_ <= 2) {
- ($user, $pass) = $me->_lookup_credentials($user);
- }
-
- $md->add($banner, $pass);
-
- return undef
- unless ($me->_APOP($user, $md->hexdigest));
-
- $me->_get_mailbox_count();
-}
-
-
-sub user {
- @_ == 2 or croak 'usage: $pop3->user( USER )';
- $_[0]->_USER($_[1]) ? 1 : undef;
-}
-
-
-sub pass {
- @_ == 2 or croak 'usage: $pop3->pass( PASS )';
-
- my ($me, $pass) = @_;
-
- return undef
- unless ($me->_PASS($pass));
-
- $me->_get_mailbox_count();
-}
-
-
-sub reset {
- @_ == 1 or croak 'usage: $obj->reset()';
-
- my $me = shift;
-
- return 0
- unless ($me->_RSET);
-
- if (defined ${*$me}{'net_pop3_mail'}) {
- local $_;
- foreach (@{${*$me}{'net_pop3_mail'}}) {
- delete $_->{'net_pop3_deleted'};
- }
- }
-}
-
-
-sub last {
- @_ == 1 or croak 'usage: $obj->last()';
-
- return undef
- unless $_[0]->_LAST && $_[0]->message =~ /(\d+)/;
-
- return $1;
-}
-
-
-sub top {
- @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])';
- my $me = shift;
-
- return undef
- unless $me->_TOP($_[0], $_[1] || 0);
-
- $me->read_until_dot;
-}
-
-
-sub popstat {
- @_ == 1 or croak 'usage: $pop3->popstat()';
- my $me = shift;
-
- return ()
- unless $me->_STAT && $me->message =~ /(\d+)\D+(\d+)/;
-
- ($1 || 0, $2 || 0);
-}
-
-
-sub list {
- @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )';
- my $me = shift;
-
- return undef
- unless $me->_LIST(@_);
-
- if (@_) {
- $me->message =~ /\d+\D+(\d+)/;
- return $1 || undef;
- }
-
- my $info = $me->read_until_dot
- or return undef;
-
- my %hash = map { (/(\d+)\D+(\d+)/) } @$info;
-
- return \%hash;
-}
-
-
-sub get {
- @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])';
- my $me = shift;
-
- return undef
- unless $me->_RETR(shift);
-
- $me->read_until_dot(@_);
-}
-
-
-sub getfh {
- @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )';
- my $me = shift;
-
- return unless $me->_RETR(shift);
- return $me->tied_fh;
-}
-
-
-sub delete {
- @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
- my $me = shift;
- return 0 unless $me->_DELE(@_);
- ${*$me}{'net_pop3_deleted'} = 1;
-}
-
-
-sub uidl {
- @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )';
- my $me = shift;
- my $uidl;
-
- $me->_UIDL(@_)
- or return undef;
- if (@_) {
- $uidl = ($me->message =~ /\d+\s+([\041-\176]+)/)[0];
- }
- else {
- my $ref = $me->read_until_dot
- or return undef;
- my $ln;
- $uidl = {};
- foreach $ln (@$ref) {
- my ($msg, $uid) = $ln =~ /^\s*(\d+)\s+([\041-\176]+)/;
- $uidl->{$msg} = $uid;
- }
- }
- return $uidl;
-}
-
-
-sub ping {
- @_ == 2 or croak 'usage: $pop3->ping( USER )';
- my $me = shift;
-
- return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/;
-
- ($1 || 0, $2 || 0);
-}
-
-
-sub _lookup_credentials {
- my ($me, $user) = @_;
-
- require Net::Netrc;
-
- $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] }
- || $ENV{NAME}
- || $ENV{USER}
- || $ENV{LOGNAME};
-
- my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'}, $user);
- $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
-
- my $pass = $m
- ? $m->password || ""
- : "";
-
- ($user, $pass);
-}
-
-
-sub _get_mailbox_count {
- my ($me) = @_;
- my $ret = ${*$me}{'net_pop3_count'} =
- ($me->message =~ /(\d+)\s+message/io) ? $1 : ($me->popstat)[0];
-
- $ret ? $ret : "0E0";
-}
-
-
-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 }
-sub _DELE { shift->command('DELE', $_[0])->response() == CMD_OK }
-sub _NOOP { shift->command('NOOP')->response() == CMD_OK }
-sub _RSET { shift->command('RSET')->response() == CMD_OK }
-sub _QUIT { shift->command('QUIT')->response() == CMD_OK }
-sub _TOP { shift->command('TOP', @_)->response() == CMD_OK }
-sub _UIDL { shift->command('UIDL', @_)->response() == CMD_OK }
-sub _USER { shift->command('USER', $_[0])->response() == CMD_OK }
-sub _PASS { shift->command('PASS', $_[0])->response() == CMD_OK }
-sub _APOP { shift->command('APOP', @_)->response() == CMD_OK }
-sub _PING { shift->command('PING', $_[0])->response() == CMD_OK }
-
-
-sub _RPOP { shift->command('RPOP', $_[0])->response() == CMD_OK }
-sub _LAST { shift->command('LAST')->response() == CMD_OK }
-
-
-sub _CAPA { shift->command('CAPA')->response() == CMD_OK }
-
-
-sub quit {
- my $me = shift;
-
- $me->_QUIT;
- $me->close;
-}
-
-
-sub DESTROY {
- my $me = shift;
-
- if (defined fileno($me) and ${*$me}{'net_pop3_deleted'}) {
- $me->reset;
- $me->quit;
- }
-}
-
-##
-## POP3 has weird responses, so we emulate them to look the same :-)
-##
-
-
-sub response {
- my $cmd = shift;
- my $str = $cmd->getline() or return undef;
- my $code = "500";
-
- $cmd->debug_print(0, $str)
- if ($cmd->debug);
-
- if ($str =~ s/^\+OK\s*//io) {
- $code = "200";
- }
- elsif ($str =~ s/^\+\s*//io) {
- $code = "300";
- }
- else {
- $str =~ s/^-ERR\s*//io;
- }
-
- ${*$cmd}{'net_cmd_resp'} = [$str];
- ${*$cmd}{'net_cmd_code'} = $code;
-
- substr($code, 0, 1);
-}
-
-
-sub capa {
- my $this = shift;
- my ($capa, %capabilities);
-
- # Fake a capability here
- $capabilities{APOP} = '' if ($this->banner() =~ /<.*>/);
-
- if ($this->_CAPA()) {
- $capabilities{CAPA} = 1;
- $capa = $this->read_until_dot();
- %capabilities = (%capabilities, map {/^\s*(\S+)\s*(.*)/} @$capa);
- }
- else {
-
- # Check AUTH for SASL capabilities
- if ($this->command('AUTH')->response() == CMD_OK) {
- my $mechanism = $this->read_until_dot();
- $capabilities{SASL} = join " ", map {m/([A-Z0-9_-]+)/} @{$mechanism};
- }
- }
-
- return ${*$this}{'net_pop3e_capabilities'} = \%capabilities;
-}
-
-
-sub capabilities {
- my $this = shift;
-
- ${*$this}{'net_pop3e_capabilities'} || $this->capa;
-}
-
-
-sub auth {
- my ($self, $username, $password) = @_;
-
- eval {
- require MIME::Base64;
- require Authen::SASL;
- } or $self->set_status(500, ["Need MIME::Base64 and Authen::SASL todo auth"]), return 0;
-
- my $capa = $self->capa;
- my $mechanisms = $capa->{SASL} || 'CRAM-MD5';
-
- my $sasl;
-
- if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) {
- $sasl = $username;
- my $user_mech = $sasl->mechanism || '';
- my @user_mech = split(/\s+/, $user_mech);
- my %user_mech;
- @user_mech{@user_mech} = ();
-
- my @server_mech = split(/\s+/, $mechanisms);
- my @mech = @user_mech
- ? grep { exists $user_mech{$_} } @server_mech
- : @server_mech;
- unless (@mech) {
- $self->set_status(
- 500,
- [ 'Client SASL mechanisms (',
- join(', ', @user_mech),
- ') do not match the SASL mechnism the server announces (',
- join(', ', @server_mech), ')',
- ]
- );
- return 0;
- }
-
- $sasl->mechanism(join(" ", @mech));
- }
- else {
- die "auth(username, password)" if not length $username;
- $sasl = Authen::SASL->new(
- mechanism => $mechanisms,
- callback => {
- user => $username,
- pass => $password,
- authname => $username,
- }
- );
- }
-
- # We should probably allow the user to pass the host, but I don't
- # currently know and SASL mechanisms that are used by smtp that need it
- my ($hostname) = split /:/, ${*$self}{'net_pop3_host'};
- my $client = eval { $sasl->client_new('pop', $hostname, 0) };
-
- unless ($client) {
- my $mech = $sasl->mechanism;
- $self->set_status(
- 500,
- [ " Authen::SASL failure: $@",
- '(please check if your local Authen::SASL installation',
- "supports mechanism '$mech'"
- ]
- );
- return 0;
- }
-
- my ($token) = $client->client_start
- or do {
- my $mech = $client->mechanism;
- $self->set_status(
- 500,
- [ ' Authen::SASL failure: $client->client_start ',
- "mechanism '$mech' hostname #$hostname#",
- $client->error
- ]
- );
- return 0;
- };
-
- # We dont support sasl mechanisms that encrypt the socket traffic.
- # todo that we would really need to change the ISA hierarchy
- # so we dont inherit from IO::Socket, but instead hold it in an attribute
-
- my @cmd = ("AUTH", $client->mechanism);
- my $code;
-
- push @cmd, MIME::Base64::encode_base64($token, '')
- if defined $token and length $token;
-
- while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
-
- my ($token) = $client->client_step(MIME::Base64::decode_base64(($self->message)[0])) or do {
- $self->set_status(
- 500,
- [ ' Authen::SASL failure: $client->client_step ',
- "mechanism '", $client->mechanism, " hostname #$hostname#, ",
- $client->error
- ]
- );
- return 0;
- };
-
- @cmd = (MIME::Base64::encode_base64(defined $token ? $token : '', ''));
- }
-
- $code == CMD_OK;
-}
-
-
-sub banner {
- my $this = shift;
-
- return ${*$this}{'net_pop3_banner'};
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Net::POP3 - Post Office Protocol 3 Client class (RFC1939)
-
-=head1 SYNOPSIS
-
- use Net::POP3;
-
- # Constructors
- $pop = Net::POP3->new('pop3host');
- $pop = Net::POP3->new('pop3host', Timeout => 60);
-
- if ($pop->login($username, $password) > 0) {
- my $msgnums = $pop->list; # hashref of msgnum => size
- foreach my $msgnum (keys %$msgnums) {
- my $msg = $pop->get($msgnum);
- print @$msg;
- $pop->delete($msgnum);
- }
- }
-
- $pop->quit;
-
-=head1 DESCRIPTION
-
-This module implements a client interface to the POP3 protocol, enabling
-a perl5 application to talk to POP3 servers. This documentation assumes
-that you are familiar with the POP3 protocol described in RFC1939.
-
-A new Net::POP3 object must be created with the I<new> method. Once
-this has been done, all POP3 commands are accessed via method calls
-on the object.
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new ( [ HOST ] [, OPTIONS ] 0
-
-This is the constructor for a new Net::POP3 object. C<HOST> is the
-name of the remote host to which an POP3 connection is required.
-
-C<HOST> is optional. If C<HOST> is not given then it may instead be
-passed as the C<Host> option described below. If neither is given then
-the C<POP3_Hosts> specified in C<Net::Config> will be used.
-
-C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
-Possible options are:
-
-B<Host> - POP3 host to connect to. It may be a single scalar, as defined for
-the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
-an array with hosts to try in turn. The L</host> method will return the value
-which was used to connect to the host.
-
-B<ResvPort> - If given then the socket for the C<Net::POP3> object
-will be bound to the local port given using C<bind> when the socket is
-created.
-
-B<Timeout> - Maximum time, in seconds, to wait for a response from the
-POP3 server (default: 120)
-
-B<Debug> - Enable debugging information
-
-=back
-
-=head1 METHODS
-
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, failure will be returned as I<undef> or an
-empty list.
-
-=over 4
-
-=item auth ( USERNAME, PASSWORD )
-
-Attempt SASL authentication.
-
-=item user ( USER )
-
-Send the USER command.
-
-=item pass ( PASS )
-
-Send the PASS command. Returns the number of messages in the mailbox.
-
-=item login ( [ USER [, PASS ]] )
-
-Send both the USER and PASS commands. If C<PASS> is not given the
-C<Net::POP3> uses C<Net::Netrc> to lookup the password using the host
-and username. If the username is not specified then the current user name
-will be used.
-
-Returns the number of messages in the mailbox. However if there are no
-messages on the server the string C<"0E0"> will be returned. This is
-will give a true value in a boolean context, but zero in a numeric context.
-
-If there was an error authenticating the user then I<undef> will be returned.
-
-=item apop ( [ USER [, PASS ]] )
-
-Authenticate with the server identifying as C<USER> with password C<PASS>.
-Similar to L</login>, but the password is not sent in clear text.
-
-To use this method you must have the Digest::MD5 or the MD5 module installed,
-otherwise this method will return I<undef>.
-
-=item banner ()
-
-Return the sever's connection banner
-
-=item capa ()
-
-Return a reference to a hash of the capabilities of the server. APOP
-is added as a pseudo capability. Note that I've been unable to
-find a list of the standard capability values, and some appear to
-be multi-word and some are not. We make an attempt at intelligently
-parsing them, but it may not be correct.
-
-=item capabilities ()
-
-Just like capa, but only uses a cache from the last time we asked
-the server, so as to avoid asking more than once.
-
-=item top ( MSGNUM [, NUMLINES ] )
-
-Get the header and the first C<NUMLINES> of the body for the message
-C<MSGNUM>. Returns a reference to an array which contains the lines of text
-read from the server.
-
-=item list ( [ MSGNUM ] )
-
-If called with an argument the C<list> returns the size of the message
-in octets.
-
-If called without arguments a reference to a hash is returned. The
-keys will be the C<MSGNUM>'s of all undeleted messages and the values will
-be their size in octets.
-
-=item get ( MSGNUM [, FH ] )
-
-Get the message C<MSGNUM> from the remote mailbox. If C<FH> is not given
-then get returns a reference to an array which contains the lines of
-text read from the server. If C<FH> is given then the lines returned
-from the server are printed to the filehandle C<FH>.
-
-=item getfh ( MSGNUM )
-
-As per get(), but returns a tied filehandle. Reading from this
-filehandle returns the requested message. The filehandle will return
-EOF at the end of the message and should not be reused.
-
-=item last ()
-
-Returns the highest C<MSGNUM> of all the messages accessed.
-
-=item popstat ()
-
-Returns a list of two elements. These are the number of undeleted
-elements and the size of the mbox in octets.
-
-=item ping ( USER )
-
-Returns a list of two elements. These are the number of new messages
-and the total number of messages for C<USER>.
-
-=item uidl ( [ MSGNUM ] )
-
-Returns a unique identifier for C<MSGNUM> if given. If C<MSGNUM> is not
-given C<uidl> returns a reference to a hash where the keys are the
-message numbers and the values are the unique identifiers.
-
-=item delete ( MSGNUM )
-
-Mark message C<MSGNUM> to be deleted from the remote mailbox. All messages
-that are marked to be deleted will be removed from the remote mailbox
-when the server connection closed.
-
-=item reset ()
-
-Reset the status of the remote POP3 server. This includes resetting the
-status of all messages to not be deleted.
-
-=item quit ()
-
-Quit and close the connection to the remote POP3 server. Any messages marked
-as deleted will be deleted from the remote mailbox.
-
-=back
-
-=head1 NOTES
-
-If a C<Net::POP3> object goes out of scope before C<quit> method is called
-then the C<reset> method will called before the connection is closed. This
-means that any messages marked to be deleted will not be.
-
-=head1 SEE ALSO
-
-L<Net::Netrc>,
-L<Net::Cmd>
-
-=head1 AUTHOR
-
-Graham Barr <gbarr@pobox.com>
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995-2003 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.
-
-=cut
diff --git a/lib/Net/README b/lib/Net/README
deleted file mode 100644
index 25b6c73ffd..0000000000
--- a/lib/Net/README
+++ /dev/null
@@ -1,109 +0,0 @@
-libnet is a collection of Perl modules which provides a simple
-and consistent programming interface (API) to the client side
-of various protocols used in the internet community.
-
-For details of each protocol please refer to the RFC. RFC's
-can be found a various places on the WEB, for a starting
-point look at:
-
- http://www.yahoo.com/Computers_and_Internet/Standards/RFCs/
-
-The RFC implemented in this distribution are
-
-Net::FTP RFC959 File Transfer Protocol
-Net::SMTP RFC821 Simple Mail Transfer Protocol
-Net::Time RFC867 Daytime Protocol
-Net::Time RFC868 Time Protocol
-Net::NNTP RFC977 Network News Transfer Protocol
-Net::POP3 RFC1939 Post Office Protocol 3
-
-AVAILABILITY
-
-The latest version of libnet is available from the Comprehensive Perl
-Archive Network (CPAN). To find a CPAN site near you see:
-
- http://search.cpan.org/~gbarr/libnet/
-
-The subversion source repository can be browsed at
-
- http://svn.goingon.net/viewvc/libnet/
-
-If you have a subversion client, then you can checkout the latest code with
-
- svn co http://svn.goingon.net/repos/libnet/trunk libnet
-
-INSTALLATION
-
-In order to use this package you will need Perl version 5.002 or
-better. You install libnet, as you would install any perl module
-library, by running these commands:
-
- perl Makefile.PL
- make
- make test
- make install
-
-If you want to install a private copy of libnet in your home
-directory, then you should try to produce the initial Makefile with
-something like this command:
-
- perl Makefile.PL PREFIX=~/perl
-
-
-The Makefile.PL program will start out by checking your perl
-installation for a few packages that are recommended to be installed
-together with libnet. These packages should be available on CPAN
-(described above).
-
-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 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
-
-See ChangeLog for recent changes. POD style documentation is included
-in all modules and scripts. These are normally converted to manual
-pages and installed as part of the "make install" process. You should
-also be able to use the 'perldoc' utility to extract documentation from
-the module files directly.
-
-DEMOS
-
-The demos directory does contain a few demo scripts. These should be
-run from the top directory like
-
- demos/smtp.self -user my-email-address -debug
-
-However I do not guarantee these scripts to work.
-
-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 sent to me at <gbarr@pobox.com>.
-
-Most of the modules in this library have an option to output a debug
-transcript to STDERR. When reporting bugs/problems please, if possible,
-include a transcript of a run.
-
-COPYRIGHT
-
- (C) 1996-2007 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.
-
-Share and Enjoy!
diff --git a/lib/Net/SMTP.pm b/lib/Net/SMTP.pm
deleted file mode 100644
index a28496d688..0000000000
--- a/lib/Net/SMTP.pm
+++ /dev/null
@@ -1,867 +0,0 @@
-# Net::SMTP.pm
-#
-# Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. 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::SMTP;
-
-require 5.001;
-
-use strict;
-use vars qw($VERSION @ISA);
-use Socket 1.3;
-use Carp;
-use IO::Socket;
-use Net::Cmd;
-use Net::Config;
-
-$VERSION = "2.31";
-
-@ISA = qw(Net::Cmd IO::Socket::INET);
-
-
-sub new {
- my $self = shift;
- my $type = ref($self) || $self;
- my ($host, %arg);
- if (@_ % 2) {
- $host = shift;
- %arg = @_;
- }
- else {
- %arg = @_;
- $host = delete $arg{Host};
- }
- my $hosts = defined $host ? $host : $NetConfig{smtp_hosts};
- my $obj;
-
- my $h;
- foreach $h (@{ref($hosts) ? $hosts : [$hosts]}) {
- $obj = $type->SUPER::new(
- PeerAddr => ($host = $h),
- PeerPort => $arg{Port} || 'smtp(25)',
- LocalAddr => $arg{LocalAddr},
- LocalPort => $arg{LocalPort},
- Proto => 'tcp',
- Timeout => defined $arg{Timeout}
- ? $arg{Timeout}
- : 120
- )
- and last;
- }
-
- return undef
- unless defined $obj;
-
- $obj->autoflush(1);
-
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-
- unless ($obj->response() == CMD_OK) {
- $obj->close();
- return undef;
- }
-
- ${*$obj}{'net_smtp_exact_addr'} = $arg{ExactAddresses};
- ${*$obj}{'net_smtp_host'} = $host;
-
- (${*$obj}{'net_smtp_banner'}) = $obj->message;
- (${*$obj}{'net_smtp_domain'}) = $obj->message =~ /\A\s*(\S+)/;
-
- unless ($obj->hello($arg{Hello} || "")) {
- $obj->close();
- return undef;
- }
-
- $obj;
-}
-
-
-sub host {
- my $me = shift;
- ${*$me}{'net_smtp_host'};
-}
-
-##
-## User interface methods
-##
-
-
-sub banner {
- my $me = shift;
-
- return ${*$me}{'net_smtp_banner'} || undef;
-}
-
-
-sub domain {
- my $me = shift;
-
- return ${*$me}{'net_smtp_domain'} || undef;
-}
-
-
-sub etrn {
- my $self = shift;
- defined($self->supports('ETRN', 500, ["Command unknown: 'ETRN'"]))
- && $self->_ETRN(@_);
-}
-
-
-sub auth {
- my ($self, $username, $password) = @_;
-
- eval {
- require MIME::Base64;
- require Authen::SASL;
- } or $self->set_status(500, ["Need MIME::Base64 and Authen::SASL todo auth"]), return 0;
-
- my $mechanisms = $self->supports('AUTH', 500, ["Command unknown: 'AUTH'"]);
- return unless defined $mechanisms;
-
- my $sasl;
-
- if (ref($username) and UNIVERSAL::isa($username, 'Authen::SASL')) {
- $sasl = $username;
- $sasl->mechanism($mechanisms);
- }
- else {
- die "auth(username, password)" if not length $username;
- $sasl = Authen::SASL->new(
- mechanism => $mechanisms,
- callback => {
- user => $username,
- pass => $password,
- authname => $username,
- }
- );
- }
-
- # We should probably allow the user to pass the host, but I don't
- # currently know and SASL mechanisms that are used by smtp that need it
- my $client = $sasl->client_new('smtp', ${*$self}{'net_smtp_host'}, 0);
- my $str = $client->client_start;
-
- # We dont support sasl mechanisms that encrypt the socket traffic.
- # todo that we would really need to change the ISA hierarchy
- # so we dont inherit from IO::Socket, but instead hold it in an attribute
-
- my @cmd = ("AUTH", $client->mechanism);
- my $code;
-
- push @cmd, MIME::Base64::encode_base64($str, '')
- if defined $str and length $str;
-
- while (($code = $self->command(@cmd)->response()) == CMD_MORE) {
- @cmd = (
- MIME::Base64::encode_base64(
- $client->client_step(MIME::Base64::decode_base64(($self->message)[0])), ''
- )
- );
- }
-
- $code == CMD_OK;
-}
-
-
-sub hello {
- my $me = shift;
- my $domain = shift || "localhost.localdomain";
- my $ok = $me->_EHLO($domain);
- my @msg = $me->message;
-
- if ($ok) {
- my $h = ${*$me}{'net_smtp_esmtp'} = {};
- my $ln;
- foreach $ln (@msg) {
- $h->{uc $1} = $2
- if $ln =~ /(\w+)\b[= \t]*([^\n]*)/;
- }
- }
- elsif ($me->status == CMD_ERROR) {
- @msg = $me->message
- if $ok = $me->_HELO($domain);
- }
-
- return undef unless $ok;
-
- $msg[0] =~ /\A\s*(\S+)/;
- return ($1 || " ");
-}
-
-
-sub supports {
- my $self = shift;
- my $cmd = uc shift;
- return ${*$self}{'net_smtp_esmtp'}->{$cmd}
- if exists ${*$self}{'net_smtp_esmtp'}->{$cmd};
- $self->set_status(@_)
- if @_;
- return;
-}
-
-
-sub _addr {
- my $self = shift;
- my $addr = shift;
- $addr = "" unless defined $addr;
-
- if (${*$self}{'net_smtp_exact_addr'}) {
- return $1 if $addr =~ /^\s*(<.*>)\s*$/s;
- }
- else {
- return $1 if $addr =~ /(<[^>]*>)/;
- $addr =~ s/^\s+|\s+$//sg;
- }
-
- "<$addr>";
-}
-
-
-sub mail {
- my $me = shift;
- my $addr = _addr($me, shift);
- my $opts = "";
-
- if (@_) {
- my %opt = @_;
- my ($k, $v);
-
- if (exists ${*$me}{'net_smtp_esmtp'}) {
- my $esmtp = ${*$me}{'net_smtp_esmtp'};
-
- if (defined($v = delete $opt{Size})) {
- if (exists $esmtp->{SIZE}) {
- $opts .= sprintf " SIZE=%d", $v + 0;
- }
- else {
- carp 'Net::SMTP::mail: SIZE option not supported by host';
- }
- }
-
- if (defined($v = delete $opt{Return})) {
- if (exists $esmtp->{DSN}) {
- $opts .= " RET=" . ((uc($v) eq "FULL") ? "FULL" : "HDRS");
- }
- else {
- carp 'Net::SMTP::mail: DSN option not supported by host';
- }
- }
-
- if (defined($v = delete $opt{Bits})) {
- if ($v eq "8") {
- if (exists $esmtp->{'8BITMIME'}) {
- $opts .= " BODY=8BITMIME";
- }
- else {
- carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
- }
- }
- elsif ($v eq "binary") {
- if (exists $esmtp->{'BINARYMIME'} && exists $esmtp->{'CHUNKING'}) {
- $opts .= " BODY=BINARYMIME";
- ${*$me}{'net_smtp_chunking'} = 1;
- }
- else {
- carp 'Net::SMTP::mail: BINARYMIME option not supported by host';
- }
- }
- elsif (exists $esmtp->{'8BITMIME'} or exists $esmtp->{'BINARYMIME'}) {
- $opts .= " BODY=7BIT";
- }
- else {
- carp 'Net::SMTP::mail: 8BITMIME and BINARYMIME options not supported by host';
- }
- }
-
- if (defined($v = delete $opt{Transaction})) {
- if (exists $esmtp->{CHECKPOINT}) {
- $opts .= " TRANSID=" . _addr($me, $v);
- }
- else {
- carp 'Net::SMTP::mail: CHECKPOINT option not supported by host';
- }
- }
-
- if (defined($v = delete $opt{Envelope})) {
- if (exists $esmtp->{DSN}) {
- $v =~ s/([^\041-\176]|=|\+)/sprintf "+%02x", ord($1)/sge;
- $opts .= " ENVID=$v";
- }
- else {
- carp 'Net::SMTP::mail: DSN option not supported by host';
- }
- }
-
- if (defined($v = delete $opt{ENVID})) {
-
- # expected to be in a format as required by RFC 3461, xtext-encoded
- if (exists $esmtp->{DSN}) {
- $opts .= " ENVID=$v";
- }
- else {
- carp 'Net::SMTP::mail: DSN option not supported by host';
- }
- }
-
- if (defined($v = delete $opt{AUTH})) {
-
- # expected to be in a format as required by RFC 2554,
- # rfc2821-quoted and xtext-encoded, or <>
- if (exists $esmtp->{AUTH}) {
- $v = '<>' if !defined($v) || $v eq '';
- $opts .= " AUTH=$v";
- }
- else {
- carp 'Net::SMTP::mail: AUTH option not supported by host';
- }
- }
-
- if (defined($v = delete $opt{XVERP})) {
- if (exists $esmtp->{'XVERP'}) {
- $opts .= " XVERP";
- }
- else {
- carp 'Net::SMTP::mail: XVERP option not supported by host';
- }
- }
-
- carp 'Net::SMTP::recipient: unknown option(s) ' . join(" ", keys %opt) . ' - ignored'
- if scalar keys %opt;
- }
- else {
- carp 'Net::SMTP::mail: ESMTP not supported by host - options discarded :-(';
- }
- }
-
- $me->_MAIL("FROM:" . $addr . $opts);
-}
-
-
-sub send { my $me = shift; $me->_SEND("FROM:" . _addr($me, $_[0])) }
-sub send_or_mail { my $me = shift; $me->_SOML("FROM:" . _addr($me, $_[0])) }
-sub send_and_mail { my $me = shift; $me->_SAML("FROM:" . _addr($me, $_[0])) }
-
-
-sub reset {
- my $me = shift;
-
- $me->dataend()
- if (exists ${*$me}{'net_smtp_lastch'});
-
- $me->_RSET();
-}
-
-
-sub recipient {
- my $smtp = shift;
- my $opts = "";
- my $skip_bad = 0;
-
- if (@_ && ref($_[-1])) {
- my %opt = %{pop(@_)};
- my $v;
-
- $skip_bad = delete $opt{'SkipBad'};
-
- if (exists ${*$smtp}{'net_smtp_esmtp'}) {
- my $esmtp = ${*$smtp}{'net_smtp_esmtp'};
-
- if (defined($v = delete $opt{Notify})) {
- if (exists $esmtp->{DSN}) {
- $opts .= " NOTIFY=" . join(",", map { uc $_ } @$v);
- }
- else {
- carp 'Net::SMTP::recipient: DSN option not supported by host';
- }
- }
-
- if (defined($v = delete $opt{ORcpt})) {
- if (exists $esmtp->{DSN}) {
- $opts .= " ORCPT=" . $v;
- }
- else {
- carp 'Net::SMTP::recipient: DSN option not supported by host';
- }
- }
-
- carp 'Net::SMTP::recipient: unknown option(s) ' . join(" ", keys %opt) . ' - ignored'
- if scalar keys %opt;
- }
- elsif (%opt) {
- carp 'Net::SMTP::recipient: ESMTP not supported by host - options discarded :-(';
- }
- }
-
- my @ok;
- my $addr;
- foreach $addr (@_) {
- if ($smtp->_RCPT("TO:" . _addr($smtp, $addr) . $opts)) {
- push(@ok, $addr) if $skip_bad;
- }
- elsif (!$skip_bad) {
- return 0;
- }
- }
-
- return $skip_bad ? @ok : 1;
-}
-
-BEGIN {
- *to = \&recipient;
- *cc = \&recipient;
- *bcc = \&recipient;
-}
-
-
-sub data {
- my $me = shift;
-
- if (exists ${*$me}{'net_smtp_chunking'}) {
- carp 'Net::SMTP::data: CHUNKING extension in use, must call bdat instead';
- }
- else {
- my $ok = $me->_DATA() && $me->datasend(@_);
-
- $ok && @_
- ? $me->dataend
- : $ok;
- }
-}
-
-
-sub bdat {
- my $me = shift;
-
- if (exists ${*$me}{'net_smtp_chunking'}) {
- my $data = shift;
-
- $me->_BDAT(length $data)
- && $me->rawdatasend($data)
- && $me->response() == CMD_OK;
- }
- else {
- carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
- }
-}
-
-
-sub bdatlast {
- my $me = shift;
-
- if (exists ${*$me}{'net_smtp_chunking'}) {
- my $data = shift;
-
- $me->_BDAT(length $data, "LAST")
- && $me->rawdatasend($data)
- && $me->response() == CMD_OK;
- }
- else {
- carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead';
- }
-}
-
-
-sub datafh {
- my $me = shift;
- return unless $me->_DATA();
- return $me->tied_fh;
-}
-
-
-sub expand {
- my $me = shift;
-
- $me->_EXPN(@_)
- ? ($me->message)
- : ();
-}
-
-
-sub verify { shift->_VRFY(@_) }
-
-
-sub help {
- my $me = shift;
-
- $me->_HELP(@_)
- ? scalar $me->message
- : undef;
-}
-
-
-sub quit {
- my $me = shift;
-
- $me->_QUIT;
- $me->close;
-}
-
-
-sub DESTROY {
-
- # ignore
-}
-
-##
-## RFC821 commands
-##
-
-
-sub _EHLO { shift->command("EHLO", @_)->response() == CMD_OK }
-sub _HELO { shift->command("HELO", @_)->response() == CMD_OK }
-sub _MAIL { shift->command("MAIL", @_)->response() == CMD_OK }
-sub _RCPT { shift->command("RCPT", @_)->response() == CMD_OK }
-sub _SEND { shift->command("SEND", @_)->response() == CMD_OK }
-sub _SAML { shift->command("SAML", @_)->response() == CMD_OK }
-sub _SOML { shift->command("SOML", @_)->response() == CMD_OK }
-sub _VRFY { shift->command("VRFY", @_)->response() == CMD_OK }
-sub _EXPN { shift->command("EXPN", @_)->response() == CMD_OK }
-sub _HELP { shift->command("HELP", @_)->response() == CMD_OK }
-sub _RSET { shift->command("RSET")->response() == CMD_OK }
-sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
-sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
-sub _DATA { shift->command("DATA")->response() == CMD_MORE }
-sub _BDAT { shift->command("BDAT", @_) }
-sub _TURN { shift->unsupported(@_); }
-sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK }
-sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK }
-
-1;
-
-__END__
-
-=head1 NAME
-
-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);
-
-=head1 DESCRIPTION
-
-This module implements a client interface to the SMTP and ESMTP
-protocol, enabling a perl5 application to talk to SMTP servers. This
-documentation assumes that you are familiar with the concepts of the
-SMTP protocol described in RFC821.
-
-A new Net::SMTP object must be created with the I<new> method. Once
-this has been done, all SMTP commands are accessed through this object.
-
-The Net::SMTP class is a subclass of Net::Cmd and IO::Socket::INET.
-
-=head1 EXAMPLES
-
-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;
-
-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
-
-=over 4
-
-=item new ( [ HOST ] [, OPTIONS ] )
-
-This is the constructor for a new Net::SMTP object. C<HOST> is the
-name of the remote host to which an SMTP connection is required.
-
-C<HOST> is optional. If C<HOST> is not given then it may instead be
-passed as the C<Host> option described below. If neither is given then
-the C<SMTP_Hosts> specified in C<Net::Config> will be used.
-
-C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
-Possible options are:
-
-B<Hello> - SMTP requires that you identify yourself. This option
-specifies a string to pass as your mail domain. If not given localhost.localdomain
-will be used.
-
-B<Host> - SMTP host to connect to. It may be a single scalar, as defined for
-the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
-an array with hosts to try in turn. The L</host> method will return the value
-which was used to connect to the host.
-
-B<LocalAddr> and B<LocalPort> - These parameters are passed directly
-to IO::Socket to allow binding the socket to a local port.
-
-B<Timeout> - Maximum time, in seconds, to wait for a response from the
-SMTP server (default: 120)
-
-B<ExactAddresses> - If true the all ADDRESS arguments must be as
-defined by C<addr-spec> in RFC2822. If not given, or false, then
-Net::SMTP will attempt to extract the address from the value passed.
-
-B<Debug> - Enable debugging information
-
-
-Example:
-
-
- $smtp = Net::SMTP->new('mailhost',
- Hello => 'my.mail.domain',
- Timeout => 30,
- Debug => 1,
- );
-
- # the same
- $smtp = Net::SMTP->new(
- Host => 'mailhost',
- Hello => 'my.mail.domain',
- Timeout => 30,
- Debug => 1,
- );
-
- # Connect to the default server from Net::config
- $smtp = Net::SMTP->new(
- Hello => 'my.mail.domain',
- Timeout => 30,
- );
-
-=back
-
-=head1 METHODS
-
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, failure will be returned as I<undef> or an
-empty list.
-
-=over 4
-
-=item banner ()
-
-Returns the banner message which the server replied with when the
-initial connection was made.
-
-=item domain ()
-
-Returns the domain that the remote SMTP server identified itself as during
-connection.
-
-=item hello ( DOMAIN )
-
-Tell the remote server the mail domain which you are in using the EHLO
-command (or HELO if EHLO fails). Since this method is invoked
-automatically when the Net::SMTP object is constructed the user should
-normally not have to call it manually.
-
-=item host ()
-
-Returns the value used by the constructor, and passed to IO::Socket::INET,
-to connect to the host.
-
-=item etrn ( DOMAIN )
-
-Request a queue run for the DOMAIN given.
-
-=item auth ( USERNAME, PASSWORD )
-
-Attempt SASL authentication.
-
-=item mail ( ADDRESS [, OPTIONS] )
-
-=item send ( ADDRESS )
-
-=item send_or_mail ( ADDRESS )
-
-=item send_and_mail ( ADDRESS )
-
-Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<ADDRESS>
-is the address of the sender. This initiates the sending of a message. The
-method C<recipient> should be called for each address that the message is to
-be sent to.
-
-The C<mail> method can some additional ESMTP OPTIONS which is passed
-in hash like fashion, using key and value pairs. Possible options are:
-
- Size => <bytes>
- Return => "FULL" | "HDRS"
- Bits => "7" | "8" | "binary"
- Transaction => <ADDRESS>
- Envelope => <ENVID> # xtext-encodes its argument
- ENVID => <ENVID> # similar to Envelope, but expects argument encoded
- XVERP => 1
- AUTH => <submitter> # encoded address according to RFC 2554
-
-The C<Return> and C<Envelope> parameters are used for DSN (Delivery
-Status Notification).
-
-The submitter address in C<AUTH> option is expected to be in a format as
-required by RFC 2554, in an RFC2821-quoted form and xtext-encoded, or <> .
-
-=item reset ()
-
-Reset the status of the server. This may be called after a message has been
-initiated, but before any data has been sent, to cancel the sending of the
-message.
-
-=item recipient ( ADDRESS [, ADDRESS, [...]] [, OPTIONS ] )
-
-Notify the server that the current message should be sent to all of the
-addresses given. Each address is sent as a separate command to the server.
-Should the sending of any address result in a failure then the process is
-aborted and a I<false> value is returned. It is up to the user to call
-C<reset> if they so desire.
-
-The C<recipient> method can also pass additional case-sensitive OPTIONS as an
-anonymous hash using key and value pairs. Possible options are:
-
- Notify => ['NEVER'] or ['SUCCESS','FAILURE','DELAY'] (see below)
- ORcpt => <ORCPT>
- SkipBad => 1 (to ignore bad addresses)
-
-If C<SkipBad> is true the C<recipient> 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($recipient1,$recipient2, { Notify => ['FAILURE','DELAY'], SkipBad => 1 }); # Good
- @goodrecips=$smtp->recipient(@recipients, { Notify => ['FAILURE'], SkipBad => 1 }); # Good
- $smtp->recipient("$recipient,$recipient2"); # BAD
-
-Notify is used to request Delivery Status Notifications (DSNs), but your
-SMTP/ESMTP service may not respect this request depending upon its version and
-your site's SMTP configuration.
-
-Leaving out the Notify option usually defaults an SMTP service to its default
-behavior equivalent to ['FAILURE'] notifications only, but again this may be
-dependent upon your site's SMTP configuration.
-
-The NEVER keyword must appear by itself if used within the Notify option and "requests
-that a DSN not be returned to the sender under any conditions."
-
- {Notify => ['NEVER']}
-
- $smtp->recipient(@recipients, { Notify => ['NEVER'], SkipBad => 1 }); # Good
-
-You may use any combination of these three values 'SUCCESS','FAILURE','DELAY' in
-the anonymous array reference as defined by RFC3461 (see http://rfc.net/rfc3461.html
-for more information. Note: quotations in this topic from same.).
-
-A Notify parameter of 'SUCCESS' or 'FAILURE' "requests that a DSN be issued on
-successful delivery or delivery failure, respectively."
-
-A Notify parameter of 'DELAY' "indicates the sender's willingness to receive
-delayed DSNs. Delayed DSNs may be issued if delivery of a message has been
-delayed for an unusual amount of time (as determined by the Message Transfer
-Agent (MTA) at which the message is delayed), but the final delivery status
-(whether successful or failure) cannot be determined. The absence of the DELAY
-keyword in a NOTIFY parameter requests that a "delayed" DSN NOT be issued under
-any conditions."
-
- {Notify => ['SUCCESS','FAILURE','DELAY']}
-
- $smtp->recipient(@recipients, { Notify => ['FAILURE','DELAY'], SkipBad => 1 }); # Good
-
-ORcpt is also part of the SMTP DSN extension according to RFC3461.
-It is used to pass along the original recipient that the mail was first
-sent to. The machine that generates a DSN will use this address to inform
-the sender, because he can't know if recipients get rewritten by mail servers.
-It is expected to be in a format as required by RFC3461, xtext-encoded.
-
-=item to ( ADDRESS [, ADDRESS [...]] )
-
-=item cc ( ADDRESS [, ADDRESS [...]] )
-
-=item bcc ( ADDRESS [, ADDRESS [...]] )
-
-Synonyms for C<recipient>.
-
-=item data ( [ DATA ] )
-
-Initiate the sending of the data from the current message.
-
-C<DATA> may be a reference to a list or a list. If specified the contents
-of C<DATA> and a termination string C<".\r\n"> is sent to the server. And the
-result will be true if the data was accepted.
-
-If C<DATA> is not specified then the result will indicate that the server
-wishes the data to be sent. The data must then be sent using the C<datasend>
-and C<dataend> methods described in L<Net::Cmd>.
-
-=item expand ( ADDRESS )
-
-Request the server to expand the given address Returns an array
-which contains the text read from the server.
-
-=item verify ( ADDRESS )
-
-Verify that C<ADDRESS> is a legitimate mailing address.
-
-Most sites usually disable this feature in their SMTP service configuration.
-Use "Debug => 1" option under new() to see if disabled.
-
-=item help ( [ $subject ] )
-
-Request help text from the server. Returns the text or undef upon failure
-
-=item quit ()
-
-Send the QUIT command to the remote SMTP server and close the socket connection.
-
-=back
-
-=head1 ADDRESSES
-
-Net::SMTP attempts to DWIM with addresses that are passed. For
-example an application might extract The From: line from an email
-and pass that to mail(). While this may work, it is not recommended.
-The application should really use a module like L<Mail::Address>
-to extract the mail address and pass that.
-
-If C<ExactAddresses> is passed to the constructor, then addresses
-should be a valid rfc2821-quoted address, although Net::SMTP will
-accept accept the address surrounded by angle brackets.
-
- funny user@domain WRONG
- "funny user"@domain RIGHT, recommended
- <"funny user"@domain> OK
-
-=head1 SEE ALSO
-
-L<Net::Cmd>
-
-=head1 AUTHOR
-
-Graham Barr <gbarr@pobox.com>
-
-=head1 COPYRIGHT
-
-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.
-
-=cut
diff --git a/lib/Net/Time.pm b/lib/Net/Time.pm
deleted file mode 100644
index 6f1dd04586..0000000000
--- a/lib/Net/Time.pm
+++ /dev/null
@@ -1,151 +0,0 @@
-# Net::Time.pm
-#
-# Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. 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::Time;
-
-use strict;
-use vars qw($VERSION @ISA @EXPORT_OK $TIMEOUT);
-use Carp;
-use IO::Socket;
-require Exporter;
-use Net::Config;
-use IO::Select;
-
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(inet_time inet_daytime);
-
-$VERSION = "2.10";
-
-$TIMEOUT = 120;
-
-
-sub _socket {
- my ($pname, $pnum, $host, $proto, $timeout) = @_;
-
- $proto ||= 'udp';
-
- my $port = (getservbyname($pname, $proto))[2] || $pnum;
-
- my $hosts = defined $host ? [$host] : $NetConfig{$pname . '_hosts'};
-
- my $me;
-
- foreach $host (@$hosts) {
- $me = IO::Socket::INET->new(
- PeerAddr => $host,
- PeerPort => $port,
- Proto => $proto
- )
- and last;
- }
-
- return unless $me;
-
- $me->send("\n")
- if $proto eq 'udp';
-
- $timeout = $TIMEOUT
- unless defined $timeout;
-
- IO::Select->new($me)->can_read($timeout)
- ? $me
- : undef;
-}
-
-
-sub inet_time {
- my $s = _socket('time', 37, @_) || return undef;
- my $buf = '';
- my $offset = 0 | 0;
-
- return undef
- unless defined $s->recv($buf, length(pack("N", 0)));
-
- # unpack, we | 0 to ensure we have an unsigned
- my $time = (unpack("N", $buf))[0] | 0;
-
- # the time protocol return time in seconds since 1900, convert
- # it to a the required format
-
- if ($^O eq "MacOS") {
-
- # MacOS return seconds since 1904, 1900 was not a leap year.
- $offset = (4 * 31536000) | 0;
- }
- else {
-
- # otherwise return seconds since 1972, there were 17 leap years between
- # 1900 and 1972
- $offset = (70 * 31536000 + 17 * 86400) | 0;
- }
-
- $time - $offset;
-}
-
-
-sub inet_daytime {
- my $s = _socket('daytime', 13, @_) || return undef;
- my $buf = '';
-
- defined($s->recv($buf, 1024))
- ? $buf
- : undef;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-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');
-
-=head1 DESCRIPTION
-
-C<Net::Time> provides subroutines that obtain the time on a remote machine.
-
-=over 4
-
-=item inet_time ( [HOST [, PROTOCOL [, TIMEOUT]]])
-
-Obtain the time on C<HOST>, or some default host if C<HOST> is not given
-or not defined, using the protocol as defined in RFC868. The optional
-argument C<PROTOCOL> should define the protocol to use, either C<tcp> or
-C<udp>. The result will be a time value in the same units as returned
-by time() or I<undef> upon failure.
-
-=item inet_daytime ( [HOST [, PROTOCOL [, TIMEOUT]]])
-
-Obtain the time on C<HOST>, or some default host if C<HOST> is not given
-or not defined, using the protocol as defined in RFC867. The optional
-argument C<PROTOCOL> should define the protocol to use, either C<tcp> or
-C<udp>. The result will be an ASCII string or I<undef> upon failure.
-
-=back
-
-=head1 AUTHOR
-
-Graham Barr <gbarr@pobox.com>
-
-=head1 COPYRIGHT
-
-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.
-
-=cut
diff --git a/lib/Net/demos/ftp b/lib/Net/demos/ftp
deleted file mode 100755
index 610e102999..0000000000
--- a/lib/Net/demos/ftp
+++ /dev/null
@@ -1,21 +0,0 @@
-#!/usr/local/bin/perl
-
-use blib;
-use Net::FTP;
-use Getopt::Long;
-
-$opt_debug = undef;
-$opt_firewall = undef;
-
-GetOptions(qw(debug firewall=s));
-
-@firewall = defined $opt_firewall ? (Firewall => $opt_firewall) : ();
-
-foreach $host (@ARGV)
- {
- $ftp = Net::FTP->new($host, @firewall, Debug => $opt_debug ? 1 : 0);
- $ftp->login();
- print $ftp->pwd,"\n";
- $ftp->quit;
- }
-
diff --git a/lib/Net/demos/inetd b/lib/Net/demos/inetd
deleted file mode 100644
index 36a00e7bb8..0000000000
--- a/lib/Net/demos/inetd
+++ /dev/null
@@ -1,9 +0,0 @@
-#!/usr/local/bin/perl
-
-use Net::DummyInetd;
-use Net::SMTP;
-
-$p = new Net::DummyInetd qw(/usr/lib/sendmail -ba -bs);
-
-$smtp = Net::SMTP->new('localhost', Port => $p->port, Debug => 7);
-$smtp->quit;
diff --git a/lib/Net/demos/nntp b/lib/Net/demos/nntp
deleted file mode 100755
index 7753fbc299..0000000000
--- a/lib/Net/demos/nntp
+++ /dev/null
@@ -1,40 +0,0 @@
-#!/usr/local/bin/perl
-
-use blib;
-use Getopt::Long;
-use Net::NNTP;
-
-$opt_debug = undef;
-
-GetOptions(qw(debug));
-
-@groups = @ARGV;
-
-$nntp = Net::NNTP->new('news', Debug => $opt_debug ? 1 : 0);
-
-if($subs = $nntp->newsgroups)
- {
- print join("\n",(keys %$subs)[0 .. 10]),"\n";
- }
- else
- {
- warn $nntp->message;
- }
-
-foreach $group (@groups)
- {
- $new = $nntp->newnews(time - 3600, lc $group);
-
- if(ref($new) && scalar(@$new))
- {
- print@{$news}[0..3],"\n"
- if $news = $nntp->article($new->[-1]);
-
- warn $nntp->message
- unless $news;
- }
- }
-
-$nntp->quit;
-
-
diff --git a/lib/Net/demos/nntp.mirror b/lib/Net/demos/nntp.mirror
deleted file mode 100644
index 8a43c3262a..0000000000
--- a/lib/Net/demos/nntp.mirror
+++ /dev/null
@@ -1,86 +0,0 @@
-#!/usr/bin/perl5
-
-### Subject: Re: Fuller example of Net::NNTP?
-### Date: Tue, 4 Feb 1997 10:37:58 -0800
-### From: "Paul E. Hoffman" <phoffman@imc.org>
-### To: Graham Barr <gbarr@ti.com>
-###
-### Thanks for your reply. After looking at the examples, I realized that
-### you're not doing what I want, which is to store the messages on the local
-### hard disk with the same message number as what was on the remote. So, I
-### rolled my own program, although I haven't finished it yet (I have a hook
-### for expiring, but haven't done it yet).
-###
-### You are welcome to use this in the Net:: distribution if you think it is
-### useful.
-###
-### NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
-###
-### This script is included as-is, I give no guarantee that it will
-### work on every system
-###
-
-use Net::NNTP;
-
-$BaseDir = '/usr/usenet';
-chdir($BaseDir) or die "Could not cd to $BaseDir\n";
-
-# Format of grouplist is:
-# groupname<tab>expirationdays
-# expirationdays is the number of days to leave the articles around;
-# set it to 0 if you want the articles to stay forever
-# If the groupname starts with a #, it is skipped
-open(GROUPLIST, 'grouplist.txt') or die "Could not open grouplist.txt\n";
-while(<GROUPLIST>) {
- $Line = $_; chomp($Line);
- if($Line eq '') { next }; # Skip blank lines
- if(substr($Line, 0, 1) eq '#') { next }; # Skip comments
- push(@Groups, $Line)
-}
-
-$NntpPtr = Net::NNTP->new('news.server.com');
-
-foreach $GroupLine (@Groups) {
- ($GroupName, $GroupExp) = split(/\s/, $GroupLine, 2);
- # Process the expiration first (still to be done...)
-
- # See if this is a new group
- unless(-e "$BaseDir/$GroupName") {
- unless(mkdir("$BaseDir/$GroupName", 0755))
- { die "Could not make $BaseDir/$GroupName\n" }
- }
- chdir("$BaseDir/$GroupName") or die "Couldn't chdir to $GroupName\n";
- # Find the last article in the directory
- @AllInDir = <*>; @RevSortedAllInDir = reverse(sort(@AllInDir));
- $LenArr = @RevSortedAllInDir;
- if($LenArr > 0) { $NumLastInDir = $RevSortedAllInDir[0] }
- else { $NumLastInDir = 0 }
- ($NumArt, $NumFirst, $NumLast, $XGroupName) =
-$NntpPtr->group($GroupName);
-
- if($NumLast == $NumLastInDir) { next } # No new articles
- if($NumLast < $NumLastInDir)
- { die "In $GroupName, the last number was $NumLast, but the " .
- " last number in the directory was $NumLastInDir\n" }
- # Figure out which article to start from
- if($NumLastInDir == 0) { $GetArtNum = $NumFirst }
- else { $GetArtNum = $NumLastInDir + 1 }
-
- # Now read each of the new articles
- while(1) { # Loop until "last" is called
- $ArtRef = $NntpPtr->article($GetArtNum);
- @ArtArr = @$ArtRef; $ArtArrLen = @ArtArr;
- if($ArtArrLen > 0 ) { # Skip article numbers that had 0 len
- open(OUT, ">$GetArtNum") or
- die "Could not create $GroupName/$GetArtNum\n";
- print OUT @$ArtRef; close(OUT);
- }
-
- # Check if we're at the end
- if($GetArtNum == $NumLast) { last }
- $GetArtNum += 1; # Increment the article number to get
- }
-}
-
-$NntpPtr->quit;
-exit;
diff --git a/lib/Net/demos/pop3 b/lib/Net/demos/pop3
deleted file mode 100644
index 0ae07ae9c3..0000000000
--- a/lib/Net/demos/pop3
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/usr/local/bin/perl -w
-
-use blib;
-use Net::POP3;
-use Getopt::Long;
-
-$opt_debug = 0;
-$opt_user = undef;
-
-GetOptions(qw(debug user=s));
-
-$pop = Net::POP3->new('backup3', Debug => $opt_debug ? 6 : 0);
-
-$user = $opt_user || $ENV{USER} || $ENV{LOGNAME};
-
-$count = $pop->login($user);
-
-if($count)
- {
- $m = $pop->get(1);
- print @$m if $m;
- }
-
-$pop->quit;
diff --git a/lib/Net/demos/smtp.self b/lib/Net/demos/smtp.self
deleted file mode 100755
index 5cfbc2b824..0000000000
--- a/lib/Net/demos/smtp.self
+++ /dev/null
@@ -1,80 +0,0 @@
-#!/usr/local/bin/perl -w
-
-use blib;
-use Net::SMTP;
-use Getopt::Long;
-
-=head1 NAME
-
- smtp.self - mail a message via smtp
-
-=head1 DESCRIPTION
-
-C<smtp.self> will attempt to send a message to a given user
-
-=head1 OPTIONS
-
-=over 4
-
-=item -debug
-
-Enabe the output of dubug information
-
-=item -help
-
-Display this help text and quit
-
-=item -user USERNAME
-
-Send the message to C<USERNAME>
-
-=head1 EXAMPLE
-
- demos/smtp.self -user foo.bar
-
- demos/smtp.self -debug -user Graham.Barr
-
-=back
-
-=cut
-
-$opt_debug = undef;
-$opt_user = undef;
-$opt_help = undef;
-GetOptions(qw(debug user=s help));
-
-exec("pod2text $0")
- if defined $opt_help;
-
-Net::SMTP->debug(1) if $opt_debug;
-
-$smtp = Net::SMTP->new("mailhost");
-
-$user = $opt_user || $ENV{USER} || $ENV{LOGNAME};
-
-$smtp->mail($user) && $smtp->to($user);
-$smtp->reset;
-
-if($smtp->mail($user) && $smtp->to($user))
- {
- $smtp->data();
-
- map { s/-USER-/$user/g } @data=<DATA>;
-
- $smtp->datasend(@data);
- $smtp->dataend;
- }
-else
- {
- warn $smtp->message;
- }
-
-$smtp->quit;
-
-__DATA__
-To: <-USER->
-Subject: A test message
-
-The message was sent directly via SMTP using Net::SMTP
-.
-The message was sent directly via SMTP using Net::SMTP
diff --git a/lib/Net/demos/time b/lib/Net/demos/time
deleted file mode 100644
index 61095d3071..0000000000
--- a/lib/Net/demos/time
+++ /dev/null
@@ -1,13 +0,0 @@
-#!/usr/local/bin/perl -w
-
-use blib;
-use Net::Time qw(inet_time inet_daytime);
-
-print inet_daytime('localhost');
-print inet_daytime('localhost','tcp');
-print inet_daytime('localhost','udp');
-
-print inet_time('localhost'),"\n";
-print inet_time('localhost','tcp'),"\n";
-print inet_time('localhost','udp'),"\n";
-
diff --git a/lib/Net/libnetFAQ.pod b/lib/Net/libnetFAQ.pod
deleted file mode 100644
index e6ec362f36..0000000000
--- a/lib/Net/libnetFAQ.pod
+++ /dev/null
@@ -1,303 +0,0 @@
-=head1 NAME
-
-libnetFAQ - libnet Frequently Asked Questions
-
-=head1 DESCRIPTION
-
-=head2 Where to get this document
-
-This document is distributed with the libnet distribution, and is also
-available on the libnet web page at
-
- http://search.cpan.org/~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.
-This document is free; you can redistribute it and/or modify it
-under the terms of the Artistic License.
-
-=head2 Disclaimer
-
-This information is offered in good faith and in the hope that it may
-be of use, but is not guaranteed to be correct, up to date, or suitable
-for any particular purpose whatsoever. The authors accept no liability
-in respect of this information or its use.
-
-
-=head1 Obtaining and installing libnet
-
-=head2 What is libnet ?
-
-libnet is a collection of perl5 modules which all related to network
-programming. The majority of the modules available provided the
-client side of popular server-client protocols that are used in
-the internet community.
-
-=head2 Which version of perl do I need ?
-
-libnet has been know to work with versions of perl from 5.002 onwards. However
-if your release of perl is prior to perl5.004 then you will need to
-obtain and install the IO distribution from CPAN. If you have perl5.004
-or later then you will have the IO modules in your installation already,
-but CPAN may contain updates.
-
-=head2 What other modules do I need ?
-
-The only modules you will need installed are the modules from the IO
-distribution. If you have perl5.004 or later you will already have
-these modules.
-
-=head2 What machines support libnet ?
-
-libnet itself is an entirely perl-code distribution so it should work
-on any machine that perl runs on. However IO may not work
-with some machines and earlier releases of perl. But this
-should not be the case with perl version 5.004 or later.
-
-=head2 Where can I get the latest libnet release
-
-The latest libnet release is always on CPAN, you will find it
-in
-
- http://www.cpan.org/modules/by-module/Net/
-
-The latest release and information is also available on the libnet web page
-at
-
- http://search.cpan.org/~gbarr/libnet/
-
-=head1 Using Net::FTP
-
-=head2 How do I download files from an FTP server ?
-
-An example taken from an article posted to comp.lang.perl.misc
-
- #!/your/path/to/perl
-
- # a module making life easier
-
- use Net::FTP;
-
- # for debugging: $ftp = Net::FTP->new('site','Debug',10);
- # open a connection and log in!
-
- $ftp = Net::FTP->new('target_site.somewhere.xxx');
- $ftp->login('username','password');
-
- # set transfer mode to binary
-
- $ftp->binary();
-
- # change the directory on the ftp site
-
- $ftp->cwd('/some/path/to/somewhere/');
-
- foreach $name ('file1', 'file2', 'file3') {
-
- # get's arguments are in the following order:
- # ftp server's filename
- # filename to save the transfer to on the local machine
- # can be simply used as get($name) if you want the same name
-
- $ftp->get($name,$name);
- }
-
- # ftp done!
-
- $ftp->quit;
-
-=head2 How do I transfer files in binary mode ?
-
-To transfer files without <LF><CR> translation Net::FTP provides
-the C<binary> method
-
- $ftp->binary;
-
-=head2 How can I get the size of a file on a remote FTP server ?
-
-=head2 How can I get the modification time of a file on a remote FTP server ?
-
-=head2 How can I change the permissions of a file on a remote server ?
-
-The FTP protocol does not have a command for changing the permissions
-of a file on the remote server. But some ftp servers may allow a chmod
-command to be issued via a SITE command, eg
-
- $ftp->quot('site chmod 0777',$filename);
-
-But this is not guaranteed to work.
-
-=head2 Can I do a reget operation like the ftp command ?
-
-=head2 How do I get a directory listing from an FTP server ?
-
-=head2 Changing directory to "" does not fail ?
-
-Passing an argument of "" to ->cwd() has the same affect of calling ->cwd()
-without any arguments. Turn on Debug (I<See below>) and you will see what is
-happening
-
- $ftp = Net::FTP->new($host, Debug => 1);
- $ftp->login;
- $ftp->cwd("");
-
-gives
-
- Net::FTP=GLOB(0x82196d8)>>> CWD /
- Net::FTP=GLOB(0x82196d8)<<< 250 CWD command successful.
-
-=head2 I am behind a SOCKS firewall, but the Firewall option does not work ?
-
-The Firewall option is only for support of one type of firewall. The type
-supported is an ftp proxy.
-
-To use Net::FTP, or any other module in the libnet distribution,
-through a SOCKS firewall you must create a socks-ified perl executable
-by compiling perl with the socks library.
-
-=head2 I am behind an FTP proxy firewall, but cannot access machines outside ?
-
-Net::FTP implements the most popular ftp proxy firewall approach. The scheme
-implemented is that where you log in to the firewall with C<user@hostname>
-
-I have heard of one other type of firewall which requires a login to the
-firewall with an account, then a second login with C<user@hostname>. You can
-still use Net::FTP to traverse these firewalls, but a more manual approach
-must be taken, eg
-
- $ftp = Net::FTP->new($firewall) or die $@;
- $ftp->login($firewall_user, $firewall_passwd) or die $ftp->message;
- $ftp->login($ext_user . '@' . $ext_host, $ext_passwd) or die $ftp->message.
-
-=head2 My ftp proxy firewall does not listen on port 21
-
-FTP servers usually listen on the same port number, port 21, as any other
-FTP server. But there is no reason why this has to be the case.
-
-If you pass a port number to Net::FTP then it assumes this is the port
-number of the final destination. By default Net::FTP will always try
-to connect to the firewall on port 21.
-
-Net::FTP uses IO::Socket to open the connection and IO::Socket allows
-the port number to be specified as part of the hostname. So this problem
-can be resolved by either passing a Firewall option like C<"hostname:1234">
-or by setting the C<ftp_firewall> option in Net::Config to be a string
-in in the same form.
-
-=head2 Is it possible to change the file permissions of a file on an FTP server ?
-
-The answer to this is "maybe". The FTP protocol does not specify a command to change
-file permissions on a remote host. However many servers do allow you to run the
-chmod command via the C<SITE> command. This can be done with
-
- $ftp->site('chmod','0775',$file);
-
-=head2 I have seen scripts call a method message, but cannot find it documented ?
-
-Net::FTP, like several other packages in libnet, inherits from Net::Cmd, so
-all the methods described in Net::Cmd are also available on Net::FTP
-objects.
-
-=head2 Why does Net::FTP not implement mput and mget methods
-
-The quick answer is because they are easy to implement yourself. The long
-answer is that to write these in such a way that multiple platforms are
-supported correctly would just require too much code. Below are
-some examples how you can implement these yourself.
-
-sub mput {
- my($ftp,$pattern) = @_;
- foreach my $file (glob($pattern)) {
- $ftp->put($file) or warn $ftp->message;
- }
-}
-
-sub mget {
- my($ftp,$pattern) = @_;
- foreach my $file ($ftp->ls($pattern)) {
- $ftp->get($file) or warn $ftp->message;
- }
-}
-
-
-=head1 Using Net::SMTP
-
-=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,
-it is a mail domain. To find the name of a host to connect for a mail domain
-you need to do a DNS MX lookup
-
-=head2 Why does Net::SMTP not do DNS MX lookups ?
-
-Net::SMTP implements the SMTP protocol. The DNS MX lookup is not part
-of this protocol.
-
-=head2 The verify method always returns true ?
-
-Well it may seem that way, but it does not. The verify method returns true
-if the command succeeded. If you pass verify an address which the
-server would normally have to forward to another machine, the command
-will succeed with something like
-
- 252 Couldn't verify <someone@there> but will attempt delivery anyway
-
-This command will fail only if you pass it an address in a domain
-the server directly delivers for, and that address does not exist.
-
-=head1 Debugging scripts
-
-=head2 How can I debug my scripts that use Net::* modules ?
-
-Most of the libnet client classes allow options to be passed to the
-constructor, in most cases one option is called C<Debug>. Passing
-this option with a non-zero value will turn on a protocol trace, which
-will be sent to STDERR. This trace can be useful to see what commands
-are being sent to the remote server and what responses 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;
-
-this script would output something like
-
- Net::FTP: Net::FTP(2.22)
- Net::FTP: Exporter
- Net::FTP: Net::Cmd(2.0801)
- Net::FTP: IO::Socket::INET
- Net::FTP: IO::Socket(1.1603)
- Net::FTP: IO::Handle(1.1504)
-
- Net::FTP=GLOB(0x8152974)<<< 220 imagine FTP server (Version wu-2.4(5) Tue Jul 29 11:17:18 CDT 1997) ready.
- Net::FTP=GLOB(0x8152974)>>> user gbarr
- Net::FTP=GLOB(0x8152974)<<< 331 Password required for gbarr.
- Net::FTP=GLOB(0x8152974)>>> PASS ....
- Net::FTP=GLOB(0x8152974)<<< 230 User gbarr logged in. Access restrictions apply.
- Net::FTP=GLOB(0x8152974)>>> QUIT
- Net::FTP=GLOB(0x8152974)<<< 221 Goodbye.
-
-The first few lines tell you the modules that Net::FTP uses and their versions,
-this is useful data to me when a user reports a bug. The last seven lines
-show the communication with the server. Each line has three parts. The first
-part is the object itself, this is useful for separating the output
-if you are using multiple objects. The second part is either C<<<<<> to
-show data coming from the server or C<&gt&gt&gt&gt> to show data
-going to the server. The remainder of the line is the command
-being sent or response being received.
-
-=head1 AUTHOR AND COPYRIGHT
-
-Copyright (c) 1997 Graham Barr.
-All rights reserved.
-
diff --git a/lib/Net/t/config.t b/lib/Net/t/config.t
deleted file mode 100644
index 08df82b1ee..0000000000
--- a/lib/Net/t/config.t
+++ /dev/null
@@ -1,87 +0,0 @@
-#!./perl -w
-
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- @INC = '../lib';
- }
- if (!eval "require Socket") {
- print "1..0 # no Socket\n"; exit 0;
- }
- undef *{Socket::inet_aton};
- undef *{Socket::inet_ntoa};
- if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
- print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
- }
- $INC{'Socket.pm'} = 1;
-}
-
-package Socket;
-
-sub import {
- my $pkg = caller();
- no strict 'refs';
- *{ $pkg . '::inet_aton' } = \&inet_aton;
- *{ $pkg . '::inet_ntoa' } = \&inet_ntoa;
-}
-
-my $fail = 0;
-my %names;
-
-sub set_fail {
- $fail = shift;
-}
-
-sub inet_aton {
- return if $fail;
- my $num = unpack('N', pack('C*', split(/\./, $_[0])));
- $names{$num} = $_[0];
- return $num;
-}
-
-sub inet_ntoa {
- return if $fail;
- return $names{$_[0]};
-}
-
-package main;
-
-
-(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' );
-
-Socket::set_fail(1);
-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('a.host.not.there'), -1,
- '... should return -1 without a valid hostname' );
-
-Socket::set_fail(0);
-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/datasend.t b/lib/Net/t/datasend.t
deleted file mode 100644
index 96b5b7c619..0000000000
--- a/lib/Net/t/datasend.t
+++ /dev/null
@@ -1,159 +0,0 @@
-#!./perl -w
-
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- @INC = '../lib';
- }
- if (!eval "require Socket") {
- print "1..0 # no Socket\n"; exit 0;
- }
- if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
- print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
- }
-}
-
-BEGIN {
- package Foo;
-
- use IO::File;
- use Net::Cmd;
- @ISA = qw(Net::Cmd IO::File);
-
- sub timeout { 0 }
-
- sub new {
- my $fh = shift->new_tmpfile;
- binmode($fh);
- $fh;
- }
-
- sub output {
- my $self = shift;
- seek($self,0,0);
- local $/ = undef;
- scalar(<$self>);
- }
-
- sub response {
- return Net::Cmd::CMD_OK;
- }
-}
-
-(my $libnet_t = __FILE__) =~ s/datasend.t/libnet_t.pl/;
-require $libnet_t or die;
-
-print "1..51\n";
-
-sub check {
- my $expect = pop;
- my $cmd = Foo->new;
- ok($cmd->datasend, 'datasend') unless @_;
- foreach my $line (@_) {
- ok($cmd->datasend($line), 'datasend');
- }
- ok($cmd->dataend, 'dataend');
- is(
- unpack("H*",$cmd->output),
- unpack("H*",$expect)
- );
-}
-
-my $cmd;
-
-check(
- # nothing
-
- ".\015\012"
-);
-
-check(
- "a",
-
- "a\015\012.\015\012",
-);
-
-check(
- "a\r",
-
- "a\015\015\012.\015\012",
-);
-
-check(
- "a\rb",
-
- "a\015b\015\012.\015\012",
-);
-
-check(
- "a\rb\n",
-
- "a\015b\015\012.\015\012",
-);
-
-check(
- "a\rb\n\n",
-
- "a\015b\015\012\015\012.\015\012",
-);
-
-check(
- "a\r",
- "\nb",
-
- "a\015\012b\015\012.\015\012",
-);
-
-check(
- "a\r",
- "\nb\n",
-
- "a\015\012b\015\012.\015\012",
-);
-
-check(
- "a\r",
- "\nb\r\n",
-
- "a\015\012b\015\012.\015\012",
-);
-
-check(
- "a\r",
- "\nb\r\n\n",
-
- "a\015\012b\015\012\015\012.\015\012",
-);
-
-check(
- "a\n.b\n",
-
- "a\015\012..b\015\012.\015\012",
-);
-
-check(
- ".a\n.b\n",
-
- "..a\015\012..b\015\012.\015\012",
-);
-
-check(
- ".a\n",
- ".b\n",
-
- "..a\015\012..b\015\012.\015\012",
-);
-
-check(
- ".a",
- ".b\n",
-
- "..a.b\015\012.\015\012",
-);
-
-check(
- "a\n.",
-
- "a\015\012..\015\012.\015\012",
-);
-
diff --git a/lib/Net/t/ftp.t b/lib/Net/t/ftp.t
deleted file mode 100644
index 32d750efe8..0000000000
--- a/lib/Net/t/ftp.t
+++ /dev/null
@@ -1,73 +0,0 @@
-#!./perl -w
-
-BEGIN {
- unless (-d 'blib') {
- chdir 't' if -d 't';
- @INC = '../lib';
- }
- if (!eval "require Socket") {
- print "1..0 # no Socket\n"; exit 0;
- }
- if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
- print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
- }
-}
-
-use Net::Config;
-use Net::FTP;
-
-unless(defined($NetConfig{ftp_testhost}) && $NetConfig{test_hosts}) {
- print "1..0\n";
- exit 0;
-}
-
-my $t = 1;
-print "1..7\n";
-
-$ftp = Net::FTP->new($NetConfig{ftp_testhost})
- or (print("not ok 1\n"), exit);
-
-printf "ok %d\n",$t++;
-
-$ftp->login('anonymous') or die($ftp->message . "\n");
-printf "ok %d\n",$t++;
-
-$ftp->pwd or do {
- print STDERR $ftp->message,"\n";
- print "not ";
-};
-
-printf "ok %d\n",$t++;
-
-$ftp->cwd('/pub') or do {
- print STDERR $ftp->message,"\n";
- print "not ";
-};
-
-if ($data = $ftp->stor('libnet.tst')) {
- my $text = "abc\ndef\nqwe\n";
- printf "ok %d\n",$t++;
- $data->write($text,length $text);
- $data->close;
- $data = $ftp->retr('libnet.tst');
- $data->read($buf,length $text);
- $data->close;
- print "not " unless $text eq $buf;
- printf "ok %d\n",$t++;
- $ftp->delete('libnet.tst') or print "not ";
- printf "ok %d\n",$t++;
-
-}
-else {
- print "# ",$ftp->message,"\n";
- printf "ok %d\n",$t++;
- printf "ok %d\n",$t++;
- printf "ok %d\n",$t++;
-}
-
-$ftp->quit or do {
- print STDERR $ftp->message,"\n";
- print "not ";
-};
-
-printf "ok %d\n",$t++;
diff --git a/lib/Net/t/hostname.t b/lib/Net/t/hostname.t
deleted file mode 100644
index 4013d74aab..0000000000
--- a/lib/Net/t/hostname.t
+++ /dev/null
@@ -1,61 +0,0 @@
-#!./perl -w
-
-BEGIN {
- unless (-d 'blib') {
- chdir 't' if -d 't';
- @INC = '../lib';
- }
- if (!eval "require Socket") {
- print "1..0 # no Socket\n"; exit 0;
- }
- if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
- print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
- }
-}
-
-use Net::Domain qw(hostname domainname hostdomain hostfqdn);
-use Net::Config;
-
-unless($NetConfig{test_hosts}) {
- print "1..0\n";
- exit 0;
-}
-
-print "1..5\n";
-
-$domain = domainname();
-
-if(defined $domain && $domain ne "") {
- print "ok 1 - defined, non-empty domainname\n";
-}
-elsif (not defined $domain) {
- print "ok 1 # SKIP domain not fully defined\n";
-}
-else {
- print "not ok 1\n";
-}
-
-# This checks thats hostanme does not overwrite $_
-my @domain = qw(foo.example.com bar.example.jp);
-my @copy = @domain;
-
-my @dummy = grep { defined hostname() and hostname() eq $_ } @domain;
-
-($domain[0] && $domain[0] eq $copy[0])
- ? print "ok 2\n"
- : print "not ok 2\n";
-
-@dummy = grep { defined hostdomain() and hostdomain() eq $_ } @domain;
-
-($domain[0] && $domain[0] eq $copy[0])
- ? print "ok 3\n"
- : print "not ok 3\n";
-
-my $name = hostname();
-my $domain = hostdomain();
-if(defined $domain && defined $name && $name ne "" && $domain ne "") {
- hostfqdn() eq $name . "." . $domain ? print "ok 4\n" : print "not ok 4\n";
- domainname() eq $name . "." . $domain ? print "ok 5\n" : print "not ok 5\n";} else {
- print "ok 4 # SKIP domain not fully defined\n";
- print "ok 5 # SKIP domain not fully defined\n";
-}
diff --git a/lib/Net/t/libnet_t.pl b/lib/Net/t/libnet_t.pl
deleted file mode 100644
index ed245e6502..0000000000
--- a/lib/Net/t/libnet_t.pl
+++ /dev/null
@@ -1,37 +0,0 @@
-
-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/netrc.t b/lib/Net/t/netrc.t
deleted file mode 100644
index cb5c35d907..0000000000
--- a/lib/Net/t/netrc.t
+++ /dev/null
@@ -1,155 +0,0 @@
-#!./perl
-
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- @INC = '../lib';
- }
- if (!eval "require Socket") {
- print "1..0 # no Socket\n"; exit 0;
- }
- if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
- print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
- }
-}
-
-use strict;
-
-use Cwd;
-print "1..20\n";
-
-# for testing _readrc
-$ENV{HOME} = Cwd::cwd();
-
-# avoid "used only once" warning
-local (*CORE::GLOBAL::getpwuid, *CORE::GLOBAL::stat);
-
-*CORE::GLOBAL::getpwuid = sub ($) {
- ((undef) x 7, Cwd::cwd());
-};
-
-# for testing _readrc
-my @stat;
-*CORE::GLOBAL::stat = sub (*) {
- return @stat;
-};
-
-# for testing _readrc
-$INC{'FileHandle.pm'} = 1;
-
-(my $libnet_t = __FILE__) =~ s/\w+.t$/libnet_t.pl/;
-require $libnet_t;
-
-# now that the tricks are out of the way...
-eval { require Net::Netrc; };
-ok( !$@, 'should be able to require() Net::Netrc safely' );
-ok( exists $INC{'Net/Netrc.pm'}, 'should be able to use Net::Netrc' );
-
-SKIP: {
- skip('incompatible stat() handling for OS', 4), next SKIP
- if ($^O =~ /os2|win32|macos|cygwin/i or $] < 5.005);
-
- my $warn;
- local $SIG{__WARN__} = sub {
- $warn = shift;
- };
-
- # add write access for group/other
- $stat[2] = 077;
- ok( !defined(Net::Netrc::_readrc()),
- '_readrc() should not read world-writable file' );
- ok( scalar($warn =~ /^Bad permissions:/),
- '... and should warn about it' );
-
- # the owner field should still not match
- $stat[2] = 0;
-
- if ($<) {
- ok( !defined(Net::Netrc::_readrc()),
- '_readrc() should not read file owned by someone else' );
- ok( scalar($warn =~ /^Not owner:/),
- '... and should warn about it' );
- } else {
- skip("testing as root",2);
- }
-}
-
-# this field must now match, to avoid the last-tested warning
-$stat[4] = $<;
-
-# this curious mix of spaces and quotes tests a regex at line 79 (version 2.11)
-FileHandle::set_lines(split(/\n/, <<LINES));
-macdef bar
-login baz
- machine "foo"
-login nigol "password" drowssap
-machine foo "login" l2
- password p2
-account tnuocca
-default login "baz" password p2
-default "login" baz password p3
-macdef
-LINES
-
-# having set several lines and the uid, this should succeed
-is( Net::Netrc::_readrc(), 1, '_readrc() should succeed now' );
-
-# on 'foo', the login is 'nigol'
-is( Net::Netrc->lookup('foo')->{login}, 'nigol',
- 'lookup() should find value by host name' );
-
-# on 'foo' with login 'l2', the password is 'p2'
-is( Net::Netrc->lookup('foo', 'l2')->{password}, 'p2',
- 'lookup() should find value by hostname and login name' );
-
-# the default password is 'p3', as later declarations have priority
-is( Net::Netrc->lookup()->{password}, 'p3',
- 'lookup() should find default value' );
-
-# lookup() ignores the login parameter when using default data
-is( Net::Netrc->lookup('default', 'baz')->{password}, 'p3',
- 'lookup() should ignore passed login when searching default' );
-
-# lookup() goes to default data if hostname cannot be found in config data
-is( Net::Netrc->lookup('abadname')->{login}, 'baz',
- 'lookup() should use default for unknown machine name' );
-
-# now test these accessors
-my $instance = bless({}, 'Net::Netrc');
-for my $accessor (qw( login account password )) {
- is( $instance->$accessor(), undef,
- "$accessor() should return undef if $accessor is not set" );
- $instance->{$accessor} = $accessor;
- is( $instance->$accessor(), $accessor,
- "$accessor() should return value when $accessor is set" );
-}
-
-# and the three-for-one accessor
-is( scalar( () = $instance->lpa()), 3,
- 'lpa() should return login, password, account');
-is( join(' ', $instance->lpa), 'login password account',
- 'lpa() should return appropriate values for l, p, and a' );
-
-package FileHandle;
-
-sub new {
- tie *FH, 'FileHandle', @_;
- bless \*FH, $_[0];
-}
-
-sub TIEHANDLE {
- my ($class, $file, $mode) = @_[0,2,3];
- bless({ file => $file, mode => $mode }, $class);
-}
-
-my @lines;
-sub set_lines {
- @lines = @_;
-}
-
-sub READLINE {
- shift @lines;
-}
-
-sub close { 1 }
-
diff --git a/lib/Net/t/nntp.t b/lib/Net/t/nntp.t
deleted file mode 100644
index 7fb99de62c..0000000000
--- a/lib/Net/t/nntp.t
+++ /dev/null
@@ -1,59 +0,0 @@
-#!./perl -w
-
-BEGIN {
- unless (-d 'blib') {
- chdir 't' if -d 't';
- @INC = '../lib';
- }
- if (!eval "require Socket") {
- print "1..0 # no Socket\n"; exit 0;
- }
- if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
- print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
- }
-}
-
-use Net::Config;
-use Net::NNTP;
-use Net::Cmd qw(CMD_REJECT);
-
-unless(@{$NetConfig{nntp_hosts}} && $NetConfig{test_hosts}) {
- print "1..0\n";
- exit;
-}
-
-print "1..4\n";
-
-my $i = 1;
-
-$nntp = Net::NNTP->new(Debug => 0)
- or (print("not ok 1\n"), exit);
-
-print "ok 1\n";
-
-my $grp;
-foreach $grp (qw(test alt.test control news.announce.newusers)) {
- @grp = $nntp->group($grp);
- last if @grp;
-}
-
-if($nntp->status == CMD_REJECT) {
- # Command was rejected, probably because we need authinfo
- map { print "ok ",$_,"\n" } 2,3,4;
- exit;
-}
-
-print "not " unless @grp;
-print "ok 2\n";
-
-
-if(@grp && $grp[2] > $grp[1]) {
- $nntp->head($grp[1]) or print "not ";
-}
-print "ok 3\n";
-
-if(@grp) {
- $nntp->quit or print "not ";
-}
-print "ok 4\n";
-
diff --git a/lib/Net/t/require.t b/lib/Net/t/require.t
deleted file mode 100644
index 163c8bd801..0000000000
--- a/lib/Net/t/require.t
+++ /dev/null
@@ -1,28 +0,0 @@
-#!./perl -w
-
-BEGIN {
- unless (-d 'blib') {
- chdir 't' if -d 't';
- @INC = '../lib';
- }
- if (!eval "require Socket") {
- print "1..0 # no Socket\n"; exit 0;
- }
- if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
- print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
- }
-}
-
-print "1..9\n";
-my $i = 1;
-eval { require Net::Config; } || print "not "; print "ok ",$i++,"\n";
-eval { require Net::Domain; } || print "not "; print "ok ",$i++,"\n";
-eval { require Net::Cmd; } || print "not "; print "ok ",$i++,"\n";
-eval { require Net::Netrc; } || print "not "; print "ok ",$i++,"\n";
-eval { require Net::FTP; } || print "not "; print "ok ",$i++,"\n";
-eval { require Net::SMTP; } || print "not "; print "ok ",$i++,"\n";
-eval { require Net::NNTP; } || print "not "; print "ok ",$i++,"\n";
-eval { require Net::POP3; } || print "not "; print "ok ",$i++,"\n";
-eval { require Net::Time; } || print "not "; print "ok ",$i++,"\n";
-
-
diff --git a/lib/Net/t/smtp.t b/lib/Net/t/smtp.t
deleted file mode 100644
index ac2df6c8b9..0000000000
--- a/lib/Net/t/smtp.t
+++ /dev/null
@@ -1,38 +0,0 @@
-#!./perl -w
-
-BEGIN {
- unless (-d 'blib') {
- chdir 't' if -d 't';
- @INC = '../lib';
- }
- if (!eval "require Socket") {
- print "1..0 # no Socket\n"; exit 0;
- }
- if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
- print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
- }
-}
-
-use Net::Config;
-use Net::SMTP;
-
-unless(@{$NetConfig{smtp_hosts}} && $NetConfig{test_hosts}) {
- print "1..0\n";
- exit 0;
-}
-
-print "1..3\n";
-
-my $i = 1;
-
-$smtp = Net::SMTP->new(Debug => 0)
- or (print("not ok 1\n"), exit);
-
-print "ok 1\n";
-
-$smtp->domain or print "not ";
-print "ok 2\n";
-
-$smtp->quit or print "not ";
-print "ok 3\n";
-
diff --git a/lib/Net/t/time.t b/lib/Net/t/time.t
deleted file mode 100644
index a8d416eea2..0000000000
--- a/lib/Net/t/time.t
+++ /dev/null
@@ -1,133 +0,0 @@
-#!./perl -w
-
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- @INC = '../lib';
- }
- if (!eval "require Socket") {
- print "1..0 # no Socket\n"; exit 0;
- }
- if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
- print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
- }
- $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;