This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Initial integration of libnet-1.0703.
authorJarkko Hietaniemi <jhi@iki.fi>
Sun, 17 Jun 2001 16:53:29 +0000 (16:53 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Sun, 17 Jun 2001 16:53:29 +0000 (16:53 +0000)
The Configure script renamed as libnetcfg, will be
installed along other utilities.

p4raw-id: //depot/perl@10663

42 files changed:
MANIFEST
lib/Net/ChangeLog.libnet [new file with mode: 0644]
lib/Net/Cmd.pm [new file with mode: 0644]
lib/Net/Config.eg [new file with mode: 0644]
lib/Net/Config.pm [new file with mode: 0644]
lib/Net/Domain.pm [new file with mode: 0644]
lib/Net/DummyInetd.pm [new file with mode: 0644]
lib/Net/FTP.pm [new file with mode: 0644]
lib/Net/FTP/A.pm [new file with mode: 0644]
lib/Net/FTP/E.pm [new file with mode: 0644]
lib/Net/FTP/I.pm [new file with mode: 0644]
lib/Net/FTP/L.pm [new file with mode: 0644]
lib/Net/FTP/dataconn.pm [new file with mode: 0644]
lib/Net/Hostname.eg [new file with mode: 0644]
lib/Net/NNTP.pm [new file with mode: 0644]
lib/Net/Netrc.pm [new file with mode: 0644]
lib/Net/PH.pm [new file with mode: 0644]
lib/Net/POP3.pm [new file with mode: 0644]
lib/Net/README.config [new file with mode: 0644]
lib/Net/README.libnet [new file with mode: 0644]
lib/Net/SMTP.pm [new file with mode: 0644]
lib/Net/SNPP.pm [new file with mode: 0644]
lib/Net/Time.pm [new file with mode: 0644]
lib/Net/demos/ftp [new file with mode: 0755]
lib/Net/demos/inetd [new file with mode: 0644]
lib/Net/demos/nntp [new file with mode: 0755]
lib/Net/demos/nntp.mirror [new file with mode: 0644]
lib/Net/demos/pop3 [new file with mode: 0644]
lib/Net/demos/smtp.self [new file with mode: 0755]
lib/Net/demos/snpp [new file with mode: 0755]
lib/Net/demos/time [new file with mode: 0644]
lib/Net/libnet.ppd [new file with mode: 0644]
lib/Net/libnetFAQ.pod [new file with mode: 0644]
lib/Net/t/ftp.t [new file with mode: 0644]
lib/Net/t/hostname.t [new file with mode: 0644]
lib/Net/t/nntp.t [new file with mode: 0644]
lib/Net/t/ph.t [new file with mode: 0644]
lib/Net/t/require.t [new file with mode: 0644]
lib/Net/t/smtp.t [new file with mode: 0644]
utils.lst
utils/Makefile
utils/libnetcfg.PL [new file with mode: 0644]

index a4c63cf..5785ce3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -878,11 +878,49 @@ lib/Memoize/t/tie_storable.t      Memoize
 lib/Memoize/t/tiefeatures.t    Memoize
 lib/Memoize/t/unmemoize.t      Memoize
 lib/NEXT.pm            Pseudo-class NEXT for method redispatch
+lib/Net/ChangeLog.libnet       libnet
+lib/Net/Cmd.pm libnet
+lib/Net/Config.eg      libnet
+lib/Net/Config.pm      libnet
+lib/Net/Domain.pm      libnet
+lib/Net/DummyInetd.pm  libnet
+lib/Net/FTP.pm libnet
+lib/Net/FTP/A.pm       libnet
+lib/Net/FTP/E.pm       libnet
+lib/Net/FTP/I.pm       libnet
+lib/Net/FTP/L.pm       libnet
+lib/Net/FTP/dataconn.pm        libnet
+lib/Net/Hostname.eg    libnet
+lib/Net/NNTP.pm        libnet
+lib/Net/Netrc.pm       libnet
+lib/Net/PH.pm  libnet
+lib/Net/POP3.pm        libnet
 lib/Net/Ping.pm                Hello, anybody home?
+lib/Net/README.config  libnet
+lib/Net/README.libnet  libnet
+lib/Net/SMTP.pm        libnet
+lib/Net/SNPP.pm        libnet
+lib/Net/Time.pm        libnet
+lib/Net/demos/ftp      libnet
+lib/Net/demos/inetd    libnet
+lib/Net/demos/nntp     libnet
+lib/Net/demos/nntp.mirror      libnet
+lib/Net/demos/pop3     libnet
+lib/Net/demos/smtp.self        libnet
+lib/Net/demos/snpp     libnet
+lib/Net/demos/time     libnet
 lib/Net/hostent.pm     By-name interface to Perl's builtin gethost*
+lib/Net/libnet.ppd     libnet
+lib/Net/libnetFAQ.pod  libnet
 lib/Net/netent.pm      By-name interface to Perl's builtin getnet*
 lib/Net/protoent.pm    By-name interface to Perl's builtin getproto*
 lib/Net/servent.pm     By-name interface to Perl's builtin getserv*
+lib/Net/t/ftp.t        libnet
+lib/Net/t/hostname.t   libnet
+lib/Net/t/nntp.t       libnet
+lib/Net/t/ph.t libnet
+lib/Net/t/require.t    libnet
+lib/Net/t/smtp.t       libnet
 lib/PerlIO.pm          PerlIO support module
 lib/Pod/Checker.pm     Pod-Parser - check POD documents for syntax errors
 lib/Pod/Find.pm                used by pod/splitpod
@@ -1998,6 +2036,7 @@ utils/c2ph.PL             program to translate dbx stabs to perl
 utils/dprofpp.PL       Perl code profile post-processor
 utils/h2ph.PL          A thing to turn C .h files into perl .ph files
 utils/h2xs.PL          Program to make .xs files from C header files
+utils/libnetcfg.PL     libnet
 utils/perlbug.PL       A simple tool to submit a bug report
 utils/perlcc.PL                Front-end for compiler
 utils/perldoc.PL       A simple tool to find & display perl's documentation
diff --git a/lib/Net/ChangeLog.libnet b/lib/Net/ChangeLog.libnet
new file mode 100644 (file)
index 0000000..ccfcac5
--- /dev/null
@@ -0,0 +1,717 @@
+Change 402 on 2000/03/23 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Config
+       - Fix typos in requires_firewall(), Thanks to Johan Vromans <jvromans@squirrel.nl>
+
+Change 401 on 2000/03/23 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - fix rmdir for when ls() returns full paths
+
+Change 379 on 2000/03/13 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.0702
+
+Change 378 on 2000/03/10 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP::A
+       - Fix to stop possible forever loop
+
+Change 377 on 2000/03/10 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP::A
+       - use " not '
+
+Change 376 on 2000/03/10 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Config
+       - need to import inet_aton and inet_ntoa
+
+Change 375 on 2000/03/10 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Config
+       - change arg to split to /\./ from "."
+
+Change 374 on 2000/03/07 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP::A
+       - Fix return value of read()
+
+Change 373 on 2000/03/07 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP::I
+       - Fix typo
+
+Change 372 on 2000/03/07 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.07
+
+Change 371 on 2000/03/06 by <gbarr@pobox.com> (Graham Barr)
+
+       - Moved FAQ to Net/libnetFAQ.pod
+
+Change 370 on 2000/03/06 by <gbarr@pobox.com> (Graham Barr)
+
+       - Added mput and mget examples
+
+Change 369 on 2000/03/06 by <gbarr@pobox.com> (Graham Barr)
+
+       - Added support for the xwho command in qpage, but no docs yet.
+
+Change 368 on 2000/03/06 by <gbarr@pobox.com> (Graham Barr)
+
+       new Configure script
+
+Change 367 on 2000/03/06 by <gbarr@pobox.com> (Graham Barr)
+
+       Local-ize $SIG{__DIE__}
+
+Change 361 on 2000/02/17 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Fix arg count check in cwd()
+
+Change 351 on 2000/01/31 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Cmd
+       - Fixed bug in getline returning an empty line
+       - Added optional filehandle argument to read_until_dot.
+       
+       Net::POP3
+       - get now takes an optional filehandle argument, if given the
+         message is sent to the handle.
+
+Change 348 on 2000/01/17 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Cmd
+       - fix getline not to drop blank lines
+
+Change 347 on 2000/01/12 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Time
+       - Fix use of uninitialized warning caused by _socket
+
+Change 346 on 2000/01/11 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Change firewall code to use Net::Config->requires_firewall
+       
+       Net::Config
+       - renamed is_external to be requires_firewall
+
+Change 345 on 2000/01/06 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Added workaround for a Y2K bug that exists with the MDTM
+         command on some servers.
+
+Change 341 on 1999/09/29 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP, Net::FTP::A, Net::FTP::I, Net::FTP::datacon
+       - Added BlockSize option to control size of blocks read from server
+         (defaults to 10K)
+
+Change 340 on 1999/09/28 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP, Configure
+       - First attempt to add multiple firewall type support
+
+Change 339 on 1999/09/28 by <gbarr@pobox.com> (Graham Barr)
+
+       Added ppd info to Makefile.PL and libnet.ppd to MANIFEST
+
+Change 333 on 1999/09/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.0607
+
+Change 332 on 1999/09/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Configure
+       - Fix typo
+
+Change 331 on 1999/09/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - get and put now accept *FD as well as \*FD for the local filehandle
+
+Change 330 on 1999/09/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Domain
+       - Added support for VMS as suggest by lane@DUPHY4.Physics.Drexel.Edu
+
+Change 329 on 1999/09/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Netrc
+       - Added support for spaces in passwords
+
+Change 328 on 1999/09/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Cmd
+       - Map \n's in commands to " "
+
+Change 327 on 1999/09/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Netrc
+       - Applied patch from Randy Merrell to fix / escaping
+
+Change 318 on 1999/08/06 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Cmd
+       - Remove use of defined(@ISA)
+
+Change 316 on 1999/07/11 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::POP3
+       - Added ping method supplied by William Rolston <rolston@freerealtime.com>
+
+Change 309 on 1999/05/05 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Check that writes to local file succeed
+
+Change 308 on 1999/05/05 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Fix bug ->size when SIZE and STAT are not implemented
+
+Change 307 on 1999/05/05 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::POP3
+       - The return value for apop is now the same as login
+
+Change 306 on 1999/05/05 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::POP3
+       - login now returns "0E0" when there are no messages on te server.
+         This is true in a boolean context, but zero in a numeric context
+
+Change 305 on 1999/05/05 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP::A
+       - Fixed bug when sending a file in ascii mode that already contains
+         \r\n character sequences
+       - Made improvements to speed of \r\n <-> \n translation
+
+Change 304 on 1999/05/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Added hash mark printing
+
+Change 264 on 1999/03/17 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::TFTP
+       - Fix typo in CLOSE()
+
+Change 262 on 1999/03/16 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - new should only call authorize if there is user/passwd data
+       
+       Net::SMTP
+       - Allow ->to to ignore bad addresses
+
+Change 254 on 1999/02/24 by <gbarr@pobox.com> (Graham Barr)
+
+       Added some debug to t/ftp.t to help understand failure
+
+Change 253 on 1999/02/17 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Cmd
+       - Added checks for a closed connection
+
+Change 252 on 1999/02/17 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Domain
+       - set FQDN = IP if host does not have a name
+
+Change 248 on 1999/02/05 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Domain
+       - check for defined(&main::SYS_gethostname) before calling syscall
+         as user may have a UNIVERSAL::AUTOLOADER defined
+
+Change 245 on 1999/01/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Modify mkdir to call ->cwd(), not ->cd()
+
+Change 206 on 1998/10/20 by <gbarr@pobox.com> (Graham Barr)
+
+       Fix typo in Net::Cmd
+
+Change 204 on 1998/10/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::SMTP
+       - DESTROY now does nothing, so any half-sent message should be aborted
+
+Change 198 on 1998/10/15 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Config added
+       
+       Configure, Makefile.PL
+       - Canges to handle new Net::Config module
+
+Change 197 on 1998/10/15 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Fixed return vlue of _ACCT
+       
+       Net::Cmd
+       - Fixed datasend to ensure all data is sent
+       - Fixed a || bug in getline
+       
+       Some FAQ updates
+
+Change 196 on 1998/10/15 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::TFTP
+       - Initial public release
+
+Change 195 on 1998/10/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Fixed bad use of ||= in cwd()
+       
+       Net::POP3
+       - Fixed pattern for -ERR (had +ERR)
+
+Change 191 on 1998/09/26 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::POP3
+       - Fix bug in UIDL
+
+Change 187 on 1998/09/01 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::TFTP
+       - Some cleanup of the code
+       - removed leading - from named args
+
+Change 185 on 1998/08/23 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::TFTP
+       - Initial version
+
+Change 184 on 1998/08/23 by <gbarr@pobox.com> (Graham Barr)
+
+       Remove mention of Net::SNMP from README
+
+Change 183 on 1998/08/06 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Domain
+       - Fix problem with returning last name instead of first name for a
+         win32 multi-homed machine
+
+Change 182 on 1998/08/06 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - _list_cmd returned (undef) instead of ()
+       - Fix typo in docs
+       
+       Net::NNTP
+       - Fix typo in docs
+
+Change 181 on 1998/08/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Allow spaces in filenames (ick!)
+
+Change 179 on 1998/08/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - added new rmdir from Dunkin Software
+       - fix to the code generating the listen port
+
+Change 171 on 1998/07/08 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - login will now send ACCT if $acct is defined and the PASS
+         command completed with 2xx or 3xx
+       - Added a check for the close of the dataconn in _store_cmd
+       - Debug trace will hide any parameter given to ACCT
+
+Change 167 on 1998/07/04 by <gbarr@pobox.com> (Graham Barr)
+
+       - Added Config.eg, an example Config.pm
+       - Removed set method from Net::Config
+       - Removed check for Data::Dumper from Makefile.PL
+
+Change 157 on 1998/06/19 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Another small tweak to ->supported()
+
+Change 156 on 1998/06/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Tweak to ->supported() to better detect reports from some
+         servers (NcFTPd)
+
+Change 153 on 1998/06/16 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Fix "Use of uninitialized" warning, patch from
+         Lars Thegler <lth@dannet.dk>
+
+Change 148 on 1998/06/07 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::SMTP
+       - Fix typo
+
+Change 147 on 1998/06/07 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::SMTP
+       - Added ->supports()
+       - Added ->etrn()
+       
+       Updated FAQ
+
+Change 141 on 1998/05/24 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::SMTP
+       - Added banner() method
+
+Change 132 on 1998/04/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::POP3
+       - Added ResvPort option to new()
+
+Change 131 on 1998/04/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Makefile.PL
+       - Patch for running $^X Configure under VMS
+
+Change 130 on 1998/04/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP, Net::POP3
+       - wrapped getpwuid in eval {} as some OSs (eg NT) do not support it
+
+Change 129 on 1998/04/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Enhanced ->size() to try different approaces if SIZE is
+         not implemented
+
+Change 128 on 1998/04/15 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Time
+       - Correct number of seconds in a year
+
+Change 126 on 1998/04/06 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP, Net::FTP::A, Net::FTP::I, Net::Cmd
+       - changes for undef checking on sysread/syswrite
+
+Change 118 on 1998/02/23 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Added site method
+
+Change 117 on 1998/02/23 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::POP3
+       - Remove use of map in a void context
+
+Change 116 on 1998/02/21 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Changes to mkdir for recursive creates.
+
+Change 114 on 1998/02/20 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Domain
+       - Change $SIG{__DIE__} to $SIG{'__DIE__'} to stop warning in 5.003
+
+Change 113 on 1998/02/17 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP::A
+       - modified regexp in write for converting to CRLF, should now work with MacOS
+       
+       Net::FTP
+       - Added use of File::Basename
+       - Small tweak to abort()
+       
+       Net::Time
+       - Changed inet_time to handle MacOS
+       
+       Net::Netrc
+       - Fixes for MacOS
+       
+       Net::Domain
+       - Fixes for MacOS
+       
+       Net::SMTP
+       - Fix for new() to fail if HELO command fails
+
+Change 108 on 1998/02/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Added check for filenames with spaces, \r or \n
+
+Change 107 on 1998/02/06 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Ensure dataconn object is in reading mode for data transfers
+
+Change 101 on 1998/01/22 by <gbarr@pobox.com> (Graham Barr)
+
+       Renamed FAQ.pod as FAQ
+
+Change 100 on 1998/01/22 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::NNTP
+       - Added Reader option to new()
+
+Change 99 on 1998/01/22 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::POP3
+       - fix pass() to call popstat() if pattern does not match for
+         message count
+
+Change 98 on 1998/01/22 by <gbarr@pobox.com> (Graham Barr)
+
+       Restore changes lost in disk-crash
+       
+       *** Patch 1.0605
+       
+       Sun Dec 21 1997 <gbarr@pobox.com> (Graham Barr)
+       
+       Net::FTP
+       - Fix for pasv_xfer, previous version hung if an error occured
+         while setting up the link between the two servers.
+       
+       Sun Dec 14 1997 <gbarr@pobox.com> (Graham Barr)
+       
+       Net::Domain
+       - Fix for 'Use of uninitialized' when setting $SIG{__DIE__}
+       
+       Sat Dec 13 1997 <gbarr@pobox.com> (Graham Barr)
+       
+       Net::Domain, Net::Netrc
+       - patches from Nick Ing-Simmons for MSWin32
+       
+       *** Patch 1.0604
+       
+       Thu Dec 11 1997 <gbarr@pobox.com> (Graham Barr)
+       
+       Net::FTP
+       - Removed use of AutoLoader, it was causing problems on
+         some platforms
+
+Change 92 on 1997/12/08 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Fix to pasv_xfer, the command stream on the source side was left
+         out of sync.
+
+Change 91 on 1997/12/04 by <gbarr@pobox.com> (Graham Barr)
+
+       MANIFEST, FAQ.pod
+       - Added initial FAQ document
+
+Change 90 on 1997/12/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Set $@ if ->new() fails
+
+Change 82 on 1997/11/30 by <gbarr@pobox.com> (Graham Barr)
+
+       x
+
+Change 79 on 1997/11/30 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Cmd
+       - Fix for read_until_dot entering an endless loop, now returns undef
+       
+       Net::POP3
+       - Fix ->list() and ->uidl() to handle undef being returned from
+         ->read_until_dot()
+
+Change 78 on 1997/11/30 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Fix to login() and authorize() for OS/2 which does not
+         support getpw*()
+
+Change 65 on 1997/11/28 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Domain
+       - If user has defined $SIG{__DIE__} then failures inside eval
+         still call it. local-ized $SIG{__DIE__} to stop this as Net::Domain
+         used eval to hide such errors.
+
+Change 64 on 1997/11/28 by <gbarr@pobox.com> (Graham Barr)
+
+       t/nntp.t
+       - Now exits passing if commands fail due to not having
+         authorization.
+
+Change 61 on 1997/11/25 by <gbarr@pobox.com> (Graham Barr)
+
+       none
+
+Change 60 on 1997/11/25 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP::I
+       - Fix to prevent ABOR being sent when xfer is complete
+       - Change to write() to ensure whole packet is sent
+       
+       Net::FTP
+       - Moved $TELNET_ vars to top of file so that  autosplit does not place them
+         in the wrong file and cause "Use of undefined ...."
+       - Clarification on the result from ->size() added to docs.
+       - pasv_xfer changed to use stor as stou is not a "MUST-have" command
+       - added pasv_xfer_unique
+       
+       Net::PH
+       - Documentation updates.
+       
+       t/nntp.t
+       - Modified to test for a list of groups
+
+Change 58 on 1997/11/17 by <gbarr@pobox.com> (Graham Barr)
+
+       t/nntp.t
+       - Modified to check for more groups before failure
+
+Change 56 on 1997/11/17 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::SMTP
+       - Corrected documentation for ->expand()
+
+Change 54 on 1997/11/17 by <gbarr@pobox.com> (Graham Barr)
+
+       Makefile.PL
+       - change to code for creating Net::Config
+       
+       Net::FTP::A
+       - Change to write() to ensure whole packet is sent
+       - Documentation correction to dir() and ls()
+       
+       Net::FTP::dataconn
+       - Stop abort be called when a write socket is being closed.
+       
+       Net::NNTP
+       - Changes to postok logic
+       
+       Net::PH
+       - fields() now also returns a reference to an ordered array of tag names
+         if called in an array context.
+       
+       Net::Cmd
+       - Catch added for SIGPIPE while in ->command()
+
+Change 43 on 1997/11/05 by <gbarr@pobox.com> (Graham Barr)
+
+       rename files
+
+Change 39 on 1997/11/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Configure
+       - Fix croak problem
+
+Change 38 on 1997/11/04 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP, Net::NNTP, Net::PH, Net::POP3, Net::SMTP, Net::SNPP
+       - Fix error cause by calling close method when "unexpected EOF:
+         has been encountered.
+       
+       t/require.t
+       - Remove Net::Telnet test
+
+Change 37 on 1997/10/31 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.06
+
+Change 36 on 1997/10/31 by <gbarr@pobox.com> (Graham Barr)
+
+       none
+
+Change 35 on 1997/10/31 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Fixed undef warning in login() when $ruser does not exist in .netrc
+
+Change 34 on 1997/10/31 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Added new supported() method
+
+Change 33 on 1997/10/31 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - DESTORY now sends quit command
+       - corrected OOB commands sent prior to an abort command
+       - close will call abort unless eof seen
+       - documentation updates
+       
+       Net::FTP::datacon
+       - abort() will read a byte if non have been read
+       
+       Net::FTP::A
+       - read was using arg#3 as an offset ?? change to use as timeout, this
+         now matches Net::FTP::I::read and the docs
+       - speedup to read()
+
+Change 18 on 1997/10/03 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.17
+
+Change 15 on 1997/09/26 by <gbarr@pobox.com> (Graham Barr)
+
+       Email address and documentation changes
+
+Change 14 on 1997/09/26 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Added account method so ACCT command can be sent independantly
+         of ->login()
+       - Fixed a bug which caused an infinite loop if EOF happend on the
+         command channel while executing code to work around MS FTP
+           servers
+       
+       Net::Cmd
+       - Fixed undefined warning when an unexpected EOF is encountered
+       
+       Net::NNTP
+       - Added a call to ->reader() from within ->new(), just in case we are
+         talking to an INN server, but we have transfer rights. This will
+         ensure we are talking to nnrpd.
+       
+       Net::SNPP
+       - Fixed a bug in ->new() while locating default host
+
+Change 13 on 1997/09/26 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Modified code which determined whether to connect via a Firewall.
+         if the Firewall wall option is passed then it will be used,
+         reguardless of whether the real machine can be reached.
+       - The Firewall option to new is now used in preference over
+         the FTP_FIREWALL environment variable.
+
+Change 12 on 1997/09/26 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::Cmd
+       - modified ->response() to return CMD_ERROR if ->getline() returns
+         undef
+
+Change 6 on 1997/09/14 by <gbarr@pobox.com> (Graham Barr)
+
+       Small tweak to Makefile,PL to remove requirement for Data::Dumper
+
+Change 3 on 1997/09/12 by <gbarr@pobox.com> (Graham Barr)
+
+       Makefile.PL
+       - Local config file libnet.cfg installed as Net::Config
+
+Change 2 on 1997/09/12 by <gbarr@pobox.com> (Graham Barr)
+
+       Net::FTP
+       - Modified to use AutoLoader
+       - Fixed Net::FTP::[AI]::write to trap SIGPIPE errors
+         and return an error, instead of aborting the script
+
+Change 1 on 1997/09/12 by <gbarr@pobox.com> (Graham Barr)
+
+       A new beginning
+
diff --git a/lib/Net/Cmd.pm b/lib/Net/Cmd.pm
new file mode 100644 (file)
index 0000000..22b8d48
--- /dev/null
@@ -0,0 +1,591 @@
+# Net::Cmd.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::Cmd;
+
+require 5.001;
+require Exporter;
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION);
+use Carp;
+
+$VERSION = "2.18";
+@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 = ();
+
+sub _print_isa
+{
+ no strict qw(refs);
+
+ my $pkg = shift;
+ my $cmd = $pkg;
+
+ $debug{$pkg} ||= 0;
+
+ my %done = ();
+ my @do   = ($pkg);
+ my %spc = ( $pkg , "");
+
+ print STDERR "\n";
+ while ($pkg = shift @do)
+  {
+   next if defined $done{$pkg};
+
+   $done{$pkg} = 1;
+
+   my $v = defined ${"${pkg}::VERSION"}
+                ? "(" . ${"${pkg}::VERSION"} . ")"
+                : "";
+
+   my $spc = $spc{$pkg};
+   print STDERR "$cmd: ${spc}${pkg}${v}\n";
+
+   if(@{"${pkg}::ISA"})
+    {
+     @spc{@{"${pkg}::ISA"}} = ("  " . $spc{$pkg}) x @{"${pkg}::ISA"};
+     unshift(@do, @{"${pkg}::ISA"});
+    }
+  }
+
+ print STDERR "\n";
+}
+
+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;
+
+ return $cmd unless defined fileno($cmd);
+ $cmd->dataend()
+    if(exists ${*$cmd}{'net_cmd_lastch'});
+
+ if (scalar(@_))
+  {
+   local $SIG{PIPE} = 'IGNORE';
+
+   my $str =  join(" ", map { /\n/ ? do { my $n = $_; $n =~ tr/\n/ /; $n } : $_; } @_) . "\015\012";
+   my $len = length $str;
+   my $swlen;
+   
+   $cmd->close
+       unless (defined($swlen = syswrite($cmd,$str,$len)) && $swlen == $len);
+
+   $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;
+   if (select($rout=$rin, undef, undef, $timeout))
+    {
+     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
+    {
+     carp("$cmd: Timeout") if($cmd->debug);
+     return undef;
+    }
+  }
+
+ ${*$cmd}{'net_cmd_partial'} = $partial;
+
+ 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);
+
+ 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";
+  }
+
+ $line =~ s/\n/\015\012/sgo;
+
+ ${*$cmd}{'net_cmd_lastch'} ||= " ";
+ $line = ${*$cmd}{'net_cmd_lastch'} . $line;
+
+ $line =~ s/(\012\.)/$1./sog;
+
+ ${*$cmd}{'net_cmd_lastch'} = substr($line,-1,1);
+
+ my $len = length($line) - 1;
+ my $offset = 1;
+ my $win = "";
+ vec($win,fileno($cmd),1) = 1;
+ my $timeout = $cmd->timeout || undef;
+
+ 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));
+
+ return 1
+    unless(exists ${*$cmd}{'net_cmd_lastch'});
+
+ if(${*$cmd}{'net_cmd_lastch'} eq "\015")
+  {
+   syswrite($cmd,"\012",1);
+   print STDERR "\n"
+    if($cmd->debug);
+  }
+ elsif(${*$cmd}{'net_cmd_lastch'} ne "\012")
+  {
+   syswrite($cmd,"\015\012",2);
+   print STDERR "\n"
+    if($cmd->debug);
+  }
+
+ print STDERR "$cmd>>> .\n"
+    if($cmd->debug);
+
+ syswrite($cmd,".\015\012",3);
+
+ delete ${*$cmd}{'net_cmd_lastch'};
+
+ $cmd->response() == CMD_OK;
+}
+
+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. 
+
+Set the level of debug information for this object. If no argument is
+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 result 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 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.
+
+=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-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/Config.eg b/lib/Net/Config.eg
new file mode 100644 (file)
index 0000000..450acac
--- /dev/null
@@ -0,0 +1,49 @@
+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 a 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
new file mode 100644 (file)
index 0000000..30a65fd
--- /dev/null
@@ -0,0 +1,212 @@
+
+package Net::Config;
+# $Id: //depot/libnet/Net/Config.pm#6 $
+
+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.04";
+
+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 => 0,
+    ftp_int_passive => 0,
+    test_hosts => 1,
+    test_exist => 1,
+);
+
+my $file = __FILE__;
+my $ref;
+$file =~ s/Config.pm/libnet.cfg/;
+if ( -f $file ) {
+    $ref = eval { do $file };
+    if (ref($ref) eq 'HASH') {
+       %NetConfig = (%NetConfig, %{ $ref });
+       $LIBNET_CFG = $file;
+    }
+}
+if ($< == $> and !$CONFIGURE)  {
+    my $home = eval { (getpwuid($>))[7] } || $ENV{HOME};
+    $file = $home . "/.libnetrc";
+    $ref = eval { do $file } if -f $file;
+    %NetConfig = (%NetConfig, %{ $ref })
+       if ref($ref) eq 'HASH'; 
+}
+my ($k,$v);
+while(($k,$v) = each %NetConfig) {
+    $v = [ $v ]
+       if($k =~ /_hosts$/ && !ref($v));
+}
+
+# Take a hostname and determine if it is inside te 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
+distribuion. 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 thier own. This
+can be done by having a C<.libnetrc> file in thier home directory. This file
+should return a reference to a HASH containing the keys described below.
+For example
+
+    # .libnetrc
+    {
+        nntp_hosts => [ "my_prefered_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> a 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_ext_passive
+
+=item ftp_int_pasive
+
+FTP servers normally work on a non-passive mode. That is when you want to
+transfer data you have to tell the server the address and port to
+connect to.
+
+With some firewalls this does not work as te server cannot
+connect to your machine (because you are beind a firewall) and the firewall
+does not re-write te 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 cetting 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 them C<make test> may attempt to connect to hosts given in the
+configuration.
+
+=item test_exists
+
+If true the C<Configure> will check each hostname given that it exists
+
+=back
+
+=cut
diff --git a/lib/Net/Domain.pm b/lib/Net/Domain.pm
new file mode 100644 (file)
index 0000000..c1b0140
--- /dev/null
@@ -0,0 +1,331 @@
+# 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.13"; # $Id: //depot/libnet/Net/Domain.pm#10 $
+
+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 (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;
+
+    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);
+    local($_);
+
+    @hosts = ($host,"localhost");
+
+    unless($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;
+        };
+
+       chop($dom = `domainname 2>/dev/null`)
+               unless(defined $dom);
+
+       if(defined $dom) {
+           my @h = ();
+           while(length($dom)) {
+               push(@h, "$host.$dom");
+               $dom =~ s/^[^.]+.//;
+           }
+           unshift(@hosts,@h);
+       }
+    }
+
+    # Attempt to locate FQDN
+
+    foreach (@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} || undef;
+
+    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($host !~ /\./ && $domain =~ /\./);
+
+    # For hosts that have no name, just an IP address
+    return $fqdn = $host if $host =~ /^\d+(\.\d+){3}$/;
+
+    my @host   = split(/\./, $host);
+    my @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);
+
+=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 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/DummyInetd.pm b/lib/Net/DummyInetd.pm
new file mode 100644 (file)
index 0000000..8247337
--- /dev/null
@@ -0,0 +1,148 @@
+# Net::DummyInetd.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::DummyInetd;
+
+require 5.002;
+
+use IO::Handle;
+use IO::Socket;
+use strict;
+use vars qw($VERSION);
+use Carp;
+
+$VERSION = do { my @r=(q$Revision: 1.6 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
+
+
+sub _process
+{
+ my $listen = shift;
+ my @cmd = @_;
+ my $vec = '';
+ my $r;
+
+ vec($vec,fileno($listen),1) = 1;
+
+ while(select($r=$vec,undef,undef,undef))
+  {
+   my $sock = $listen->accept;
+   my $pid;
+
+   if($pid = fork())
+    {
+     sleep 1;
+     close($sock);
+    }
+   elsif(defined $pid)
+    {
+     my $x =  IO::Handle->new_from_fd($sock,"r");
+     open(STDIN,"<&=".fileno($x)) || die "$! $@";
+     close($x);
+
+     my $y = IO::Handle->new_from_fd($sock,"w");
+     open(STDOUT,">&=".fileno($y)) || die "$! $@";
+     close($y);
+
+     close($sock);
+     exec(@cmd) || carp "$! $@";
+    }
+   else
+    {
+     close($sock);
+     carp $!;
+    }
+  }
+ exit -1; 
+}
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+
+ my $listen = IO::Socket::INET->new(Listen => 5, Proto => 'tcp');
+ my $pid;
+
+ return bless [ $listen->sockport, $pid ]
+       if($pid = fork());
+
+ _process($listen,@_);
+}
+
+sub port
+{
+ my $self = shift;
+ $self->[0];
+}
+
+sub DESTROY
+{
+ my $self = shift;
+ kill 9, $self->[1];
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Net::DummyInetd - A dummy Inetd server
+
+=head1 SYNOPSIS
+
+    use Net::DummyInetd;
+    use Net::SMTP;
+    
+    $inetd = new Net::DummyInetd qw(/usr/lib/sendmail -ba -bs);
+    
+    $smtp  = Net::SMTP->new('localhost', Port => $inetd->port);
+
+=head1 DESCRIPTION
+
+C<Net::DummyInetd> is just what it's name says, it is a dummy inetd server.
+Creation of a C<Net::DummyInetd> will cause a child process to be spawned off
+which will listen to a socket. When a connection arrives on this socket
+the specified command is fork'd and exec'd with STDIN and STDOUT file
+descriptors duplicated to the new socket.
+
+This package was added as an example of how to use C<Net::SMTP> to connect
+to a C<sendmail> process, which is not the default, via SIDIN and STDOUT.
+A C<Net::Inetd> package will be available in the next release of C<libnet>
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( CMD )
+
+Creates a new object and spawns a child process which listens to a socket.
+C<CMD> is a list, which will be passed to C<exec> when a new process needs
+to be created.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item port
+
+Returns the port number on which the I<DummyInetd> object is listening
+
+=back
+
+=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/FTP.pm b/lib/Net/FTP.pm
new file mode 100644 (file)
index 0000000..6748256
--- /dev/null
@@ -0,0 +1,1642 @@
+# Net::FTP.pm
+#
+# Copyright (c) 1995-8 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 AutoLoader qw(AUTOLOAD);
+
+$VERSION = "2.56"; # $Id:$
+@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);
+
+# Name is too long for AutoLoad, it clashes with pasv_xfer
+sub pasv_xfer_unique {
+    my($sftp,$sfile,$dftp,$dfile) = @_;
+    $sftp->pasv_xfer($sfile,$dftp,$dfile,1);
+}
+
+1;
+# Having problems with AutoLoader
+#__END__
+
+sub new
+{
+ my $pkg  = shift;
+ my $peer = shift;
+ my %arg  = @_; 
+
+ my $host = $peer;
+ my $fire = 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};
+    }
+  }
+
+ my $ftp = $pkg->SUPER::new(PeerAddr => $peer, 
+                           PeerPort => $arg{Port} || 'ftp(21)',
+                           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_firewall'} = $fire
+       if(defined $fire);
+
+ ${*$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 hash {
+    my $ftp = shift;           # self
+    my $prev = ${*$ftp}{'net_ftp_hash'} || [\*STDERR, 0];
+
+    unless(@_) {
+      return $prev;
+    }
+    my($h,$b) = @_;
+    if(@_ == 1) {
+      unless($h) {
+        delete ${*$ftp}{'net_ftp_hash'};
+        return $prev;
+      }
+      elsif(ref($h)) {
+        $b = 1024;
+      }
+      else {
+        ($h,$b) = (\*STDERR,$h);
+      }
+    }
+    select((select($h), $|=1)[0]);
+    $b = 512 if $b < 512;
+    ${*$ftp}{'net_ftp_hash'} = [$h, $b];
+    $prev;
+}        
+
+sub quit
+{
+ my $ftp = shift;
+
+ $ftp->_QUIT;
+ $ftp->close;
+}
+
+sub DESTROY
+{
+ my $ftp = shift;
+ defined(fileno($ftp)) && $ftp->quit
+}
+
+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+)/)[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 =~ /^[-rw]{10}/
+   }
+ }
+ else {
+   my @files = $ftp->dir($file);
+   if(@files) {
+     return (split(/\s+/,$1))[4]
+        if $files[0] =~ /^([-rw]{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 = $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 = "-" . (eval { (getpwuid($>))[0] } || $ENV{NAME} ) . '@'
+         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 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,$localfd,$data);
+ local *FD;
+
+ $localfd = ref($local) || ref(\$local) eq "GLOB"
+             ? fileno($local)
+            : undef;
+
+ ($local = $remote) =~ s#^.*/##
+       unless(defined $local);
+
+ croak("Bad remote filename '$remote'\n")
+       if $remote =~ /[\r\n]/s;
+
+ ${*$ftp}{'net_ftp_rest'} = $where
+       if ($where);
+
+ delete ${*$ftp}{'net_ftp_port'};
+ delete ${*$ftp}{'net_ftp_pasv'};
+
+ $data = $ftp->retr($remote) or
+       return undef;
+
+ if(defined $localfd)
+  {
+   $loc = $local;
+  }
+ else
+  {
+   $loc = \*FD;
+
+   unless(($where) ? open($loc,">>$local") : open($loc,">$local"))
+    {
+     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'};
+
+ while(1)
+  {
+   last unless $len = $data->read($buf,$blksize);
+   if($hashh) {
+    $count += $len;
+    print $hashh "#" x (int($count / $hashb));
+    $count %= $hashb;
+   }
+   my $written = syswrite($loc,$buf,$len);
+   unless(defined($written) && $written == $len)
+    {
+     carp "Cannot write to Local file $local: $!\n";
+     $data->abort;
+     close($loc)
+        unless defined $localfd;
+     return undef;
+    }
+  }
+
+ print $hashh "\n" if $hashh;
+
+ close($loc)
+       unless defined $localfd;
+ $data->close(); # implied $ftp->response
+
+ 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 $ftp->_RMD( $dir ) || !$recurse;
+
+    # Try to delete the contents
+    # Get a list of all the files in the directory
+    my $filelist = $ftp->ls($dir);
+
+    return undef
+       unless $filelist && @$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 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 sucessful, 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,$localfd);
+ local *FD;
+
+ $localfd = ref($local) || ref(\$local) eq "GLOB"
+             ? fileno($local)
+            : undef;
+
+ unless(defined $remote)
+  {
+   croak 'Must specify remote filename with stream input'
+       if defined $localfd;
+
+   require File::Basename;
+   $remote = File::Basename::basename($local);
+  }
+
+ croak("Bad remote filename '$remote'\n")
+       if $remote =~ /[\r\n]/s;
+
+ if(defined $localfd)
+  {
+   $loc = $local;
+  }
+ else
+  {
+   $loc = \*FD;
+
+   unless(open($loc,"<$local"))
+    {
+     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;
+
+ 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 = sysread($loc,$buf="",$blksize);
+
+   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 defined $localfd;
+     print $hashh "\n" if $hashh;
+     return undef;
+    }
+  }
+
+ print $hashh "\n" if $hashh;
+
+ close($loc)
+       unless defined $localfd;
+
+ $sock->close() or
+       return undef;
+
+ ($remote) = $ftp->message =~ /unique file name:\s*(\S*)\s*\)/
+       if ('STOU' eq uc $cmd);
+
+ 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',
+                                                      );
+  
+   my $listen = ${*$ftp}{'net_ftp_listen'};
+
+   my($myport, @myaddr) = ($listen->sockport, split(/\./,$ftp->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//;
+       $text =~ s/\n/ /sog;
+       while($text =~ /(\w+)([* ])/g) {
+           $hash->{"\U$1"} = $2 eq " " ? 1 : 0;
+       }
+    }
+    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 = split(/,/,${*$ftp}{'net_ftp_pasv'});
+
+   $data = $pkg->new(PeerAddr => join(".",@port[0..3]),
+                    PeerPort => $port[4] * 256 + $port[5],
+                    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();
+
+ 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 {
+    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 cmd { shift->command(@_)->response() }
+
+########################################
+#
+# RFC959 commands
+#
+
+sub _ABOR { shift->command("ABOR")->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 _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 _USER { shift->command("user",@_)->response() } # A certain brain dead firewall :-)
+sub _PASS { shift->command("PASS",@_)->response() }
+sub _ACCT { shift->command("ACCT",@_)->response() }
+sub _AUTH { shift->command("AUTH",@_)->response() }
+
+sub _ALLO { shift->unsupported(@_) }
+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);
+    $ftp->login("anonymous",'me@here.there');
+    $ftp->cwd("/pub");
+    $ftp->get("that.file");
+    $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 a FTP connection is required.
+
+C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
+Possible options are:
+
+B<Firewall> - The name of a machine which acts as a 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 refered to
+as a ftp proxy.
+
+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. This is not usually required except for some I<dumb>
+servers, and some firewall configurations. This can also be set by the
+environment variable C<FTP_PASSIVE>.
+
+B<Hash> - If TRUE, print hash marks (#) on STDERR 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.
+
+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 the users
+Email address will be used for a 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 type (TYPE [, ARGS])
+
+This method will send the TYPE command to the remote FTP server
+to change the type of data transfer. The return value is the previous
+value.
+
+=item ascii ([ARGS]) binary([ARGS]) ebcdic([ARGS]) byte([ARGS])
+
+Synonyms for C<type> with the first arguments set correctly
+
+B<NOTE> ebcdic and byte are not fully supported.
+
+=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 rmdir ( DIR )
+
+Remove the directory with the name C<DIR>.
+
+=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 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 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 transfered, 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.
+
+=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 transfered 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 transfered 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.
+
+=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 a 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 the 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 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 the timeout value from the command connection will be used.
+
+Returns the number of bytes written before any <CRLF> translation.
+
+=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<ALLO>
+
+Allocates storage for the file to be transferred.
+
+=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 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-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/A.pm b/lib/Net/FTP/A.pm
new file mode 100644 (file)
index 0000000..46791e8
--- /dev/null
@@ -0,0 +1,99 @@
+##
+## 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.13"; # $Id: //depot/libnet/Net/FTP/A.pm#9 $
+
+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;
+
+  $data->can_write($timeout) or
+        croak "Timeout";
+
+  (my $tmp = substr($buf,0,$size)) =~ s/\n/\015\012/sg;
+
+  # If the remote server has closed the connection we will be signal'd
+  # when we write. This can happen if the disk on the remote server fills up
+
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $len = length($tmp);
+  my $off = 0;
+  my $wrote = 0;
+
+  while($len) {
+    $off += $wrote;
+    $wrote = syswrite($data, substr($tmp,$off), $len);
+    return undef
+      unless defined($wrote);
+    $len -= $wrote;
+  }
+
+  $size;
+}
+
+1;
diff --git a/lib/Net/FTP/E.pm b/lib/Net/FTP/E.pm
new file mode 100644 (file)
index 0000000..6e458bd
--- /dev/null
@@ -0,0 +1,7 @@
+package Net::FTP::E;
+
+require Net::FTP::I;
+
+@ISA = qw(Net::FTP::I);
+
+1;
diff --git a/lib/Net/FTP/I.pm b/lib/Net/FTP/I.pm
new file mode 100644 (file)
index 0000000..4548c12
--- /dev/null
@@ -0,0 +1,70 @@
+##
+## 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.08"; # $Id: //depot/libnet/Net/FTP/I.pm#6$
+
+sub read {
+  my    $data   = shift;
+  local *buf    = \$_[0]; shift;
+  my    $size    = shift || croak 'read($buf,$size,[$timeout])';
+  my    $timeout = @_ ? shift : $data->timeout;
+
+  $data->can_read($timeout) or
+        croak "Timeout";
+
+  my($b,$n,$l);
+  my $blksize = ${*$data}{'net_ftp_blksize'};
+  $blksize = $size if $size > $blksize;
+
+  while(($l = length(${*$data})) < $size) {
+   $n += ($b = sysread($data, ${*$data}, $blksize, $l));
+   last unless $b;
+  }
+
+  $n = $size < ($l = length(${*$data})) ? $size : $l;
+
+  $buf = substr(${*$data},0,$n);
+  substr(${*$data},0,$n) = '';
+
+  ${*$data}{'net_ftp_bytesread'} += $n if $n;
+  ${*$data}{'net_ftp_eof'} = 1 unless $n;
+
+  $n;
+}
+
+sub write {
+  my    $data    = shift;
+  local *buf     = \$_[0]; shift;
+  my    $size    = shift || croak 'write($buf,$size,[$timeout])';
+  my    $timeout = @_ ? shift : $data->timeout;
+
+  $data->can_write($timeout) or
+        croak "Timeout";
+
+  # If the remote server has closed the connection we will be signal'd
+  # when we write. This can happen if the disk on the remote server fills up
+
+  local $SIG{PIPE} = 'IGNORE';
+  my $sent = $size;
+  my $off = 0;
+
+  while($sent > 0) {
+    my $n = syswrite($data, $buf, $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
new file mode 100644 (file)
index 0000000..fbb5a5a
--- /dev/null
@@ -0,0 +1,7 @@
+package Net::FTP::L;
+
+require Net::FTP::I;
+
+@ISA = qw(Net::FTP::I);
+
+1;
diff --git a/lib/Net/FTP/dataconn.pm b/lib/Net/FTP/dataconn.pm
new file mode 100644 (file)
index 0000000..e43c6e6
--- /dev/null
@@ -0,0 +1,123 @@
+##
+## Generic data connection package
+##
+
+package Net::FTP::dataconn;
+
+use Carp;
+use vars qw(@ISA $timeout);
+use Net::Cmd;
+
+@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   = shift;
+ local *timeout = \$_[0]; shift;
+ my    $rw     = shift;
+
+ my($rin,$win);
+
+ return 1 unless $timeout;
+
+ $rin = '';
+ vec($rin,fileno($data),1) = 1;
+
+ $win = $rw ? undef : $rin;
+ $rin = undef unless $rw;
+
+ my $nfound = select($rin, $win, undef, $timeout);
+
+ croak "select: $!"
+       if $nfound < 0;
+
+ return $nfound;
+}
+
+sub can_read
+{
+ my    $data    = shift;
+ local *timeout = \$_[0];
+
+ $data->_select($timeout,1);
+}
+
+sub can_write
+{
+ my    $data    = shift;
+ local *timeout = \$_[0];
+
+ $data->_select($timeout,0);
+}
+
+sub cmd
+{
+ my $ftp = shift;
+
+ ${*$ftp}{'net_ftp_cmd'};
+}
+
+1;
diff --git a/lib/Net/Hostname.eg b/lib/Net/Hostname.eg
new file mode 100644 (file)
index 0000000..3bf2b7c
--- /dev/null
@@ -0,0 +1,14 @@
+# This is an example Hostname.pm.
+
+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
new file mode 100644 (file)
index 0000000..2644397
--- /dev/null
@@ -0,0 +1,1060 @@
+# 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.19"; # $Id: //depot/libnet/Net/NNTP.pm#8$
+@ISA     = qw(Net::Cmd IO::Socket::INET);
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+ my $host = shift if @_ % 2;
+ my %arg  = @_;
+ 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 debug_text
+{
+ my $nntp = shift;
+ my $inout = shift;
+ my $text = shift;
+
+ if(($nntp->code == 350 && $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 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 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 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 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] . "-";
+     $arg .= $spec->[1]
+       if defined $spec->[1] && $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 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<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 sucess a true value will be
+returned. If C<FH> is not specified then the return value, on sucess,
+will be a reference to an array containg 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 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 )
+
+=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 first article number in the group,
+the last 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.
+
+=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 the a 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
new file mode 100644 (file)
index 0000000..0c63310
--- /dev/null
@@ -0,0 +1,326 @@
+# 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.10"; # $Id: //depot/libnet/Net/Netrc.pm#4$
+
+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};
+   $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')
+  { 
+   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;
+     push(@tok, $+)
+       while(length && s/^("([^"]*)"|(\S+))\s*//);
+
+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.
+
+=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/PH.pm b/lib/Net/PH.pm
new file mode 100644 (file)
index 0000000..d245b5c
--- /dev/null
@@ -0,0 +1,784 @@
+#
+# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com> and
+# Alex Hristov <hristov@slb.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::PH;
+
+require 5.001;
+
+use strict;
+use vars qw(@ISA $VERSION);
+use Carp;
+
+use Socket 1.3;
+use IO::Socket;
+use Net::Cmd;
+use Net::Config;
+
+$VERSION = "2.20"; # $Id: //depot/libnet/Net/PH.pm#7$
+@ISA     = qw(Exporter Net::Cmd IO::Socket::INET);
+
+sub new
+{
+ my $pkg  = shift;
+ my $host = shift if @_ % 2;
+ my %arg  = @_; 
+ my $hosts = defined $host ? [ $host ] : $NetConfig{ph_hosts};
+ my $ph;
+
+ my $h;
+ foreach $h (@{$hosts})
+  {
+   $ph = $pkg->SUPER::new(PeerAddr => ($host = $h), 
+                         PeerPort => $arg{Port} || 'csnet-ns(105)',
+                         Proto    => 'tcp',
+                         Timeout  => defined $arg{Timeout}
+                                       ? $arg{Timeout}
+                                       : 120
+                        ) and last;
+  }
+
+ return undef
+       unless defined $ph;
+
+ ${*$ph}{'net_ph_host'} = $host;
+
+ $ph->autoflush(1);
+
+ $ph->debug(exists $arg{Debug} ? $arg{Debug} : undef);
+
+ $ph;
+}
+
+sub status
+{
+ my $ph = shift;
+
+ $ph->command('status')->response;
+ $ph->code;
+}
+
+sub login
+{
+ my $ph = shift;
+ my($user,$pass,$encrypted) = @_;
+ my $resp;
+
+ $resp = $ph->command("login",$user)->response;
+
+ if(defined($pass) && $resp == CMD_MORE)
+  {
+   if($encrypted)
+    {
+     my $challenge_str = $ph->message;
+     chomp($challenge_str);
+     Net::PH::crypt::crypt_start($pass);
+     my $cryptstr = Net::PH::crypt::encryptit($challenge_str);
+
+     $ph->command("answer", $cryptstr);
+    }
+   else
+    {
+     $ph->command("clear", $pass);
+    }
+   $resp = $ph->response;
+  }
+
+ $resp == CMD_OK;
+}
+
+sub logout
+{
+ my $ph = shift;
+
+ $ph->command("logout")->response == CMD_OK;
+}
+
+sub id
+{
+ my $ph = shift;
+ my $id = @_ ? shift : $<;
+
+ $ph->command("id",$id)->response == CMD_OK;
+}
+
+sub siteinfo
+{
+ my $ph = shift;
+
+ $ph->command("siteinfo");
+
+ my $ln;
+ my %resp;
+ my $cur_num = 0;
+
+ while(defined($ln = $ph->getline))
+  {
+   $ph->debug_print(0,$ln)
+     if ($ph->debug & 2);
+   chomp($ln);
+   my($code,$num,$tag,$data);
+
+   if($ln =~ /^-(\d+):(\d+):(?:\s*([^:]+):)?\s*(.*)/o)
+    {
+     ($code,$num,$tag,$data) = ($1, $2, $3 || "",$4);
+     $resp{$tag} = bless [$code, $num, $tag, $data], "Net::PH::Result";
+    }
+   else
+    {
+     $ph->set_status($ph->parse_response($ln));
+     return \%resp;
+    }
+  }
+
+ return undef;
+}
+
+sub query
+{
+ my $ph = shift;
+ my $search = shift;
+
+ my($k,$v);
+
+ my @args = ('query', _arg_hash($search));
+
+ push(@args,'return',_arg_list( shift ))
+       if @_;
+
+ unless($ph->command(@args)->response == CMD_INFO)
+  {
+   return $ph->code == 501
+       ? []
+       : undef;
+  }
+
+ my $ln;
+ my @resp;
+ my $cur_num = 0;
+
+ my($last_tag);
+
+ while(defined($ln = $ph->getline))
+  {
+   $ph->debug_print(0,$ln)
+     if ($ph->debug & 2);
+   chomp($ln);
+   my($code,$idx,$num,$tag,$data);
+
+   if($ln =~ /^-(\d+):(\d+):\s*([^:]*):\s*(.*)/o)
+    {
+     ($code,$idx,$tag,$data) = ($1,$2,$3,$4);
+     my $num = $idx - 1;
+
+     $resp[$num] ||= {};
+
+     $tag = $last_tag
+       unless(length($tag));
+
+     $last_tag = $tag;
+
+     if(exists($resp[$num]->{$tag}))
+      {
+       $resp[$num]->{$tag}->[3] .= "\n" . $data;
+      }
+     else
+      {
+       $resp[$num]->{$tag} = bless [$code, $idx, $tag, $data], "Net::PH::Result";
+      }
+    }
+   else
+    {
+     $ph->set_status($ph->parse_response($ln));
+     return \@resp;
+    }
+  }
+
+ return undef;
+}
+
+sub change
+{
+ my $ph = shift;
+ my $search = shift;
+ my $make = shift;
+
+ $ph->command(
+       "change", _arg_hash($search),
+       "make",   _arg_hash($make)
+ )->response == CMD_OK;
+}
+
+sub _arg_hash
+{
+ my $hash = shift;
+
+ return $hash
+       unless(ref($hash));
+
+ my($k,$v);
+ my @r;
+
+ while(($k,$v) = each %$hash)
+  {
+   my $a = $v;
+   $a =~ s/\n/\\n/sog;
+   $a =~ s/\t/\\t/sog;
+   $a = '"' . $a . '"'
+       if $a =~ /\W/;
+   $a = '""'
+       unless length $a;
+
+   push(@r, "$k=$a");   
+  }
+ join(" ", @r);
+}
+
+sub _arg_list
+{
+ my $arr = shift;
+
+ return $arr
+       unless(ref($arr));
+
+ my $v;
+ my @r;
+
+ foreach $v (@$arr)
+  {
+   my $a = $v;
+   $a =~ s/\n/\\n/sog;
+   $a =~ s/\t/\\t/sog;
+   $a = '"' . $a . '"'
+       if $a =~ /\W/;
+   push(@r, $a);   
+  }
+
+ join(" ",@r);
+}
+
+sub add
+{
+ my $ph = shift;
+ my $arg = @_ > 1 ? { @_ } : shift;
+
+ $ph->command('add', _arg_hash($arg))->response == CMD_OK;
+}
+
+sub delete
+{
+ my $ph = shift;
+ my $arg = @_ > 1 ? { @_ } : shift;
+
+ $ph->command('delete', _arg_hash($arg))->response == CMD_OK;
+}
+
+sub force
+{
+ my $ph = shift; 
+ my $search = shift;
+ my $force = shift;
+
+ $ph->command(
+       "change", _arg_hash($search),
+       "force",  _arg_hash($force)
+ )->response == CMD_OK;
+}
+
+
+sub fields
+{
+ my $ph = shift;
+
+ $ph->command("fields", _arg_list(\@_));
+
+ my $ln;
+ my %resp;
+ my $cur_num = 0;
+ my @tags = ();
+ while(defined($ln = $ph->getline))
+  {
+   $ph->debug_print(0,$ln)
+     if ($ph->debug & 2);
+   chomp($ln);
+
+   my($code,$num,$tag,$data,$last_tag);
+
+   if($ln =~ /^-(\d+):(\d+):\s*([^:]*):\s*(.*)/o)
+    {
+     ($code,$num,$tag,$data) = ($1,$2,$3,$4);
+
+     $tag = $last_tag
+       unless(length($tag));
+
+     $last_tag = $tag;
+
+     if(exists $resp{$tag})
+      {
+       $resp{$tag}->[3] .= "\n" . $data;
+      }
+     else
+      {
+       $resp{$tag} = bless [$code, $num, $tag, $data], "Net::PH::Result";
+       push @tags, $tag;
+      }
+    }
+   else
+    {
+     $ph->set_status($ph->parse_response($ln));
+     return wantarray ? (\%resp, \@tags) : \%resp;
+    }
+  }
+
+ return;
+}
+
+sub quit
+{
+ my $ph = shift;
+
+ $ph->close
+       if $ph->command("quit")->response == CMD_OK;
+}
+
+##
+## Net::Cmd overrides
+##
+
+sub parse_response
+{
+ return ()
+    unless $_[1] =~ s/^(-?)(\d\d\d):?//o;
+ ($2, $1 eq "-");
+}
+
+sub debug_text { $_[2] =~ /^(clear)/i ? "$1 ....\n" : $_[2]; }
+
+package Net::PH::Result;
+
+sub code  { shift->[0] }
+sub value { shift->[1] }
+sub field { shift->[2] }
+sub text  { shift->[3] }
+
+package Net::PH::crypt;
+
+#  The code in this package is based upon 'cryptit.c', Copyright (C) 1988 by
+#  Steven Dorner, and Paul Pomes, and the University of Illinois Board
+#  of Trustees, and by CSNET.
+
+use integer;
+use strict;
+sub ROTORSZ () { 256 }
+sub MASK () { 255 }
+
+my(@t1,@t2,@t3,$n1,$n2);
+
+sub crypt_start {
+    my $pass = shift;
+    $n1 = 0;
+    $n2 = 0;
+    crypt_init($pass);
+}
+
+sub crypt_init {
+    my $pw = shift;
+    my $i;
+
+    @t2 = @t3 = (0) x ROTORSZ;
+
+    my $buf = crypt($pw,$pw);
+    return -1 unless length($buf) > 0;
+    $buf = substr($buf . "\0" x 13,0,13);
+    my @buf = map { ord $_ } split(//, $buf);
+
+
+    my $seed = 123;
+    for($i = 0 ; $i < 13 ; $i++) {
+       $seed = $seed * $buf[$i] + $i;
+    }
+    @t1 = (0 .. ROTORSZ-1);
+    
+    for($i = 0 ; $i < ROTORSZ ; $i++) {
+       $seed = 5 * $seed + $buf[$i % 13];
+       my $random = $seed % 65521;
+       my $k = ROTORSZ - 1 - $i;
+       my $ic = ($random & MASK) % ($k + 1);
+       $random >>= 8;
+       @t1[$k,$ic] = @t1[$ic,$k];
+       next if $t3[$k] != 0;
+       $ic = ($random & MASK) % $k;
+       while($t3[$ic] != 0) {
+           $ic = ($ic + 1) % $k;
+       }
+       $t3[$k] = $ic;
+       $t3[$ic] = $k;
+    }
+    for($i = 0 ; $i < ROTORSZ ; $i++) {
+       $t2[$t1[$i] & MASK] = $i
+    }
+}
+
+sub encode {
+    my $sp = shift;
+    my $ch;
+    my $n = scalar(@$sp);
+    my @out = ($n);
+    my $i;
+
+    for($i = 0 ; $i < $n ; ) {
+       my($f0,$f1,$f2) = splice(@$sp,0,3);
+       push(@out,
+           $f0 >> 2,
+           ($f0 << 4) & 060 | ($f1 >> 4) & 017,
+           ($f1 << 2) & 074 | ($f2 >> 6) & 03,
+           $f2 & 077);
+       $i += 3;
+   }
+   join("", map { chr((($_ & 077) + 35) & 0xff) } @out);  # ord('#') == 35
+}
+
+sub encryptit {
+    my $from = shift;
+    my @from = map { ord $_ } split(//, $from);
+    my @sp = ();
+    my $ch;
+    while(defined($ch = shift @from)) {
+       push(@sp,
+           $t2[($t3[($t1[($ch + $n1) & MASK] + $n2) & MASK] - $n2) & MASK] - $n1);
+
+       $n1++;
+       if($n1 == ROTORSZ) {
+           $n1 = 0;
+           $n2++;
+           $n2 = 0 if $n2 == ROTORSZ;
+       }
+    }
+    encode(\@sp);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Net::PH - CCSO Nameserver Client class
+
+=head1 SYNOPSIS
+
+    use Net::PH;
+    
+    $ph = Net::PH->new("some.host.name",
+                       Port    => 105,
+                       Timeout => 120,
+                       Debug   => 0);
+
+    if($ph) {
+        $q = $ph->query({ field1 => "value1" },
+                        [qw(name address pobox)]);
+    
+        if($q) {
+        }
+    }
+    
+    # Alternative syntax
+    
+    if($ph) {
+        $q = $ph->query('field1=value1',
+                        'name address pobox');
+    
+        if($q) {
+        }
+    }
+
+=head1 DESCRIPTION
+
+C<Net::PH> is a class implementing a simple Nameserver/PH client in Perl
+as described in the CCSO Nameserver -- Server-Client Protocol. Like other
+modules in the Net:: family the C<Net::PH> object inherits methods from
+C<Net::Cmd>.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ HOST ] [, OPTIONS ])
+
+    $ph = Net::PH->new("some.host.name",
+                       Port    => 105,
+                       Timeout => 120,
+                       Debug   => 0
+                      );
+
+This is the constructor for a new Net::PH object. C<HOST> is the
+name of the remote host to which a PH connection is required.
+
+If C<HOST> is not given, then the C<SNPP_Host> specified in C<Net::Config>
+will be used.
+
+C<OPTIONS> is an optional list of named options which are passed in
+a hash like fashion, using key and value pairs. Possible options are:-
+
+B<Port> - Port number to connect to on remote host.
+
+B<Timeout> - Maximum time, in seconds, to wait for a response from the
+Nameserver, a value of zero will cause all IO operations to block.
+(default: 120)
+
+B<Debug> - Enable the printing of debugging information to STDERR
+
+=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 query( SEARCH [, RETURN ] )
+
+    $q = $ph->query({ name => $myname },
+                   [qw(name email schedule)]);
+    
+    foreach $handle (@{$q}) {
+       foreach $field (keys %{$handle}) {
+            $c = ${$handle}{$field}->code;
+            $v = ${$handle}{$field}->value;
+            $f = ${$handle}{$field}->field;
+            $t = ${$handle}{$field}->text;
+            print "field:[$field] [$c][$v][$f][$t]\n" ;
+       }
+    }
+
+    
+
+Search the database and return fields from all matching entries.
+
+The C<SEARCH> argument is a reference to a HASH which contains field/value
+pairs which will be passed to the Nameserver as the search criteria.
+
+C<RETURN> is optional, but if given it should be a reference to a list which
+contains field names to be returned.
+
+The alternative syntax is to pass strings instead of references, for example
+
+    $q = $ph->query('name=myname',
+                   'name email schedule');
+
+The C<SEARCH> argument is a string that is passed to the Nameserver as the 
+search criteria. The strings being passed should B<not> contain any carriage
+returns, or else the query command might fail or return invalid data.
+
+C<RETURN> is optional, but if given it should be a string which will
+contain field names to be returned.
+
+Each match from the server will be returned as a HASH where the keys are the
+field names and the values are C<Net::PH:Result> objects (I<code>, I<value>, 
+I<field>, I<text>).
+
+Returns a reference to an ARRAY which contains references to HASHs, one
+per match from the server.
+
+=item change( SEARCH , MAKE )
+
+    $r = $ph->change({ email => "*.domain.name" },
+                     { schedule => "busy");
+
+Change field values for matching entries.
+
+The C<SEARCH> argument is a reference to a HASH which contains field/value
+pairs which will be passed to the Nameserver as the search criteria.
+
+The C<MAKE> argument is a reference to a HASH which contains field/value
+pairs which will be passed to the Nameserver that
+will set new values to designated fields.
+
+The alternative syntax is to pass strings instead of references, for example
+
+    $r = $ph->change('email="*.domain.name"',
+                     'schedule="busy"');
+
+The C<SEARCH> argument is a string to be passed to the Nameserver as the 
+search criteria. The strings being passed should B<not> contain any carriage
+returns, or else the query command might fail or return invalid data.
+
+
+The C<MAKE> argument is a string to be passed to the Nameserver that
+will set new values to designated fields.
+
+Upon success all entries that match the search criteria will have
+the field values, given in the Make argument, changed.
+
+=item login( USER, PASS [, ENCRYPT ])
+
+    $r = $ph->login('username','password',1);
+
+Enter login mode using C<USER> and C<PASS>. If C<ENCRYPT> is given and
+is I<true> then the password will be used to encrypt a challenge text 
+string provided by the server, and the encrypted string will be sent back
+to the server. If C<ENCRYPT> is not given, or I<false> then the password 
+will be sent in clear text (I<this is not recommended>)
+
+=item logout()
+
+    $r = $ph->logout();
+
+Exit login mode and return to anonymous mode.
+
+=item fields( [ FIELD_LIST ] )
+
+    $fields = $ph->fields();
+    foreach $field (keys %{$fields}) {
+        $c = ${$fields}{$field}->code;
+        $v = ${$fields}{$field}->value;
+        $f = ${$fields}{$field}->field;
+        $t = ${$fields}{$field}->text;
+        print "field:[$field] [$c][$v][$f][$t]\n";
+    }
+
+In a scalar context, returns a reference to a HASH. The keys of the HASH are
+the field names and the values are C<Net::PH:Result> objects (I<code>,
+I<value>, I<field>, I<text>).
+
+In an array context, returns a two element array. The first element is a
+reference to a HASH as above, the second element is a reference to an array
+which contains the tag names in the order that they were returned from the
+server.
+
+C<FIELD_LIST> is a string that lists the fields for which info will be
+returned.
+
+=item add( FIELD_VALUES )
+
+    $r = $ph->add( { name => $name, phone => $phone });
+
+This method is used to add new entries to the Nameserver database. You
+must successfully call L<login> before this method can be used.
+
+B<Note> that this method adds new entries to the database. To modify
+an existing entry use L<change>.
+
+C<FIELD_VALUES> is a reference to a HASH which contains field/value
+pairs which will be passed to the Nameserver and will be used to 
+initialize the new entry.
+
+The alternative syntax is to pass a string instead of a reference, for example
+
+    $r = $ph->add('name=myname phone=myphone');
+
+C<FIELD_VALUES> is a string that consists of field/value pairs which the
+new entry will contain. The strings being passed should B<not> contain any
+carriage returns, or else the query command might fail or return invalid data.
+
+
+=item delete( FIELD_VALUES )
+
+    $r = $ph->delete('name=myname phone=myphone');
+
+This method is used to delete existing entries from the Nameserver database.
+You must successfully call L<login> before this method can be used.
+
+B<Note> that this method deletes entries to the database. To modify
+an existing entry use L<change>.
+
+C<FIELD_VALUES> is a string that serves as the search criteria for the
+records to be deleted. Any entry in the database which matches this search 
+criteria will be deleted.
+
+=item id( [ ID ] )
+
+    $r = $ph->id('709');
+
+Sends C<ID> to the Nameserver, which will enter this into its
+logs. If C<ID> is not given then the UID of the user running the
+process will be sent.
+
+=item status()
+
+Returns the current status of the Nameserver.
+
+=item siteinfo()
+
+    $siteinfo = $ph->siteinfo();
+    foreach $field (keys %{$siteinfo}) {
+        $c = ${$siteinfo}{$field}->code;
+        $v = ${$siteinfo}{$field}->value;
+        $f = ${$siteinfo}{$field}->field;
+        $t = ${$siteinfo}{$field}->text;
+        print "field:[$field] [$c][$v][$f][$t]\n";
+    }
+
+Returns a reference to a HASH containing information about the server's 
+site. The keys of the HASH are the field names and values are
+C<Net::PH:Result> objects (I<code>, I<value>, I<field>, I<text>).
+
+=item quit()
+
+    $r = $ph->quit();
+
+Quit the connection
+
+=back
+
+=head1 Q&A
+
+How do I get the values of a Net::PH::Result object?
+
+    foreach $handle (@{$q}) {
+        foreach $field (keys %{$handle}) {
+            $my_code  = ${$q}{$field}->code;
+            $my_value = ${$q}{$field}->value;
+            $my_field = ${$q}{$field}->field;
+            $my_text  = ${$q}{$field}->text;
+        }
+    }
+
+How do I get a count of the returned matches to my query?
+
+    $my_count = scalar(@{$query_result});
+
+How do I get the status code and message of the last C<$ph> command?
+
+    $status_code    = $ph->code;
+    $status_message = $ph->message;
+
+=head1 SEE ALSO
+
+L<Net::Cmd>
+
+=head1 AUTHORS
+
+Graham Barr <gbarr@pobox.com>
+Alex Hristov <hristov@slb.com>
+
+=head1 ACKNOWLEDGMENTS
+
+Password encryption code ported to perl by Broc Seib <bseib@purdue.edu>,
+Purdue University Computing Center.
+
+Otis Gospodnetic <otisg@panther.middlebury.edu> suggested
+passing parameters as string constants. Some queries cannot be 
+executed when passing parameters as string references.
+
+        Example: query first_name last_name email="*.domain"
+
+=head1 COPYRIGHT
+
+The encryption code is based upon cryptit.c, Copyright (C) 1988 by
+Steven Dorner, and Paul Pomes, and the University of Illinois Board
+of Trustees, and by CSNET.
+
+All other code is Copyright (c) 1996-1997 Graham Barr <gbarr@pobox.com>
+and Alex Hristov <hristov@slb.com>. 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
new file mode 100644 (file)
index 0000000..6a05147
--- /dev/null
@@ -0,0 +1,521 @@
+# Net::POP3.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::POP3;
+
+use strict;
+use IO::Socket;
+use vars qw(@ISA $VERSION $debug);
+use Net::Cmd;
+use Carp;
+use Net::Config;
+
+$VERSION = "2.21"; # $Id$
+
+@ISA = qw(Net::Cmd IO::Socket::INET);
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+ my $host = shift if @_ % 2;
+ my %arg  = @_; 
+ 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;
+}
+
+##
+## 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)
+  {
+   require Net::Netrc;
+
+   $user ||= eval { (getpwuid($>))[0] } || $ENV{NAME};
+
+   my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
+
+   $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
+
+   $pass = $m ? $m->password || ""
+              : "";
+  }
+
+ $me->user($user) and
+    $me->pass($pass);
+}
+
+sub apop
+{
+ @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )';
+ my($me,$user,$pass) = @_;
+ my $banner;
+
+ unless(eval { require MD5 })
+  {
+   carp "You need to install MD5 to use the APOP command";
+   return undef;
+  }
+
+ return undef
+   unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0] );
+
+ if(@_ <= 2)
+  {
+   require Net::Netrc;
+
+   $user ||= eval { (getpwuid($>))[0] } || $ENV{NAME};
+
+   my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user);
+
+   $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'});
+
+   $pass = $m ? $m->password || ""
+              : "";
+  }
+
+ my $md = new MD5;
+ $md->add($banner,$pass);
+
+ return undef
+    unless($me->_APOP($user,$md->hexdigest));
+
+ my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
+       ? $1 : ($me->popstat)[0];
+
+ $ret ? $ret : "0E0";
+}
+
+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));
+
+ my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io)
+       ? $1 : ($me->popstat)[0];
+
+ $ret ? $ret : "0E0";
+}
+
+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 delete
+{
+ @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )';
+ $_[0]->_DELE($_[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 _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 quit
+{
+ my $me = shift;
+
+ $me->_QUIT;
+ $me->close;
+}
+
+sub DESTROY
+{
+ my $me = shift;
+
+ if(defined fileno($me))
+  {
+   $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() || return undef;
+ my $code = "500";
+
+ $cmd->debug_print(0,$str)
+   if ($cmd->debug);
+
+ if($str =~ s/^\+OK\s+//io)
+  {
+   $code = "200"
+  }
+ else
+  {
+   $str =~ s/^-ERR\s+//io;
+  }
+
+ ${*$cmd}{'net_cmd_resp'} = [ $str ];
+ ${*$cmd}{'net_cmd_code'} = $code;
+
+ substr($code,0,1);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Net::POP3 - Post Office Protocol 3 Client class (RFC1081)
+
+=head1 SYNOPSIS
+
+    use Net::POP3;
+    
+    # Constructors
+    $pop = Net::POP3->new('pop3host');
+    $pop = Net::POP3->new('pop3host', Timeout => 60);
+
+=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 RFC1081.
+
+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 EXAMPLES
+
+    Need some small examples in here :-)
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ HOST, ] [ OPTIONS ] )
+
+This is the constructor for a new Net::POP3 object. C<HOST> is the
+name of the remote host to which a POP3 connection is required.
+
+If C<HOST> is not given, then the C<POP3_Host> 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<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 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 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 ti L<login>, but the password is not sent in clear text. 
+
+To use this method you must have the MD5 package installed, if you do not
+this method will return I<undef>
+
+
+=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 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 reseting 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-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/README.config b/lib/Net/README.config
new file mode 100644 (file)
index 0000000..4dc7380
--- /dev/null
@@ -0,0 +1,28 @@
+Hopefully the next release of libnet will be release 2.00. For this
+release I want to completely re-write the configuration system.
+
+My current thoughts are that a hash of values is not sufficient and that
+Net::Config should be code. This is what I have planned, if you see any
+problems or have any ideas please let me know by sending an Email
+to gbarr@pobox.com
+
+Net::Config will become an object based interface.  Methods will be called
+as static methods on the package. Net::Config will inherit from
+Net::LocalCfg and Net::Config::default. Net::LocalCfg is a package
+that local sys-admins can write to override the defaulr behaviour of
+Net::Config.
+
+Most of the variables that are currently stored in Net::Config will
+be turned into method calls, eg $NetConfig{'nntp_hosts'} will
+become Net::Config->nntp_hosts
+
+This approach will allow for a better implementation of the firewall code,
+which currently makes a lot of assumptions. To aid this Net::Config::default
+will provide a method 'reachable' which will take a single argument as
+a hostname and should return true it the host is reachable directly.
+
+This will also allow people who have dialup accounts, and appear in different
+domains at different times, to do what they need.
+
+Graham
+gbarr@pobox.com
diff --git a/lib/Net/README.libnet b/lib/Net/README.libnet
new file mode 100644 (file)
index 0000000..0b6b0cd
--- /dev/null
@@ -0,0 +1,100 @@
+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 staring
+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
+Net::SNPP      RFC1861         Simple Network Pager Protocol
+
+The distribution also contains a module (Net::PH) which facilitates
+comunicate with with servers using the CCSO Nameserver Server-Client
+Protocol
+
+FUTURE WORK
+
+AVAILABILITY
+
+The latest version of libnet is available from the Comprehensive Perl
+Archive Network (CPAN). To find a CPAN site near you see:
+
+    http://www.perl.com/CPAN
+                            ^ no slash here !!
+
+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
+the Net::Config package. If you are on a system when this script cannot be run
+for some reason then the file Config.eg can be edited manually and installed
+as Net::Config (Net/Comfig.pm)
+
+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 sendt 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
+
+  © 1996-98 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
new file mode 100644 (file)
index 0000000..8202d48
--- /dev/null
@@ -0,0 +1,596 @@
+# Net::SMTP.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::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.15"; # $Id$
+
+@ISA = qw(Net::Cmd IO::Socket::INET);
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+ my $host = shift if @_ % 2;
+ my %arg  = @_; 
+ my $hosts = defined $host ? [ $host ] : $NetConfig{smtp_hosts};
+ my $obj;
+
+ my $h;
+ foreach $h (@{$hosts})
+  {
+   $obj = $type->SUPER::new(PeerAddr => ($host = $h), 
+                           PeerPort => $arg{Port} || 'smtp(25)',
+                           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_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;
+}
+
+##
+## 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 hello
+{
+ my $me = shift;
+ my $domain = shift ||
+             eval {
+                   require Net::Domain;
+                   Net::Domain::hostfqdn();
+                  } ||
+               "";
+ my $ok = $me->_EHLO($domain);
+ my @msg = $me->message;
+
+ if($ok)
+  {
+   my $h = ${*$me}{'net_smtp_esmtp'} = {};
+   my $ln;
+   foreach $ln (@msg) {
+     $h->{$1} = $2
+       if $ln =~ /(\S+)\b[ \t]*([^\n]*)/;
+    }
+  }
+ elsif($me->status == CMD_ERROR) 
+  {
+   @msg = $me->message
+       if $ok = $me->_HELO($domain);
+  }
+
+ $ok && $msg[0] =~ /\A(\S+)/
+       ? $1
+       : undef;
+}
+
+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 $addr = shift || "";
+
+ return $1
+    if $addr =~ /(<[^>]+>)/so;
+
+ $addr =~ s/\n/ /sog;
+ $addr =~ s/(\A\s+|\s+\Z)//sog;
+
+ return "<" . $addr . ">";
+}
+
+
+sub mail
+{
+ my $me = shift;
+ my $addr = _addr(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
+        }
+       else
+        {
+        carp 'Net::SMTP::mail: DSN option not supported by host';
+        }
+      }
+
+     if(defined($v = delete $opt{Bits}))
+      {
+       if(exists $esmtp->{'8BITMIME'})
+        {
+        $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT"
+        }
+       else
+        {
+        carp 'Net::SMTP::mail: 8BITMIME option not supported by host';
+        }
+      }
+
+     if(defined($v = delete $opt{Transaction}))
+      {
+       if(exists $esmtp->{CHECKPOINT})
+        {
+        $opts .= " TRANSID=" . _addr($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';
+        }
+      }
+
+     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         { shift->_SEND("FROM:" . _addr($_[0])) }
+sub send_or_mail  { shift->_SOML("FROM:" . _addr($_[0])) }
+sub send_and_mail { shift->_SAML("FROM:" . _addr($_[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';
+        }
+      }
+
+     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($addr) . $opts)) {
+      push(@ok,$addr) if $skip_bad;
+    }
+    elsif(!$skip_bad) {
+      return 0;
+    }
+  }
+
+ return $skip_bad ? @ok : 1;
+}
+
+sub to { shift->recipient(@_) }
+
+sub data
+{
+ my $me = shift;
+
+ my $ok = $me->_DATA() && $me->datasend(@_);
+
+ $ok && @_ ? $me->dataend
+          : $ok;
+}
+
+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 _TURN { shift->unsupported(@_); }                            
+sub _ETRN { shift->command("ETRN", @_)->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 Net::SMTP [ HOST, ] [ OPTIONS ]
+
+This is the constructor for a new Net::SMTP object. C<HOST> is the
+name of the remote host to which a SMTP connection is required.
+
+If C<HOST> is not given, then the C<SMTP_Host> 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 a guess will be taken.
+
+B<Timeout> - Maximum time, in seconds, to wait for a response from the
+SMTP server (default: 120)
+
+B<Debug> - Enable debugging information
+
+
+Example:
+
+
+    $smtp = Net::SMTP->new('mailhost',
+                          Hello => 'my.mail.domain'
+                          Timeout => 30,
+                           Debug   => 1,
+                         );
+
+=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 etrn ( DOMAIN )
+
+Request a queue run for the DOMAIN given.
+
+=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      => <???>
+ Bits        => "7" | "8"
+ Transaction => <ADDRESS>
+ Envelope    => <ENVID>
+
+
+=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 some additional OPTIONS which is passed
+in hash like fashion, using key and value pairs.  Possible options are:
+
+ Notify    =>
+ SkipBad   => 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.
+
+=item to ( ADDRESS [, ADDRESS [...]] )
+
+A synonym 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.
+
+=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 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/SNPP.pm b/lib/Net/SNPP.pm
new file mode 100644 (file)
index 0000000..60781b3
--- /dev/null
@@ -0,0 +1,414 @@
+# Net::SNPP.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::SNPP;
+
+require 5.001;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+use Socket 1.3;
+use Carp;
+use IO::Socket;
+use Net::Cmd;
+use Net::Config;
+
+$VERSION = "1.11"; # $Id:$
+@ISA     = qw(Net::Cmd IO::Socket::INET);
+@EXPORT  = (qw(CMD_2WAYERROR CMD_2WAYOK CMD_2WAYQUEUED), @Net::Cmd::EXPORT);
+
+sub CMD_2WAYERROR  () { 7 }
+sub CMD_2WAYOK     () { 8 }
+sub CMD_2WAYQUEUED () { 9 }
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+ my $host = shift if @_ % 2;
+ my %arg  = @_; 
+ my $hosts = defined $host ? [ $host ] : $NetConfig{snpp_hosts};
+ my $obj;
+
+ my $h;
+ foreach $h (@{$hosts})
+  {
+   $obj = $type->SUPER::new(PeerAddr => ($host = $h), 
+                           PeerPort => $arg{Port} || 'snpp(444)',
+                           Proto    => 'tcp',
+                           Timeout  => defined $arg{Timeout}
+                                               ? $arg{Timeout}
+                                               : 120
+                           ) and last;
+  }
+
+ return undef
+       unless defined $obj;
+
+ ${*$obj}{'net_snpp_host'} = $host;
+
+ $obj->autoflush(1);
+
+ $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
+
+ unless ($obj->response() == CMD_OK)
+  {
+   $obj->close();
+   return undef;
+  }
+
+ $obj;
+}
+
+##
+## User interface methods
+##
+
+sub pager_id
+{
+ @_ == 2 or croak 'usage: $snpp->pager_id( PAGER_ID )';
+ shift->_PAGE(@_);
+}
+
+sub content
+{
+ @_ == 2 or croak 'usage: $snpp->content( MESSAGE )';
+ shift->_MESS(@_);
+}
+
+sub send
+{
+ my $me = shift;
+
+ if(@_)
+  {
+   my %arg = @_;
+
+   if(exists $arg{Pager})
+    {
+     my $pagers = ref($arg{Pager}) ? $arg{Pager} : [ $arg{Pager} ];
+     my $pager;
+     foreach $pager (@$pagers)
+      {
+       $me->_PAGE($pager) || return 0
+      }
+    }
+
+   $me->_MESS($arg{Message}) || return 0
+       if(exists $arg{Message});
+
+   $me->hold($arg{Hold}) || return 0
+       if(exists $arg{Hold});
+
+   $me->hold($arg{HoldLocal},1) || return 0
+       if(exists $arg{HoldLocal});
+
+   $me->_COVE($arg{Coverage}) || return 0
+       if(exists $arg{Coverage});
+
+   $me->_ALER($arg{Alert} ? 1 : 0) || return 0
+       if(exists $arg{Alert});
+
+   $me->service_level($arg{ServiceLevel}) || return 0
+       if(exists $arg{ServiceLevel});
+  }
+
+ $me->_SEND();
+}
+
+sub data
+{
+ my $me = shift;
+
+ my $ok = $me->_DATA() && $me->datasend(@_);
+
+ return $ok
+       unless($ok && @_);
+
+ $me->dataend;
+}
+
+sub login
+{
+ @_ == 2 || @_ == 3 or croak 'usage: $snpp->login( USER [, PASSWORD ])';
+ shift->_LOGI(@_);
+}
+
+sub help
+{
+ @_ == 1 or croak 'usage: $snpp->help()';
+ my $me = shift;
+
+ return $me->_HELP() ? $me->message
+                    : undef;
+}
+
+sub xwho
+{
+ @_ == 1 or croak 'usage: $snpp->xwho()';
+ my $me = shift;
+
+ $me->_XWHO or return undef;
+
+ my(%hash,$line);
+ my @msg = $me->message;
+ pop @msg; # Remove command complete line
+
+ foreach $line (@msg) {
+   $line =~ /^\s*(\S+)\s*(.*)/ and $hash{$1} = $2;
+ }
+
+ \%hash;
+}
+
+sub service_level
+{
+ @_ == 2 or croak 'usage: $snpp->service_level( LEVEL )';
+ my $me = shift;
+ my $level = int(shift);
+
+ if($level < 0 || $level > 11)
+  {
+   $me->set_status(550,"Invalid Service Level");
+   return 0;
+  }
+
+ $me->_LEVE($level);
+}
+
+sub alert
+{
+ @_ == 1 || @_ == 2 or croak 'usage: $snpp->alert( VALUE )';
+ my $me = shift;
+ my $value  = (@_ == 1 || shift) ? 1 : 0;
+
+ $me->_ALER($value);
+}
+
+sub coverage
+{
+ @_ == 1 or croak 'usage: $snpp->coverage( AREA )';
+ shift->_COVE(@_);
+}
+
+sub hold
+{
+ @_ == 2 || @_ == 3 or croak 'usage: $snpp->hold( TIME [, LOCAL ] )';
+ my $me = shift;
+ my $time = shift;
+ my $local = (shift) ? "" : " +0000";
+
+ my @g = reverse((gmtime($time))[0..5]);
+ $g[1] += 1;
+ $g[0] %= 100;
+
+ $me->_HOLD( sprintf("%02d%02d%02d%02d%02d%02d%s",@g,$local));
+}
+
+sub caller_id
+{
+ @_ == 2 or croak 'usage: $snpp->caller_id( CALLER_ID )';
+ shift->_CALL(@_);
+}
+
+sub subject
+{
+ @_ == 2 or croak 'usage: $snpp->subject( SUBJECT )';
+ shift->_SUBJ(@_);
+}
+
+sub two_way
+{
+ @_ == 1 or croak 'usage: $snpp->two_way()';
+ shift->_2WAY();
+}
+
+sub quit
+{
+ @_ == 1 or croak 'usage: $snpp->quit()';
+ my $snpp = shift;
+
+ $snpp->_QUIT;
+ $snpp->close;
+}
+
+##
+## IO/perl methods
+##
+
+sub DESTROY
+{
+ my $snpp = shift;
+ defined(fileno($snpp)) && $snpp->quit
+}
+
+##
+## Over-ride methods (Net::Cmd)
+##
+
+sub debug_text
+{
+ $_[2] =~ s/^((logi|page)\s+\S+\s+)\S+/$1 xxxx/io;
+ $_[2];
+}
+
+sub parse_response
+{
+ return ()
+    unless $_[1] =~ s/^(\d\d\d)(.?)//o;
+ my($code,$more) = ($1, $2 eq "-");
+
+ $more ||= $code == 214;
+
+ ($code,$more);
+}
+
+##
+## RFC1861 commands
+##
+
+# Level 1
+
+sub _PAGE { shift->command("PAGE", @_)->response()  == CMD_OK }   
+sub _MESS { shift->command("MESS", @_)->response()  == CMD_OK }   
+sub _RESE { shift->command("RESE")->response()  == CMD_OK }   
+sub _SEND { shift->command("SEND")->response()  == CMD_OK }   
+sub _QUIT { shift->command("QUIT")->response()  == CMD_OK }   
+sub _HELP { shift->command("HELP")->response()  == CMD_OK }   
+sub _DATA { shift->command("DATA")->response()  == CMD_MORE }   
+sub _SITE { shift->command("SITE",@_) }   
+
+# Level 2
+
+sub _LOGI { shift->command("LOGI", @_)->response()  == CMD_OK }   
+sub _LEVE { shift->command("LEVE", @_)->response()  == CMD_OK }   
+sub _ALER { shift->command("ALER", @_)->response()  == CMD_OK }   
+sub _COVE { shift->command("COVE", @_)->response()  == CMD_OK }   
+sub _HOLD { shift->command("HOLD", @_)->response()  == CMD_OK }   
+sub _CALL { shift->command("CALL", @_)->response()  == CMD_OK }   
+sub _SUBJ { shift->command("SUBJ", @_)->response()  == CMD_OK }   
+
+# NonStandard
+
+sub _XWHO { shift->command("XWHO")->response()  == CMD_OK }   
+
+1;
+__END__
+
+=head1 NAME
+
+Net::SNPP - Simple Network Pager Protocol Client
+
+=head1 SYNOPSIS
+
+    use Net::SNPP;
+    
+    # Constructors
+    $snpp = Net::SNPP->new('snpphost');
+    $snpp = Net::SNPP->new('snpphost', Timeout => 60);
+
+=head1 NOTE
+
+This module is not complete, yet !
+
+=head1 DESCRIPTION
+
+This module implements a client interface to the SNPP protocol, enabling
+a perl5 application to talk to SNPP servers. This documentation assumes
+that you are familiar with the SNPP protocol described in RFC1861.
+
+A new Net::SNPP object must be created with the I<new> method. Once
+this has been done, all SNPP commands are accessed through this object.
+
+=head1 EXAMPLES
+
+This example will send a pager message in one hour saying "Your lunch is ready"
+
+    #!/usr/local/bin/perl -w
+    
+    use Net::SNPP;
+    
+    $snpp = Net::SNPP->new('snpphost');
+    
+    $snpp->send( Pager   => $some_pager_number,
+                Message => "Your lunch is ready",
+                Alert   => 1,
+                Hold    => time + 3600, # lunch ready in 1 hour :-)
+              ) || die $snpp->message;
+    
+    $snpp->quit;
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ HOST, ] [ OPTIONS ] )
+
+This is the constructor for a new Net::SNPP object. C<HOST> is the
+name of the remote host to which a SNPP connection is required.
+
+If C<HOST> is not given, then the C<SNPP_Host> 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<Timeout> - Maximum time, in seconds, to wait for a response from the
+SNPP server (default: 120)
+
+B<Debug> - Enable debugging information
+
+
+Example:
+
+
+    $snpp = Net::SNPP->new('snpphost',
+                          Debug => 1,
+                         );
+
+=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 reset ()
+
+=item help ()
+
+Request help text from the server. Returns the text or undef upon failure
+
+=item quit ()
+
+Send the QUIT command to the remote SNPP server and close the socket connection.
+
+=back
+
+=head1 EXPORTS
+
+C<Net::SNPP> exports all that C<Net::CMD> exports, plus three more subroutines
+that can bu used to compare against the result of C<status>. These are :-
+C<CMD_2WAYERROR>, C<CMD_2WAYOK>, and C<CMD_2WAYQUEUED>.
+
+=head1 SEE ALSO
+
+L<Net::Cmd>
+RFC1861
+
+=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/Time.pm b/lib/Net/Time.pm
new file mode 100644 (file)
index 0000000..828babf
--- /dev/null
@@ -0,0 +1,147 @@
+# Net::Time.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::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.08";
+
+$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 $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 = '';
+
+ $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-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/demos/ftp b/lib/Net/demos/ftp
new file mode 100755 (executable)
index 0000000..610e102
--- /dev/null
@@ -0,0 +1,21 @@
+#!/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
new file mode 100644 (file)
index 0000000..36a00e7
--- /dev/null
@@ -0,0 +1,9 @@
+#!/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
new file mode 100755 (executable)
index 0000000..7753fbc
--- /dev/null
@@ -0,0 +1,40 @@
+#!/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
new file mode 100644 (file)
index 0000000..8a43c32
--- /dev/null
@@ -0,0 +1,86 @@
+#!/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
new file mode 100644 (file)
index 0000000..0ae07ae
--- /dev/null
@@ -0,0 +1,24 @@
+#!/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
new file mode 100755 (executable)
index 0000000..5cfbc2b
--- /dev/null
@@ -0,0 +1,80 @@
+#!/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/snpp b/lib/Net/demos/snpp
new file mode 100755 (executable)
index 0000000..f046b58
--- /dev/null
@@ -0,0 +1,39 @@
+#!/usr/local/bin/perl
+
+use blib;
+use Getopt::Long;
+use Net::SNPP;
+
+$opt_debug = undef;
+$opt_h = undef;
+$opt_p = undef;
+
+GetOptions(qw(debug h p));
+
+die "usage: $0 -h <host> -p <pagerid> <message>"
+       unless defined $opt_h && defined $opt_p && @ARGV;
+
+Net::SNPP->debug(1)
+       if $opt_debug;
+
+$snpp = Net::SNPP->new($opt_host);
+
+$snpp->pager_id($opt_p) || die $snpp->message;
+$snpp->content(join(" ",@ARGV)) || die $snpp->message;
+$snpp->send() || die $snpp->message;
+
+$snpp->quit;
+
+__END__
+
+or you could dp
+
+$snpp = Net::SNPP->new($opt_host);
+
+$snpp->send( Pager   => $opt_p,
+            Message => join(" ",@ARGV),
+            Alert   => 1,
+            Hold    => time + 3600
+          ) || die $snpp->message;
+
+$snpp->quit;
diff --git a/lib/Net/demos/time b/lib/Net/demos/time
new file mode 100644 (file)
index 0000000..61095d3
--- /dev/null
@@ -0,0 +1,13 @@
+#!/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/libnet.ppd b/lib/Net/libnet.ppd
new file mode 100644 (file)
index 0000000..ed864bc
--- /dev/null
@@ -0,0 +1,12 @@
+<SOFTPKG NAME="libnet" VERSION="1,06,0,0">
+       <TITLE>libnet</TITLE>
+       <ABSTRACT>Collection of Network protocol modules</ABSTRACT>
+       <AUTHOR>Graham Barr &lt;gbarr@pobox.com&gt;</AUTHOR>
+       <IMPLEMENTATION>
+               <DEPENDENCY NAME="IO-Socket" VERSION="1,05,0,0" />
+               <DEPENDENCY NAME="Socket" VERSION="1,3,0,0" />
+               <OS NAME="linux" />
+               <ARCHITECTURE NAME="i586-linux" />
+               <CODEBASE HREF="" />
+       </IMPLEMENTATION>
+</SOFTPKG>
diff --git a/lib/Net/libnetFAQ.pod b/lib/Net/libnetFAQ.pod
new file mode 100644 (file)
index 0000000..1e5af56
--- /dev/null
@@ -0,0 +1,321 @@
+=head1 NAME
+
+libnetFAQ - libnet Frequently Asked Questions
+
+=head1 DESCRIPTION
+
+=head2 Where to get this document
+
+This document is distributed with the libnet disribution, and is also
+avaliable on the libnet web page at
+
+    http://www.pobox.com/~gbarr/libnet/
+
+
+
+=head2 How to contribute to this document
+
+You may mail corrections, additions, and suggestions to me
+gbarr@pobox.com.
+
+
+=head1 Author and Copyright Information
+
+Copyright (c) 1997-1998 Graham Barr. All rights reserved.
+This document is free; you can redistribute it and/or modify it
+under the terms of the Artistic Licence.
+
+=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
+
+=over 4
+
+=head2 What is libnet ?
+
+libnet is a collection of perl5 modules which all related to network
+programming. The majority of the modules avaliable 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 entirly 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.perl.com/CPAN/modules/by-module/Net/
+The latest release and information is also avaliable on the libnet web page
+at
+
+ http://www.pobox.com/~gbarr/libnet/
+
+=back
+
+=head1 Using Net::FTP
+
+=over
+
+=head2 How do I download files from a FTP server ?
+
+An example taken from an article posted to comp.lang.perl.misc
+
+    #!/your/path/to/perl
+
+    # a module making life easier
+
+    use Net::FTP;
+
+    # for debuging: $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 a FTP server ?
+
+=head2 Changeing 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 a 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 a FTP proxy firewall, but cannot access machines outside ?
+
+Net::FTP implements the most popular ftp proxy firewall approach. The sceme
+implemented is that where you loginin 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 accont, 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 thi 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 avaliable 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 (<$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;
+  }
+}
+
+
+=back
+
+=head1 Using Net::SMTP
+
+=over
+
+=head2 Why can't the part of an Email address after the @ be used as the hostname ?
+
+The part of an Email address which follows the @ is not necessarily a hostname,
+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 thay way, but it does not. The verify method returns true
+if the command suceeded. If you pass verify an address which the
+server would normally have to forward to another machine the the command
+will suceed with something like
+
+    252 Couldn't verify <someone@there> but will attempt delivery anyway
+
+This command will only fail if you pass it an address in a domain the
+the server directly delivers for, and that address does not exist.
+
+=back
+
+=head1 Debugging scripts
+
+=over
+
+=head2 How can I debug my scripts that use Net::* modules ?
+
+Most of the libnet client classes allow options to be passed to the
+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 responces are being
+received back.
+
+    #!/your/path/to/perl
+    
+    use Net::FTP;
+    
+    my $ftp = new Net::FTP($host, Debug => 1);
+    $ftp->login('gbarr','password');
+    $ftp->quit;
+
+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 thier versions,
+this is usefule 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 mutiple 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 responce being received.
+
+=back
+
+=head1 AUTHOR AND COPYRIGHT
+
+Copyright (c) 1997 Graham Barr.
+All rights reserved.
diff --git a/lib/Net/t/ftp.t b/lib/Net/t/ftp.t
new file mode 100644 (file)
index 0000000..f91d76a
--- /dev/null
@@ -0,0 +1,60 @@
+#!./perl -w
+
+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}, Debug => 0)
+       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 STDERR $ftp->message,"\n";
+  printf "not ok %d\n",$t++;
+  printf "not ok %d\n",$t++;
+  printf "not 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
new file mode 100644 (file)
index 0000000..3e55ace
--- /dev/null
@@ -0,0 +1,19 @@
+
+use Net::Domain qw(hostname domainname hostdomain);
+use Net::Config;
+
+unless($NetConfig{test_hosts}) {
+    print "1..0\n";
+    exit 0;
+}
+
+print "1..1\n";
+
+$domain = domainname();
+
+if(defined $domain && $domain ne "") {
+ print "ok 1\n";
+}
+else {
+ print "not ok 1\n";
+}
diff --git a/lib/Net/t/nntp.t b/lib/Net/t/nntp.t
new file mode 100644 (file)
index 0000000..1afb588
--- /dev/null
@@ -0,0 +1,46 @@
+#!./perl -w
+
+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/ph.t b/lib/Net/t/ph.t
new file mode 100644 (file)
index 0000000..41ddab6
--- /dev/null
@@ -0,0 +1,31 @@
+#!./perl -w
+
+use Net::Config;
+use Net::PH;
+
+unless(@{$NetConfig{ph_hosts}} && $NetConfig{test_hosts}) {
+    print "1..0\n";
+    exit 0;
+}
+
+print "1..5\n";
+
+my $i = 1;
+
+$ph = Net::PH->new(Debug => 0)
+       or (print("not ok 1\n"), exit);
+
+print "ok 1\n";
+
+$ph->fields or print "not ";
+print "ok 2\n";
+
+$ph->siteinfo or print "not ";
+print "ok 3\n";
+
+$ph->id or print "not ";
+print "ok 4\n";
+
+$ph->quit or print "not ";
+print "ok 5\n";
+
diff --git a/lib/Net/t/require.t b/lib/Net/t/require.t
new file mode 100644 (file)
index 0000000..f9eba4d
--- /dev/null
@@ -0,0 +1,16 @@
+
+print "1..11\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::SNPP; }   || print "not "; print "ok ",$i++,"\n";
+eval { require Net::PH; }     || 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
new file mode 100644 (file)
index 0000000..55607fe
--- /dev/null
@@ -0,0 +1,25 @@
+#!./perl -w
+
+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";
+
index b4a839d..a5bb8bc 100644 (file)
--- a/utils.lst
+++ b/utils.lst
@@ -10,6 +10,7 @@ utils/c2ph      # link = utils/pstruct
 utils/dprofpp
 utils/h2ph
 utils/h2xs
