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
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
--- /dev/null
+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
+
--- /dev/null
+# 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
--- /dev/null
+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;
--- /dev/null
+
+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
--- /dev/null
+# 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
--- /dev/null
+# 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
--- /dev/null
+# 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
--- /dev/null
+##
+## 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;
--- /dev/null
+package Net::FTP::E;
+
+require Net::FTP::I;
+
+@ISA = qw(Net::FTP::I);
+
+1;
--- /dev/null
+##
+## 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;
--- /dev/null
+package Net::FTP::L;
+
+require Net::FTP::I;
+
+@ISA = qw(Net::FTP::I);
+
+1;
--- /dev/null
+##
+## 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;
--- /dev/null
+# 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;
--- /dev/null
+# 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
--- /dev/null
+# 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
--- /dev/null
+#
+# 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
--- /dev/null
+# 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
--- /dev/null
+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
--- /dev/null
+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!
--- /dev/null
+# 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
--- /dev/null
+# 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
--- /dev/null
+# 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
--- /dev/null
+#!/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;
+ }
+
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
+
+
--- /dev/null
+#!/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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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
--- /dev/null
+#!/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;
--- /dev/null
+#!/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";
+
--- /dev/null
+<SOFTPKG NAME="libnet" VERSION="1,06,0,0">
+ <TITLE>libnet</TITLE>
+ <ABSTRACT>Collection of Network protocol modules</ABSTRACT>
+ <AUTHOR>Graham Barr <gbarr@pobox.com></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>
--- /dev/null
+=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<>>>>> 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.
--- /dev/null
+#!./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++;
--- /dev/null
+
+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";
+}
--- /dev/null
+#!./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";
+
--- /dev/null
+#!./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";
+
--- /dev/null
+
+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";
+
+
--- /dev/null
+#!./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";
+
utils/dprofpp
utils/h2ph
utils/h2xs
+utils/libnetcfg
utils/perlbug
utils/perlcc
utils/perldoc
# 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)
$(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
dprofpp: dprofpp.PL ../config.sh
+libnetcfg: libnetcfg.PL ../config.sh
+
clean:
realclean:
--- /dev/null
+#!/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;
projects / p5sagit/p5-mst-13.2.git / commitdiff