From: Graham Barr Date: Thu, 28 Feb 2002 13:06:11 +0000 (+0000) Subject: Sync with libnet-1.10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12df23ee23bab7313f8619710677aae3d931aa7a;p=p5sagit%2Fp5-mst-13.2.git Sync with libnet-1.10 p4raw-id: //depot/perl@14913 --- diff --git a/lib/Net/ChangeLog.libnet b/lib/Net/ChangeLog.libnet index 8ddb94e..2ef21ac 100644 --- a/lib/Net/ChangeLog.libnet +++ b/lib/Net/ChangeLog.libnet @@ -1,3 +1,89 @@ +Change 705 on 2002/02/28 by (Graham Barr) + + Net::FTP::I + - Don't call sysread multiple times after calling select() as it + may block. + +Change 704 on 2002/02/25 by (Graham Barr) + + Net::POP3 + - Patches from Ville Skytta for various cleanup and use Digest::MD5 + +Change 703 on 2002/02/25 by (Graham Barr) + + Net::Cmd, Net::NNTP, Net::POP3, Net::SMTP + - Add support for returning tied filehandles from some operations + +Change 702 on 2002/02/25 by (Graham Barr) + + Net::Config + - New config script for MacOS from Chris Nandor + +Change 701 on 2002/02/25 by (Graham Barr) + + Net::FTP + - Allow tied handles to be passed to get/put + +Change 700 on 2002/02/25 by (Graham Barr) + + t/* + - Skip tests if no Socket module + +Change 699 on 2002/02/25 by (Graham Barr) + + t/netrc.t + - Fix RE context + +Change 698 on 2002/02/25 by (Graham Barr) + + Net::Cmd + - Pod changes from Robin Barker + +Change 697 on 2002/02/22 by (Graham Barr) + + Net::FTP + - Don't do EBCDIC translation on a binary transfer + +Change 696 on 2002/02/22 by (Graham Barr) + + Net::FTP + - Fix docs for anonymous login + +Change 695 on 2002/02/22 by (Graham Barr) + + Net::SMTP + - Support binding to a local port/address + +Change 694 on 2002/02/22 by (Graham Barr) + + Net::Netrc + - Support exscaping in the netrc file + +Change 688 on 2001/12/10 by (Graham Barr) + + Release 1.0901 + +Change 687 on 2001/12/10 by (Graham Barr) + + More test updates from the core + +Change 686 on 2001/11/27 by (Graham Barr) + + Skip tests if we are on an EBCDIC machine, but Convert::EBCDIC is not installed + Make tests run with 5.004 + +Change 685 on 2001/11/27 by (Graham Barr) + + Net::SMTP + - Don't attempt to resolve the hostname to send in the greating. + If it is not provided, use localhost.localdomain + (patch from Eduardo Perez Ureta) + +Change 684 on 2001/11/26 by (Graham Barr) + + netrc.t + - fix RE for libnet_t.pl + Change 683 on 2001/11/20 by (Graham Barr) Various doc cleanups @@ -31,7 +117,7 @@ Change 670 on 2001/11/20 by (Graham Barr) Net::FTP - Send -anonymous@ as the password for the anonymous user, not - the real username. Patch from Eduardo P?rez Ureta + the real username. Patch from Eduardo Perez Ureta Change 669 on 2001/11/20 by (Graham Barr) @@ -178,30 +264,6 @@ Change 620 on 2001/08/06 by (Graham Barr) Fix for _msg_spec when passed the same msg number twice, pass N instead of N-N -Change 625 on 2001/08/17 by (Graham Barr) - - Doc updates and add cc and bcc as aliases for recipient - -Change 624 on 2001/08/17 by (Graham Barr) - - Don't set ENV variables - -Change 623 on 2001/08/17 by (Graham Barr) - - Support mixed case in the EHLO response - -Change 622 on 2001/08/06 by (Graham Barr) - - Documentation update - -Change 621 on 2001/08/06 by (Graham Barr) - - Set the status if command returns due to the connection being closed - -Change 620 on 2001/08/06 by (Graham Barr) - - Fix for _msg_spec when passed the same msg number twice, pass N instead of N-N - Change 619 on 2001/05/29 by (Graham Barr) Remove DummyInetd @@ -235,6 +297,58 @@ Change 574 on 2000/08/24 by (Graham Barr) - Make listen socket listen on same interfacce as the command connection this fixes a problem when going via a SOCKS firewall +Change 573 on 2000/08/24 by (Graham Barr) + + Net::Netrc + - Exclude cygwin from the stat check + +Change 572 on 2000/08/24 by (Graham Barr) + + Net::FTP + - Fix bug in return value from ->rmdir + - Added ->restart() + Net::FTP::dataconn + - Added ->bytes_read + +Change 518 on 2000/05/16 by (Graham Barr) + + Net::FTP::A, Net::FTP::I + - Restrict the number of bytes given to syswrite to be at + most net_ftp_blksize. This fixes a bug on VMS where the OS will + return an error if syswrite is given more than 65535 bytes. + +Change 504 on 2000/05/02 by (Graham Barr) + + Net::NNTP + * Doc fix for the description of the return value from ->list() + +Change 503 on 2000/05/02 by (Graham Barr) + + Net::POP3 + * chnage new MD5 to MD5->new + +Change 472 on 2000/03/30 by (Graham Barr) + + Net::Cmd + - More typos in os390 code + +Change 471 on 2000/03/30 by (Graham Barr) + + Net::Cmd + - Fix bug in new os390 code + +Change 470 on 2000/03/30 by (Graham Barr) + + Generate HTML + +Change 469 on 2000/03/30 by (Graham Barr) + + Documentation updates + +Change 468 on 2000/03/30 by (Graham Barr) + + Added Net::SNPP::HylaFAX.pm + Change 458 on 2000/03/29 by (Graham Barr) Net::Cmd, Net::FTP @@ -507,12 +621,12 @@ Change 305 on 1999/05/05 by (Graham Barr) \r\n character sequences - Made improvements to speed of \r\n <-> \n translation -Change 304 on 1999/05/04 by (Graham Barr) +Change 304 on 1999/05/05 by (Graham Barr) Net::FTP - Added hash mark printing -Change 264 on 1999/03/17 by (Graham Barr) +Change 264 on 1999/03/18 by (Graham Barr) Net::TFTP - Fix typo in CLOSE() @@ -539,7 +653,7 @@ Change 252 on 1999/02/17 by (Graham Barr) Net::Domain - set FQDN = IP if host does not have a name -Change 248 on 1999/02/05 by (Graham Barr) +Change 248 on 1999/02/06 by (Graham Barr) Net::Domain - check for defined(&main::SYS_gethostname) before calling syscall @@ -550,7 +664,7 @@ Change 245 on 1999/01/18 by (Graham Barr) Net::FTP - Modify mkdir to call ->cwd(), not ->cd() -Change 206 on 1998/10/20 by (Graham Barr) +Change 206 on 1998/10/21 by (Graham Barr) Fix typo in Net::Cmd @@ -559,14 +673,14 @@ Change 204 on 1998/10/18 by (Graham Barr) Net::SMTP - DESTROY now does nothing, so any half-sent message should be aborted -Change 198 on 1998/10/15 by (Graham Barr) +Change 198 on 1998/10/16 by (Graham Barr) Net::Config added Configure, Makefile.PL - Canges to handle new Net::Config module -Change 197 on 1998/10/15 by (Graham Barr) +Change 197 on 1998/10/16 by (Graham Barr) Net::FTP - Fixed return vlue of _ACCT @@ -577,7 +691,7 @@ Change 197 on 1998/10/15 by (Graham Barr) Some FAQ updates -Change 196 on 1998/10/15 by (Graham Barr) +Change 196 on 1998/10/16 by (Graham Barr) Net::TFTP - Initial public release @@ -595,13 +709,13 @@ Change 191 on 1998/09/26 by (Graham Barr) Net::POP3 - Fix bug in UIDL -Change 187 on 1998/09/01 by (Graham Barr) +Change 187 on 1998/09/02 by (Graham Barr) Net::TFTP - Some cleanup of the code - removed leading - from named args -Change 185 on 1998/08/23 by (Graham Barr) +Change 185 on 1998/08/24 by (Graham Barr) Net::TFTP - Initial version @@ -610,13 +724,13 @@ Change 184 on 1998/08/23 by (Graham Barr) Remove mention of Net::SNMP from README -Change 183 on 1998/08/06 by (Graham Barr) +Change 183 on 1998/08/07 by (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 (Graham Barr) +Change 182 on 1998/08/07 by (Graham Barr) Net::FTP - _list_cmd returned (undef) instead of () @@ -625,18 +739,18 @@ Change 182 on 1998/08/06 by (Graham Barr) Net::NNTP - Fix typo in docs -Change 181 on 1998/08/04 by (Graham Barr) +Change 181 on 1998/08/05 by (Graham Barr) Net::FTP - Allow spaces in filenames (ick!) -Change 179 on 1998/08/04 by (Graham Barr) +Change 179 on 1998/08/05 by (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 (Graham Barr) +Change 171 on 1998/07/09 by (Graham Barr) Net::FTP - login will now send ACCT if $acct is defined and the PASS @@ -650,18 +764,18 @@ Change 167 on 1998/07/04 by (Graham Barr) - Removed set method from Net::Config - Removed check for Data::Dumper from Makefile.PL -Change 157 on 1998/06/19 by (Graham Barr) +Change 157 on 1998/06/20 by (Graham Barr) Net::FTP - Another small tweak to ->supported() -Change 156 on 1998/06/18 by (Graham Barr) +Change 156 on 1998/06/19 by (Graham Barr) Net::FTP - Tweak to ->supported() to better detect reports from some servers (NcFTPd) -Change 153 on 1998/06/16 by (Graham Barr) +Change 153 on 1998/06/17 by (Graham Barr) Net::FTP - Fix "Use of uninitialized" warning, patch from @@ -685,43 +799,43 @@ Change 141 on 1998/05/24 by (Graham Barr) Net::SMTP - Added banner() method -Change 132 on 1998/04/18 by (Graham Barr) +Change 132 on 1998/04/19 by (Graham Barr) Net::POP3 - Added ResvPort option to new() -Change 131 on 1998/04/18 by (Graham Barr) +Change 131 on 1998/04/19 by (Graham Barr) Makefile.PL - Patch for running $^X Configure under VMS -Change 130 on 1998/04/18 by (Graham Barr) +Change 130 on 1998/04/19 by (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 (Graham Barr) +Change 129 on 1998/04/19 by (Graham Barr) Net::FTP - Enhanced ->size() to try different approaces if SIZE is not implemented -Change 128 on 1998/04/15 by (Graham Barr) +Change 128 on 1998/04/16 by (Graham Barr) Net::Time - Correct number of seconds in a year -Change 126 on 1998/04/06 by (Graham Barr) +Change 126 on 1998/04/07 by (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 (Graham Barr) +Change 118 on 1998/02/24 by (Graham Barr) Net::FTP - Added site method -Change 117 on 1998/02/23 by (Graham Barr) +Change 117 on 1998/02/24 by (Graham Barr) Net::POP3 - Remove use of map in a void context @@ -731,12 +845,12 @@ Change 116 on 1998/02/21 by (Graham Barr) Net::FTP - Changes to mkdir for recursive creates. -Change 114 on 1998/02/20 by (Graham Barr) +Change 114 on 1998/02/21 by (Graham Barr) Net::Domain - Change $SIG{__DIE__} to $SIG{'__DIE__'} to stop warning in 5.003 -Change 113 on 1998/02/17 by (Graham Barr) +Change 113 on 1998/02/18 by (Graham Barr) Net::FTP::A - modified regexp in write for converting to CRLF, should now work with MacOS @@ -757,32 +871,32 @@ Change 113 on 1998/02/17 by (Graham Barr) Net::SMTP - Fix for new() to fail if HELO command fails -Change 108 on 1998/02/14 by (Graham Barr) +Change 108 on 1998/02/15 by (Graham Barr) Net::FTP - Added check for filenames with spaces, \r or \n -Change 107 on 1998/02/06 by (Graham Barr) +Change 107 on 1998/02/07 by (Graham Barr) Net::FTP - Ensure dataconn object is in reading mode for data transfers -Change 101 on 1998/01/22 by (Graham Barr) +Change 101 on 1998/01/23 by (Graham Barr) Renamed FAQ.pod as FAQ -Change 100 on 1998/01/22 by (Graham Barr) +Change 100 on 1998/01/23 by (Graham Barr) Net::NNTP - Added Reader option to new() -Change 99 on 1998/01/22 by (Graham Barr) +Change 99 on 1998/01/23 by (Graham Barr) Net::POP3 - fix pass() to call popstat() if pattern does not match for message count -Change 98 on 1998/01/22 by (Graham Barr) +Change 98 on 1998/01/23 by (Graham Barr) Restore changes lost in disk-crash @@ -812,18 +926,18 @@ Change 98 on 1998/01/22 by (Graham Barr) - Removed use of AutoLoader, it was causing problems on some platforms -Change 92 on 1997/12/08 by (Graham Barr) +Change 92 on 1997/12/09 by (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 (Graham Barr) +Change 91 on 1997/12/05 by (Graham Barr) MANIFEST, FAQ.pod - Added initial FAQ document -Change 90 on 1997/12/04 by (Graham Barr) +Change 90 on 1997/12/05 by (Graham Barr) Net::FTP - Set $@ if ->new() fails @@ -860,11 +974,11 @@ Change 64 on 1997/11/28 by (Graham Barr) - Now exits passing if commands fail due to not having authorization. -Change 61 on 1997/11/25 by (Graham Barr) +Change 61 on 1997/11/26 by (Graham Barr) none -Change 60 on 1997/11/25 by (Graham Barr) +Change 60 on 1997/11/26 by (Graham Barr) Net::FTP::I - Fix to prevent ABOR being sent when xfer is complete @@ -883,17 +997,17 @@ Change 60 on 1997/11/25 by (Graham Barr) t/nntp.t - Modified to test for a list of groups -Change 58 on 1997/11/17 by (Graham Barr) +Change 58 on 1997/11/18 by (Graham Barr) t/nntp.t - Modified to check for more groups before failure -Change 56 on 1997/11/17 by (Graham Barr) +Change 56 on 1997/11/18 by (Graham Barr) Net::SMTP - Corrected documentation for ->expand() -Change 54 on 1997/11/17 by (Graham Barr) +Change 54 on 1997/11/18 by (Graham Barr) Makefile.PL - change to code for creating Net::Config @@ -919,12 +1033,12 @@ Change 43 on 1997/11/05 by (Graham Barr) rename files -Change 39 on 1997/11/04 by (Graham Barr) +Change 39 on 1997/11/05 by (Graham Barr) Configure - Fix croak problem -Change 38 on 1997/11/04 by (Graham Barr) +Change 38 on 1997/11/05 by (Graham Barr) Net::FTP, Net::NNTP, Net::PH, Net::POP3, Net::SMTP, Net::SNPP - Fix error cause by calling close method when "unexpected EOF: @@ -933,25 +1047,25 @@ Change 38 on 1997/11/04 by (Graham Barr) t/require.t - Remove Net::Telnet test -Change 37 on 1997/10/31 by (Graham Barr) +Change 37 on 1997/11/01 by (Graham Barr) Release 1.06 -Change 36 on 1997/10/31 by (Graham Barr) +Change 36 on 1997/11/01 by (Graham Barr) none -Change 35 on 1997/10/31 by (Graham Barr) +Change 35 on 1997/11/01 by (Graham Barr) Net::FTP - Fixed undef warning in login() when $ruser does not exist in .netrc -Change 34 on 1997/10/31 by (Graham Barr) +Change 34 on 1997/11/01 by (Graham Barr) Net::FTP - Added new supported() method -Change 33 on 1997/10/31 by (Graham Barr) +Change 33 on 1997/11/01 by (Graham Barr) Net::FTP - DESTORY now sends quit command @@ -967,15 +1081,15 @@ Change 33 on 1997/10/31 by (Graham Barr) now matches Net::FTP::I::read and the docs - speedup to read() -Change 18 on 1997/10/03 by (Graham Barr) +Change 18 on 1997/10/04 by (Graham Barr) Release 1.17 -Change 15 on 1997/09/26 by (Graham Barr) +Change 15 on 1997/09/27 by (Graham Barr) Email address and documentation changes -Change 14 on 1997/09/26 by (Graham Barr) +Change 14 on 1997/09/27 by (Graham Barr) Net::FTP - Added account method so ACCT command can be sent independantly @@ -995,7 +1109,7 @@ Change 14 on 1997/09/26 by (Graham Barr) Net::SNPP - Fixed a bug in ->new() while locating default host -Change 13 on 1997/09/26 by (Graham Barr) +Change 13 on 1997/09/27 by (Graham Barr) Net::FTP - Modified code which determined whether to connect via a Firewall. @@ -1004,7 +1118,7 @@ Change 13 on 1997/09/26 by (Graham Barr) - The Firewall option to new is now used in preference over the FTP_FIREWALL environment variable. -Change 12 on 1997/09/26 by (Graham Barr) +Change 12 on 1997/09/27 by (Graham Barr) Net::Cmd - modified ->response() to return CMD_ERROR if ->getline() returns @@ -1014,19 +1128,19 @@ Change 6 on 1997/09/14 by (Graham Barr) Small tweak to Makefile,PL to remove requirement for Data::Dumper -Change 3 on 1997/09/12 by (Graham Barr) +Change 3 on 1997/09/13 by (Graham Barr) Makefile.PL - Local config file libnet.cfg installed as Net::Config -Change 2 on 1997/09/12 by (Graham Barr) +Change 2 on 1997/09/13 by (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 (Graham Barr) +Change 1 on 1997/09/13 by (Graham Barr) A new beginning diff --git a/lib/Net/Cmd.pm b/lib/Net/Cmd.pm index b9d0208..9093fcd 100644 --- a/lib/Net/Cmd.pm +++ b/lib/Net/Cmd.pm @@ -1,4 +1,4 @@ -# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#26 $ +# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#28 $ # # Copyright (c) 1995-1997 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or @@ -12,6 +12,7 @@ require Exporter; use strict; use vars qw(@ISA @EXPORT $VERSION); use Carp; +use Symbol 'gensym'; BEGIN { if ($^O eq 'os390') { @@ -20,7 +21,7 @@ BEGIN { } } -$VERSION = "2.20"; +$VERSION = "2.21"; @ISA = qw(Exporter); @EXPORT = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING); @@ -476,6 +477,70 @@ sub dataend $cmd->response() == CMD_OK; } +# read and write to tied filehandle +sub tied_fh { + my $cmd = shift; + ${*$cmd}{'net_cmd_readbuf'} = ''; + my $fh = gensym(); + tie *$fh,ref($cmd),$cmd; + return $fh; +} + +# tie to myself +sub TIEHANDLE { + my $class = shift; + my $cmd = shift; + return $cmd; +} + +# Tied filehandle read. Reads requested data length, returning +# end-of-file when the dot is encountered. +sub READ { + my $cmd = shift; + my (undef,$len,$offset) = @_; + return unless exists ${*$cmd}{'net_cmd_readbuf'}; + my $done = 0; + while (!$done and length(${*$cmd}{'net_cmd_readbuf'}) < $len) { + ${*$cmd}{'net_cmd_readbuf'} .= $cmd->getline() or return; + $done++ if ${*$cmd}{'net_cmd_readbuf'} =~ s/^\.\r?\n\Z//m; + } + + $_[0] = ''; + substr($_[0],$offset+0) = substr(${*$cmd}{'net_cmd_readbuf'},0,$len); + substr(${*$cmd}{'net_cmd_readbuf'},0,$len) = ''; + delete ${*$cmd}{'net_cmd_readbuf'} if $done; + + return length $_[0]; +} + +sub READLINE { + my $cmd = shift; + # in this context, we use the presence of readbuf to + # indicate that we have not yet reached the eof + return unless exists ${*$cmd}{'net_cmd_readbuf'}; + my $line = $cmd->getline; + return if $line =~ /^\.\r?\n/; + $line; +} + +sub PRINT { + my $cmd = shift; + my ($buf,$len,$offset) = @_; + $len ||= length ($buf); + $offset += 0; + return unless $cmd->datasend(substr($buf,$offset,$len)); + ${*$cmd}{'net_cmd_sending'}++; # flag that we should call dataend() + return $len; +} + +sub CLOSE { + my $cmd = shift; + my $r = exists(${*$cmd}{'net_cmd_sending'}) ? $cmd->dataend : 1; + delete ${*$cmd}{'net_cmd_readbuf'}; + delete ${*$cmd}{'net_cmd_sending'}; + $r; +} + 1; __END__ @@ -619,6 +684,16 @@ Any lines starting with '..' will have one of the '.'s removed. Returns a reference to a list containing the lines, or I upon failure. +=item tied_fh () + +Returns a filehandle tied to the Net::Cmd object. After issuing a +command, you may read from this filehandle using read() or <>. The +filehandle will return EOF when the final dot is encountered. +Similarly, you may write to the filehandle in order to send data to +the server after issuing a commmand that expects data to be written. + +See the Net::POP3 and Net::SMTP modules for examples of this. + =back =head1 EXPORTS @@ -639,6 +714,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/Cmd.pm#26 $> +I<$Id: //depot/libnet/Net/Cmd.pm#28 $> =cut diff --git a/lib/Net/Config.pm b/lib/Net/Config.pm index c09b834..8984ed7 100644 --- a/lib/Net/Config.pm +++ b/lib/Net/Config.pm @@ -13,7 +13,7 @@ use strict; @EXPORT = qw(%NetConfig); @ISA = qw(Net::LocalCfg Exporter); -$VERSION = "1.09"; # $Id: //depot/libnet/Net/Config.pm#16 $ +$VERSION = "1.10"; # $Id: //depot/libnet/Net/Config.pm#17 $ eval { local $SIG{__DIE__}; require Net::LocalCfg }; @@ -36,24 +36,24 @@ eval { local $SIG{__DIE__}; require Net::LocalCfg }; # # Try to get as much configuration info as possible from InternetConfig # -$^O eq 'MacOS' and eval <<'TRY_INTERNET_CONFIG'; +$^O eq 'MacOS' and eval < [ $InternetConfig{ kICNNTPHost()} ], - pop3_hosts => [ $InternetConfig{ kICMailAccount()} =~ /@(.*)/ ], - smtp_hosts => [ $InternetConfig{ kICSMTPHost()} ], - ftp_testhost => [ $InternetConfig{ kICFTPHost()} ], - ph_hosts => [ $InternetConfig{ kICPhHost()} ], - ftp_ext_passive => $InternetConfig{"646F676F€UsePassiveMode"} || 0, - ftp_int_passive => $InternetConfig{"646F676F€UsePassiveMode"} || 0, + nntp_hosts => [ \$InternetConfig{ kICNNTPHost() } ], + pop3_hosts => [ \$InternetConfig{ kICMailAccount() } =~ /\@(.*)/ ], + smtp_hosts => [ \$InternetConfig{ kICSMTPHost() } ], + ftp_testhost => \$InternetConfig{ kICFTPHost() } ? \$InternetConfig{ kICFTPHost()} : undef, + ph_hosts => [ \$InternetConfig{ kICPhHost() } ], + ftp_ext_passive => \$InternetConfig{"646F676F\xA5UsePassiveMode"} || 0, + ftp_int_passive => \$InternetConfig{"646F676F\xA5UsePassiveMode"} || 0, socks_hosts => - $InternetConfig{kICUseSocks()} ? [ $InternetConfig{kICSocksHost()} ] : [], + \$InternetConfig{ kICUseSocks() } ? [ \$InternetConfig{ kICSocksHost() } ] : [], ftp_firewall => - $InternetConfig{kICUseFTPProxy()} ? [ $InternetConfig{kICFTPProxyHost()} ] : [], + \$InternetConfig{ kICUseFTPProxy() } ? [ \$InternetConfig{ kICFTPProxyHost() } ] : [], ); -@NetConfig{keys %nc} = values %nc; +\@NetConfig{keys %nc} = values %nc; } TRY_INTERNET_CONFIG @@ -309,6 +309,6 @@ If true then C will check each hostname given that it exists =for html
-I<$Id: //depot/libnet/Net/Config.pm#16 $> +I<$Id: //depot/libnet/Net/Config.pm#17 $> =cut diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm index d2780d3..28ea97d 100644 --- a/lib/Net/FTP.pm +++ b/lib/Net/FTP.pm @@ -22,7 +22,7 @@ use Net::Config; use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC); # use AutoLoader qw(AUTOLOAD); -$VERSION = "2.62"; # $Id: //depot/libnet/Net/FTP.pm#64 $ +$VERSION = "2.64"; # $Id: //depot/libnet/Net/FTP.pm#67 $ @ISA = qw(Exporter Net::Cmd IO::Socket::INET); # Someday I will "use constant", when I am not bothered to much about @@ -411,12 +411,10 @@ sub get { my($ftp,$remote,$local,$where) = @_; - my($loc,$len,$buf,$resp,$localfd,$data); + my($loc,$len,$buf,$resp,$data); local *FD; - $localfd = ref($local) || ref(\$local) eq "GLOB" - ? fileno($local) - : undef; + my $localfd = ref($local) || ref(\$local) eq "GLOB"; ($local = $remote) =~ s#^.*/## unless(defined $local); @@ -433,7 +431,7 @@ sub get $data = $ftp->retr($remote) or return undef; - if(defined $localfd) + if($localfd) { $loc = $local; } @@ -486,14 +484,14 @@ sub get carp "Cannot write to Local file $local: $!\n"; $data->abort; close($loc) - unless defined $localfd; + unless $localfd; return undef; } } print $hashh "\n" if $hashh; - unless (defined $localfd) + unless ($localfd) { unless (close($loc)) { @@ -672,17 +670,15 @@ sub appe { shift->_data_cmd("APPE",@_) } sub _store_cmd { my($ftp,$cmd,$local,$remote) = @_; - my($loc,$sock,$len,$buf,$localfd); + my($loc,$sock,$len,$buf); local *FD; - $localfd = ref($local) || ref(\$local) eq "GLOB" - ? fileno($local) - : undef; + my $localfd = ref($local) || ref(\$local) eq "GLOB"; unless(defined $remote) { croak 'Must specify remote filename with stream input' - if defined $localfd; + if $localfd; require File::Basename; $remote = File::Basename::basename($local); @@ -691,7 +687,7 @@ sub _store_cmd croak("Bad remote filename '$remote'\n") if $remote =~ /[\r\n]/s; - if(defined $localfd) + if($localfd) { $loc = $local; } @@ -729,7 +725,7 @@ sub _store_cmd { last unless $len = sysread($loc,$buf="",$blksize); - if (trEBCDIC) + if (trEBCDIC && $ftp->type ne 'I') { $buf = $ftp->toascii($buf); $len = length($buf); @@ -746,7 +742,7 @@ sub _store_cmd { $sock->abort; close($loc) - unless defined $localfd; + unless $localfd; print $hashh "\n" if $hashh; return undef; } @@ -755,7 +751,7 @@ sub _store_cmd print $hashh "\n" if $hashh; close($loc) - unless defined $localfd; + unless $localfd; $sock->close() or return undef; @@ -1301,8 +1297,8 @@ Log into the remote FTP server with the given login information. If no arguments are given then the C uses the C package to lookup the login information for the connected host. If no information is found then a login of I is used. -If no password is given and the login is I then the users -Email address will be used for a password. +If no password is given and the login is I then I +will be used for password. If the connection is via a firewall then the C method will be called with no arguments. @@ -1714,6 +1710,6 @@ under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/FTP.pm#64 $> +I<$Id: //depot/libnet/Net/FTP.pm#67 $> =cut diff --git a/lib/Net/FTP/I.pm b/lib/Net/FTP/I.pm index 18005f6..69619e7 100644 --- a/lib/Net/FTP/I.pm +++ b/lib/Net/FTP/I.pm @@ -1,4 +1,4 @@ -## $Id: //depot/libnet/Net/FTP/I.pm#12 $ +## $Id: //depot/libnet/Net/FTP/I.pm#13 $ ## Package to read/write on BINARY data connections ## @@ -10,7 +10,7 @@ use Carp; require Net::FTP::dataconn; @ISA = qw(Net::FTP::dataconn); -$VERSION = "1.11"; +$VERSION = "1.12"; sub read { my $data = shift; @@ -18,25 +18,28 @@ sub read { my $size = shift || croak 'read($buf,$size,[$timeout])'; my $timeout = @_ ? shift : $data->timeout; - $data->can_read($timeout) or - croak "Timeout"; + my $n; - my($b,$n,$l); - my $blksize = ${*$data}{'net_ftp_blksize'}; - $blksize = $size if $size > $blksize; + if ($size > length ${*$data} and !${*$data}{'net_ftp_eof'}) { + $data->can_read($timeout) or + croak "Timeout"; - while(($l = length(${*$data})) < $size) { - $n += ($b = sysread($data, ${*$data}, $blksize, $l)) || 0; - last unless $b; + my $blksize = ${*$data}{'net_ftp_blksize'}; + $blksize = $size if $size > $blksize; + + unless ($n = sysread($data, ${*$data}, $blksize, length ${*$data})) { + return undef unless defined $n; + ${*$data}{'net_ftp_eof'} = 1; + } } - $n = $size < ($l = length(${*$data})) ? $size : $l; + $buf = substr(${*$data},0,$size); + + $n = length($buf); - $buf = substr(${*$data},0,$n); substr(${*$data},0,$n) = ''; - ${*$data}{'net_ftp_bytesread'} += $n if $n; - ${*$data}{'net_ftp_eof'} = 1 unless $n; + ${*$data}{'net_ftp_bytesread'} += $n; $n; } diff --git a/lib/Net/NNTP.pm b/lib/Net/NNTP.pm index 0078cf4..521ccf1 100644 --- a/lib/Net/NNTP.pm +++ b/lib/Net/NNTP.pm @@ -14,7 +14,7 @@ use Carp; use Time::Local; use Net::Config; -$VERSION = "2.20"; # $Id: //depot/libnet/Net/NNTP.pm#14 $ +$VERSION = "2.21"; # $Id: //depot/libnet/Net/NNTP.pm#15 $ @ISA = qw(Net::Cmd IO::Socket::INET); sub new @@ -116,6 +116,14 @@ sub article : undef; } +sub articlefh { + @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->articlefh( [ MSGID ] )'; + my $nntp = shift; + + return unless $nntp->_ARTICLE(@_); + return $nntp->tied_fh; +} + sub authinfo { @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )'; @@ -147,6 +155,14 @@ sub body : undef; } +sub bodyfh +{ + @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->bodyfh( [ MSGID ] )'; + my $nntp = shift; + return unless $nntp->_BODY(@_); + return $nntp->tied_fh; +} + sub head { @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head( [ MSGID ], [ FH ] )'; @@ -160,6 +176,14 @@ sub head : undef; } +sub headfh +{ + @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->headfh( [ MSGID ] )'; + my $nntp = shift; + return unless $nntp->_HEAD(@_); + return $nntp->tied_fh; +} + sub nntpstat { @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )'; @@ -296,6 +320,12 @@ sub post : undef; } +sub postfh { + my $nntp = shift; + return unless $nntp->_POST(); + return $nntp->tied_fh; +} + sub quit { @_ == 1 or croak 'usage: $nntp->quit()'; @@ -743,6 +773,16 @@ Like C
but only fetches the body of the article. Like C
but only fetches the headers for the article. +=item articlefh ( [ MSGID|MSGNUM ] ) + +=item bodyfh ( [ MSGID|MSGNUM ] ) + +=item headfh ( [ MSGID|MSGNUM ] ) + +These are similar to article(), body() and head(), but rather than +returning the requested data directly, they return a tied filehandle +from which to read the article. + =item nntpstat ( [ MSGID|MSGNUM ] ) The C command is similar to the C
command except that no @@ -842,6 +882,15 @@ C and C methods from L C can be either an array of lines or a reference to an array. +=item postfh () + +Post a new article to the news server using a tied filehandle. If +posting is allowed, this method will return a tied filehandle that you +can print() the contents of the article to be posted. You must +explicitly close() the filehandle when you are finished posting the +article, and the return value from the close() call will indicate +whether the message was successfully posted. + =item slave () Tell the remote server that I am not a user client, but probably another @@ -1064,6 +1113,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/NNTP.pm#14 $> +I<$Id: //depot/libnet/Net/NNTP.pm#15 $> =cut diff --git a/lib/Net/Netrc.pm b/lib/Net/Netrc.pm index a44b6e3..02ebc82 100644 --- a/lib/Net/Netrc.pm +++ b/lib/Net/Netrc.pm @@ -11,7 +11,7 @@ use strict; use FileHandle; use vars qw($VERSION); -$VERSION = "2.12"; # $Id: //depot/libnet/Net/Netrc.pm#12 $ +$VERSION = "2.12"; # $Id: //depot/libnet/Net/Netrc.pm#13 $ my %netrc = (); @@ -76,8 +76,11 @@ sub _readrc s/^\s*//; chomp; - push(@tok, $+) - while(length && s/^("([^"]*)"|(\S+))\s*//); + + while(length && s/^("((?:[^"]+|\\.)*)"|((?:[^\\\s]+|\\.)*))\s*//) { + (my $tok = $+) =~ s/\\(.)/$1/g; + push(@tok, $tok); + } TOKEN: while(@tok) @@ -332,6 +335,6 @@ it under the same terms as Perl itself. =for html
-$Id: //depot/libnet/Net/Netrc.pm#12 $ +$Id: //depot/libnet/Net/Netrc.pm#13 $ =cut diff --git a/lib/Net/POP3.pm b/lib/Net/POP3.pm index 89f0313..1460416 100644 --- a/lib/Net/POP3.pm +++ b/lib/Net/POP3.pm @@ -13,7 +13,7 @@ use Net::Cmd; use Carp; use Net::Config; -$VERSION = "2.22"; # $Id: //depot/libnet/Net/POP3.pm#20 $ +$VERSION = "2.23"; # $Id: //depot/libnet/Net/POP3.pm#22 $ @ISA = qw(Net::Cmd IO::Socket::INET); @@ -71,19 +71,9 @@ 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 || "" - : ""; - } + if (@_ <= 2) { + ($user, $pass) = $me->_lookup_credentials($user); + } $me->user($user) and $me->pass($pass); @@ -94,40 +84,30 @@ 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"; + my $md; + + if (eval { local $SIG{__DIE__}; require Digest::MD5 }) { + $md = Digest::MD5->new(); + } elsif (eval { local $SIG{__DIE__}; require MD5 }) { + $md = MD5->new(); + } else { + carp "You need to install Digest::MD5 or MD5 to use the APOP command"; return undef; - } + } return undef unless ( $banner = (${*$me}{'net_pop3_banner'} =~ /(<.*>)/)[0] ); - if(@_ <= 2) - { - 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 || "" - : ""; - } + if (@_ <= 2) { + ($user, $pass) = $me->_lookup_credentials($user); + } - my $md = MD5->new; $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"; + $me->_get_mailbox_count(); } sub user @@ -145,10 +125,7 @@ sub 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"; + $me->_get_mailbox_count(); } sub reset @@ -235,6 +212,17 @@ sub get $me->read_until_dot(@_); } +sub getfh +{ + @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )'; + my $me = shift; + + return unless $me->_RETR(shift); + return $me->tied_fh; +} + + + sub delete { @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )'; @@ -277,6 +265,33 @@ sub ping ($1 || 0, $2 || 0); } +sub _lookup_credentials +{ + my ($me, $user) = @_; + + require Net::Netrc; + + $user ||= eval { local $SIG{__DIE__}; (getpwuid($>))[0] } || + $ENV{NAME} || $ENV{USER} || $ENV{LOGNAME}; + + my $m = Net::Netrc->lookup(${*$me}{'net_pop3_host'},$user); + $m ||= Net::Netrc->lookup(${*$me}{'net_pop3_host'}); + + my $pass = $m ? $m->password || "" + : ""; + + ($user, $pass); +} + +sub _get_mailbox_count +{ + my ($me) = @_; + my $ret = ${*$me}{'net_pop3_count'} = ($me->message =~ /(\d+)\s+message/io) + ? $1 : ($me->popstat)[0]; + + $ret ? $ret : "0E0"; +} + sub _STAT { shift->command('STAT')->response() == CMD_OK } sub _LIST { shift->command('LIST',@_)->response() == CMD_OK } @@ -348,7 +363,7 @@ __END__ =head1 NAME -Net::POP3 - Post Office Protocol 3 Client class (RFC1081) +Net::POP3 - Post Office Protocol 3 Client class (RFC1939) =head1 SYNOPSIS @@ -362,7 +377,7 @@ Net::POP3 - Post Office Protocol 3 Client class (RFC1081) 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. +that you are familiar with the POP3 protocol described in RFC1939. A new Net::POP3 object must be created with the I method. Once this has been done, all POP3 commands are accessed via method calls @@ -428,14 +443,13 @@ 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 will be returned. -=item apop ( USER, PASS ) +=item apop ( [ USER [, PASS ]] ) Authenticate with the server identifying as C with password C. -Similar ti L, 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 +Similar to L, but the password is not sent in clear text. +To use this method you must have the Digest::MD5 or the MD5 module installed, +otherwise this method will return I. =item top ( MSGNUM [, NUMLINES ] ) @@ -459,6 +473,12 @@ then get returns a reference to an array which contains the lines of text read from the server. If C is given then the lines returned from the server are printed to the filehandle C. +=item getfh ( MSGNUM ) + +As per get(), but returns a tied filehandle. Reading from this +filehandle returns the requested message. The filehandle will return +EOF at the end of the message and should not be reused. + =item last () Returns the highest C of all the messages accessed. @@ -505,7 +525,7 @@ means that any messages marked to be deleted will not be. =head1 SEE ALSO -L +L, L =head1 AUTHOR @@ -520,6 +540,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/POP3.pm#20 $> +I<$Id: //depot/libnet/Net/POP3.pm#22 $> =cut diff --git a/lib/Net/SMTP.pm b/lib/Net/SMTP.pm index bae5835..e76863d 100644 --- a/lib/Net/SMTP.pm +++ b/lib/Net/SMTP.pm @@ -16,7 +16,7 @@ use IO::Socket; use Net::Cmd; use Net::Config; -$VERSION = "2.19"; # $Id: //depot/libnet/Net/SMTP.pm#20 $ +$VERSION = "2.21"; # $Id: //depot/libnet/Net/SMTP.pm#22 $ @ISA = qw(Net::Cmd IO::Socket::INET); @@ -34,6 +34,8 @@ sub new { $obj = $type->SUPER::new(PeerAddr => ($host = $h), PeerPort => $arg{Port} || 'smtp(25)', + LocalAddr => $arg{LocalAddr}, + LocalPort => $arg{LocalPort}, Proto => 'tcp', Timeout => defined $arg{Timeout} ? $arg{Timeout} @@ -344,6 +346,12 @@ sub data : $ok; } +sub datafh { + my $me = shift; + return unless $me->_DATA(); + return $me->tied_fh; +} + sub expand { my $me = shift; @@ -477,6 +485,9 @@ B - 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 and B - These parameters are passed directly +to IO::Socket to allow binding the socket to a local port. + B - Maximum time, in seconds, to wait for a response from the SMTP server (default: 120) @@ -636,6 +647,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/SMTP.pm#20 $> +I<$Id: //depot/libnet/Net/SMTP.pm#22 $> =cut diff --git a/lib/Net/t/netrc.t b/lib/Net/t/netrc.t index 464794b..cb5c35d 100644 --- a/lib/Net/t/netrc.t +++ b/lib/Net/t/netrc.t @@ -47,7 +47,7 @@ ok( exists $INC{'Net/Netrc.pm'}, 'should be able to use Net::Netrc' ); SKIP: { skip('incompatible stat() handling for OS', 4), next SKIP - if ($^O =~ /os2|win32|macos|cygwin/i); + if ($^O =~ /os2|win32|macos|cygwin/i or $] < 5.005); my $warn; local $SIG{__WARN__} = sub { @@ -58,8 +58,8 @@ SKIP: { $stat[2] = 077; ok( !defined(Net::Netrc::_readrc()), '_readrc() should not read world-writable file' ); - ok( scalar( $warn =~ /^Bad permissions:/ ), - '... and should warn about it' ); + ok( scalar($warn =~ /^Bad permissions:/), + '... and should warn about it' ); # the owner field should still not match $stat[2] = 0; @@ -67,10 +67,10 @@ SKIP: { if ($<) { ok( !defined(Net::Netrc::_readrc()), '_readrc() should not read file owned by someone else' ); - ok( scalar( $warn =~ /^Not owner:/ ), - '... and should warn about it' ); + ok( scalar($warn =~ /^Not owner:/), + '... and should warn about it' ); } else { - ok(1, "Skip - testing as root") for 1..2; + skip("testing as root",2); } } @@ -138,7 +138,7 @@ sub new { } sub TIEHANDLE { - my ($class, undef, $file, $mode) = @_; + my ($class, $file, $mode) = @_[0,2,3]; bless({ file => $file, mode => $mode }, $class); }