+utils/libnetcfg
 utils/perlbug
 utils/perlcc
 utils/perldoc
index ec26cd8..801b4a4 100644 (file)
@@ -5,9 +5,9 @@ REALPERL = ../perl
 # Files to be built with variable substitution after miniperl is
 # available.  Dependencies handled manually below (for now).
 
-pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL perlcc.PL dprofpp.PL
-plextract  = c2ph h2ph h2xs perlbug perldoc pl2pm splain perlcc dprofpp
-plextractexe  = ./c2ph ./h2ph ./h2xs ./perlbug ./perldoc ./pl2pm ./splain ./perlcc ./dprofpp
+pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL perlcc.PL dprofpp.PL libnetcfg.PL
+plextract  = c2ph h2ph h2xs perlbug perldoc pl2pm splain perlcc dprofpp libnetcfg
+plextractexe  = ./c2ph ./h2ph ./h2xs ./perlbug ./perldoc ./pl2pm ./splain ./perlcc ./dprofpp ./libnetcfg
 
 all: $(plextract) 
 
@@ -21,6 +21,7 @@ compile: all $(plextract)
        $(REALPERL) -I../lib perlcc splain -o splain.exe -v 10 -log ../compilelog;
        $(REALPERL) -I../lib perlcc perlcc -o perlcc.exe -v 10 -log ../compilelog;
        $(REALPERL) -I../lib perlcc dprofpp -o dprofpp.exe -v 10 -log ../compilelog;
+       $(REALPERL) -I../lib perlcc libnetcfg -o libnetcfg.exe -v 10 -log ../compilelog;
 
 $(plextract):
        $(PERL) -I../lib $@.PL
@@ -43,6 +44,8 @@ perlcc:               perlcc.PL ../config.sh
 
 dprofpp:       dprofpp.PL ../config.sh
 
+libnetcfg:     libnetcfg.PL ../config.sh
+
 clean:
 
 realclean:
diff --git a/utils/libnetcfg.PL b/utils/libnetcfg.PL
new file mode 100644 (file)
index 0000000..3418dd1
--- /dev/null
@@ -0,0 +1,642 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+use Cwd;
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+my $origdir = cwd;
+chdir dirname($0);
+my $file = basename($0, '.PL');
+$file .= '.com' if $^O eq 'VMS';
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{startperl}
+    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
+       if \$running_under_some_shell;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+# $Id: Configure,v 1.8 1997/03/04 09:22:32 gbarr Exp $
+
+use strict;
+use IO::File;
+use Getopt::Std;
+use ExtUtils::MakeMaker qw(prompt);
+
+use vars qw($opt_d $opt_o);
+
+##
+##
+##
+
+my %cfg = ();
+my @cfg = ();
+
+my($libnet_cfg,$msg,$ans,$def,$have_old);
+
+##
+##
+##
+
+sub valid_host
+{
+ my $h = shift;
+
+ defined($h) && (($cfg{'test_exist'} == 0) || gethostbyname($h));
+}
+
+##
+##
+##
+
+sub test_hostnames (\@)
+{
+ my $hlist = shift;
+ my @h = ();
+ my $host;
+ my $err = 0;
+
+ foreach $host (@$hlist)
+  {
+   if(valid_host($host))
+    {
+     push(@h, $host);
+     next;
+    }
+   warn "Bad hostname: '$host'\n";
+   $err++;
+  }
+ @$hlist = @h;
+ $err ? join(" ",@h) : undef;
+}
+
+##
+##
+##
+
+sub Prompt
+{
+ my($prompt,$def) = @_;
+
+ $def = "" unless defined $def;
+
+ chomp($prompt);
+
+ if($opt_d)
+  {
+   print $prompt,," [",$def,"]\n";
+   return $def;
+  }
+ prompt($prompt,$def);
+}
+
+##
+##
+##
+
+sub get_host_list
+{
+ my($prompt,$def) = @_;
+
+ $def = join(" ",@$def) if ref($def);
+
+ my @hosts;
+
+ do
+  {
+   my $ans = Prompt($prompt,$def);
+
+   $ans =~ s/(\A\s+|\s+\Z)//g;
+
+   @hosts = split(/\s+/, $ans);
+  }
+ while(@hosts && defined($def = test_hostnames(@hosts)));
+
+ \@hosts;
+}
+
+##
+##
+##
+
+sub get_hostname
+{
+ my($prompt,$def) = @_;
+
+ my $host;
+
+ while(1)
+  {
+   my $ans = Prompt($prompt,$def);
+   $host = ($ans =~ /(\S*)/)[0];
+   last
+       if(!length($host) || valid_host($host));
+
+   $def =""
+       if $def eq $host;
+
+   print <<"EDQ";
+
+*** ERROR:
+    Hostname `$host' does not seem to exist, please enter again
+    or a single space to clear any default
+
+EDQ
+  }
+
+ length $host
+       ? $host
+       : undef;
+}
+
+##
+##
+##
+
+sub get_bool ($$)
+{
+ my($prompt,$def) = @_;
+
+ chomp($prompt);
+
+ my $val = Prompt($prompt,$def ? "yes" : "no");
+
+ $val =~ /^y/i ? 1 : 0;
+}
+
+##
+##
+##
+
+sub get_netmask ($$)
+{
+ my($prompt,$def) = @_;
+
+ chomp($prompt);
+
+ my %list;
+ @list{@$def} = ();
+
+MASK:
+ while(1) {
+   my $bad = 0;
+   my $ans = Prompt($prompt) or last;
+
+   if($ans eq '*') {
+     %list = ();
+     next;
+   }
+
+   if($ans eq '=') {
+     print "\n",( %list ? join("\n", sort keys %list) : 'none'),"\n\n";
+     next;
+   }
+
+   unless ($ans =~ m{^\s*(?:(-?\s*)(\d+(?:\.\d+){0,3})/(\d+))}) {
+     warn "Bad netmask '$ans'\n";
+     next;
+   }
+
+   my($remove,$bits,@ip) = ($1,$3,split(/\./, $2),0,0,0);
+   if ( $ip[0] < 1 || $bits < 1 || $bits > 32) {
+     warn "Bad netmask '$ans'\n";
+     next MASK;
+   }
+   foreach my $byte (@ip) {
+     if ( $byte > 255 ) {
+       warn "Bad netmask '$ans'\n";
+       next MASK;
+     }
+   } 
+
+   my $mask = sprintf("%d.%d.%d.%d/%d",@ip[0..3],$bits); 
+
+   if ($remove) {
+     delete $list{$mask};
+   }
+   else {
+     $list{$mask} = 1;
+   }
+
+  }
+
+ [ keys %list ];
+}
+
+##
+##
+##
+
+sub default_hostname
+{
+ my $host;
+ my @host;
+
+ foreach $host (@_)
+  {
+   if(defined($host) && valid_host($host))
+    {
+     return $host
+       unless wantarray;
+     push(@host,$host);
+    }
+  }
+
+ return wantarray ? @host : undef;
+}
+
+##
+##
+##
+
+getopts('do:');
+
+$libnet_cfg = "libnet.cfg"
+       unless(defined($libnet_cfg = $opt_o));
+
+my %oldcfg = ();
+
+$Net::Config::CONFIGURE = 1; # Suppress load of user overrides
+if( -f $libnet_cfg )
+ {
+  %oldcfg = ( %{ do $libnet_cfg } );
+ }
+elsif (eval { require Net::Config }) 
+ {
+  $have_old = 1;
+  %oldcfg = %Net::Config::NetConfig;
+ }
+
+map { $cfg{lc $_} = $cfg{$_}; delete $cfg{$_} if /[A-Z]/ } keys %cfg;
+
+$oldcfg{'test_exist'} = 1 unless exists $oldcfg{'test_exist'};
+$oldcfg{'test_hosts'} = 1 unless exists $oldcfg{'test_hosts'};
+
+#---------------------------------------------------------------------------
+
+if($have_old && !$opt_d)
+ {
+  $msg = <<EDQ;
+
+Ah, I see you already have installed libnet before.
+
+Do you want to modify/update your configuration (y|n) ?
+EDQ
+
+ $opt_d = 1
+       unless get_bool($msg,0);
+ }
+
+#---------------------------------------------------------------------------
+
+$msg = <<EDQ;
+
+This script will prompt you to enter hostnames that can be used as
+defaults for some of the modules in the libnet distribution.
+
+To ensure that you do not enter an invalid hostname, I can perform a
+lookup on each hostname you enter. If your internet connection is via
+a dialup line then you may not want me to perform these lookups, as
+it will require you to be on-line.
+
+Do you want me to perform hostname lookups (y|n) ?
+EDQ
+
+$cfg{'test_exist'} = get_bool($msg, $oldcfg{'test_exist'});
+
+print <<EDQ unless $cfg{'test_exist'};
+
+*** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
+
+OK I will not check if the hostnames you give are valid
+so be very cafeful
+
+*** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
+EDQ
+
+
+#---------------------------------------------------------------------------
+
+print <<EDQ;
+
+The following questions all require a list of host names, separated
+with spaces. If you do not have a host available for any of the
+services, then enter a single space, followed by <CR>. To accept the
+default, hit <CR>
+
+EDQ
+
+$msg = 'Enter a list of available NNTP hosts :';
+
+$def = $oldcfg{'nntp_hosts'} ||
+       [ default_hostname($ENV{NNTPSERVER},$ENV{NEWSHOST},'news') ];
+
+$cfg{'nntp_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available SMTP hosts :';
+
+$def = $oldcfg{'smtp_hosts'} ||
+       [ default_hostname(split(/:/,$ENV{SMTPHOSTS} || ""), 'mailhost') ];
+
+$cfg{'smtp_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available POP3 hosts :';
+
+$def = $oldcfg{'pop3_hosts'} || [];
+
+$cfg{'pop3_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available SNPP hosts :';
+
+$def = $oldcfg{'snpp_hosts'} || [];
+
+$cfg{'snpp_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available PH Hosts   :'  ;
+
+$def = $oldcfg{'ph_hosts'} ||
+       [ default_hostname('dirserv') ];
+
+$cfg{'ph_hosts'}   =  get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available TIME Hosts   :'  ;
+
+$def = $oldcfg{'time_hosts'} || [];
+
+$cfg{'time_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = 'Enter a list of available DAYTIME Hosts   :'  ;
+
+$def = $oldcfg{'daytime_hosts'} || $oldcfg{'time_hosts'};
+
+$cfg{'daytime_hosts'} = get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+$msg = <<EDQ;
+
+Do you have a firewall/ftp proxy  between your machine and the internet 
+
+If you use a SOCKS firewall answer no
+
+(y|n) ?
+EDQ
+
+if(get_bool($msg,0)) {
+
+  $msg = <<'EDQ';
+What series of FTP commands do you need to send to your
+firewall to connect to an external host.
+
+user/pass     => external user & password
+fwuser/fwpass => firewall user & password
+
+0) None
+1) -----------------------
+     USER user@remote.host
+     PASS pass
+2) -----------------------
+     USER fwuser
+     PASS fwpass
+     USER user@remote.host
+     PASS pass
+3) -----------------------
+     USER fwuser
+     PASS fwpass
+     SITE remote.site
+     USER user
+     PASS pass
+4) -----------------------
+     USER fwuser
+     PASS fwpass
+     OPEN remote.site
+     USER user
+     PASS pass
+5) -----------------------
+     USER user@fwuser@remote.site
+     PASS pass@fwpass
+6) -----------------------
+     USER fwuser@remote.site
+     PASS fwpass
+     USER user
+     PASS pass
+7) -----------------------
+     USER user@remote.host
+     PASS pass
+     AUTH fwuser
+     RESP fwpass
+
+Choice:
+EDQ
+ $def = exists $oldcfg{'ftp_firewall_type'}  ? $oldcfg{'ftp_firewall_type'} : 1;
+ $ans = Prompt($msg,$def);
+ $cfg{'ftp_firewall_type'} = 0+$ans;
+ $def = $oldcfg{'ftp_firewall'} || $ENV{FTP_FIREWALL};
+
+ $cfg{'ftp_firewall'} = get_hostname("FTP proxy hostname :", $def);
+}
+else {
+ delete $cfg{'ftp_firewall'};
+}
+
+
+#---------------------------------------------------------------------------
+
+if (defined $cfg{'ftp_firewall'})
+ {
+  print <<EDQ;
+
+By default Net::FTP assumes that it only needs to use a firewall if it
+cannot resolve the name of the host given. This only works if your DNS
+system is setup to only resolve internal hostnames. If this is not the
+case and your DNS will resolve external hostnames, then another method
+is needed. Net::Config can do this if you provide the netmasks that
+describe your internal network. Each netmask should be entered in the
+form x.x.x.x/y, for example 127.0.0.0/8 or 214.8.16.32/24
+
+EDQ
+$def = [];
+if(ref($oldcfg{'local_netmask'}))
+ {
+  $def = $oldcfg{'local_netmask'};
+   print "Your current netmasks are :\n\n\t",
+       join("\n\t",@{$def}),"\n\n";
+ }
+
+print "
+Enter one netmask at each prompt, prefix with a - to remove a netmask
+from the list, enter a '*' to clear the whole list, an '=' to show the
+current list and an empty line to continue with Configure.
+
+";
+
+  my $mask = get_netmask("netmask :",$def);
+  $cfg{'local_netmask'} = $mask if ref($mask) && @$mask;
+ }
+
+#---------------------------------------------------------------------------
+
+###$msg =<<EDQ;
+###
+###SOCKS is a commonly used firewall protocol. If you use SOCKS firewalls
+###then enter a list of hostames
+###
+###Enter a list of available SOCKS hosts :
+###EDQ
+###
+###$def = $cfg{'socks_hosts'} ||
+###    [ default_hostname($ENV{SOCKS5_SERVER},
+###                       $ENV{SOCKS_SERVER},
+###                       $ENV{SOCKS4_SERVER}) ];
+###
+###$cfg{'socks_hosts'}   =  get_host_list($msg,$def);
+
+#---------------------------------------------------------------------------
+
+print <<EDQ;
+
+Normally when FTP needs a data connection the client tells the server
+a port to connect to, and the server initiates a connection to the client.
+
+Some setups, in particular firewall setups, can/do not work using this
+protocol. In these situations the client must make the connection to the
+server, this is called a passive transfer.
+EDQ
+
+if (defined $cfg{'ftp_firewall'}) {
+  $msg = "\nShould all FTP connections via a firewall/proxy be passive (y|n) ?";
+
+  $def = $oldcfg{'ftp_ext_passive'} || 0;
+
+  $cfg{'ftp_ext_passive'} = get_bool($msg,$def);
+
+  $msg = "\nShould all other FTP connections be passive (y|n) ?";
+
+}
+else {
+  $msg = "\nShould all FTP connections be passive (y|n) ?";
+}
+
+$def = $oldcfg{'ftp_int_passive'} || 0;
+
+$cfg{'ftp_int_passive'} = get_bool($msg,$def);
+
+
+#---------------------------------------------------------------------------
+
+$def = $oldcfg{'inet_domain'} || $ENV{LOCALDOMAIN};
+
+$ans = Prompt("\nWhat is your local internet domain name :",$def);
+
+$cfg{'inet_domain'} = ($ans =~ /(\S+)/)[0];
+
+#---------------------------------------------------------------------------
+
+$msg = <<EDQ;
+
+If you specified some default hosts above, it is possible for me to
+do some basic tests when you run `make test'
+
+This will cause `make test' to be quite a bit slower and, if your
+internet connection is via dialup, will require you to be on-line
+unless the hosts are local.
+
+Do you want me to run these tests (y|n) ?
+EDQ
+
+$cfg{'test_hosts'} = get_bool($msg,$oldcfg{'test_hosts'});
+
+#---------------------------------------------------------------------------
+
+$msg = <<EDQ;
+
+To allow Net::FTP to be tested I will need a hostname. This host
+should allow anonymous access and have a /pub directory
+
+What host can I use :
+EDQ
+
+$cfg{'ftp_testhost'} = get_hostname($msg,$oldcfg{'ftp_testhost'})
+       if $cfg{'test_hosts'};
+
+
+print "\n";
+
+#---------------------------------------------------------------------------
+
+my $fh = IO::File->new($libnet_cfg, "w") or
+       die "Cannot create `$libnet_cfg': $!";
+
+print "Writing $libnet_cfg\n";
+
+print $fh "{\n";
+
+my $key;
+foreach $key (keys %cfg) {
+    my $val = $cfg{$key};
+    if(!defined($val)) {
+       $val = "undef";
+    }
+    elsif(ref($val)) {
+       $val = '[' . join(",",
+           map {
+               my $v = "undef";
+               if(defined $_) {
+                   ($v = $_) =~ s/'/\'/sog;
+                   $v = "'" . $v . "'";
+               }
+               $v;
+           } @$val ) . ']';
+    }
+    else {
+       $val =~ s/'/\'/sog;
+       $val = "'" . $val . "'" if $val =~ /\D/;
+    }
+    print $fh "\t'",$key,"' => ",$val,",\n";
+}
+
+print $fh "}\n";
+
+$fh->close;
+
+############################################################################
+############################################################################
+
+exit 0;
+!NO!SUBS!
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;