From: Graham Barr Date: Mon, 2 Jun 2003 12:13:35 +0000 (+0000) Subject: Sync with libnet 1.14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dea4d7dfbb03f4a0014d53b245f3d8b5b801961c;p=p5sagit%2Fp5-mst-13.2.git Sync with libnet 1.14 p4raw-id: //depot/perl@19661 --- diff --git a/lib/Net/ChangeLog.libnet b/lib/Net/ChangeLog.libnet index 7b8c73f..259d623 100644 --- a/lib/Net/ChangeLog.libnet +++ b/lib/Net/ChangeLog.libnet @@ -1,3 +1,99 @@ +Change 805 on 2003/06/02 by (Graham Barr) + + Net::Cmd + - Avoid process death from SIGPIPE + +Change 804 on 2003/05/27 by (Graham Barr) + + Net::FTP + - Support for ALLO command (patch from Matthew N. Andrews) + +Change 803 on 2003/05/27 by (Graham Barr) + + libnetFAQ + - Fix URLs + +Change 802 on 2003/05/21 by (Graham Barr) + + Use read/print instead of sysread/syswrite for local files + so CRLF translation happens if it needs to + +Change 801 on 2003/05/20 by (Graham Barr) + + Net::FTP, Net::NNTP + - doc updates from Jarkko + +Change 800 on 2003/05/20 by (Graham Barr) + + Net::Domain + - Look in environment on VMS for domainname + (patch from Michael Cartmell) + +Change 799 on 2003/05/20 by (Graham Barr) + + Net::SMTP + - Allow multiple hosts to be passed to new() as an array reference + +Change 798 on 2003/05/20 by (Graham Barr) + + Net::FTP + - Add some error checking to the examples in the SYNOPSIS + +Change 797 on 2003/05/20 by (Graham Barr) + + Net::SMTP + - Support MTAs with broken HELO response + (patch from Michael Driscoll) + +Change 796 on 2003/05/20 by (Graham Barr) + + Net::POP3 + - Add small example to SYNOPSIS + +Change 795 on 2003/05/20 by (Graham Barr) + + Net::NNTP + - Add post clarifications to pod + +Change 794 on 2003/05/20 by (Graham Barr) + + Net::SMTP, Net::Cmd + - Support for BINARYMIME + (patch from Richard Coles) + +Change 793 on 2003/05/20 by (Graham Barr) + + Net::FTP + - Allow the firewall type to be specified in Net::Config + (patch from Philip Newton) + +Change 792 on 2003/05/20 by (Graham Barr) + + Net::SMTP + - Fixes to the DSN parameter to mail() + (patch from Rafael Garcia-Suarez) + +Change 791 on 2003/05/20 by (Graham Barr) + + Net::FTP::A + - Fix CRLF translation in write() + +Change 790 on 2003/05/20 by (Graham Barr) + + Net::Cmd + - Improve performance of CRLF translation when sending data + +Change 789 on 2003/05/20 by (Graham Barr) + + Net::SMTP + - Make the use of email address extraction configurable. By default + it is now back how it was + +Change 788 on 2003/05/20 by (Graham Barr) + + Net::NNTP + - Prevent instance methods being called as class methods when debug is turned on + Change 772 on 2003/03/03 by (Graham Barr) Release 1.13 diff --git a/lib/Net/Cmd.pm b/lib/Net/Cmd.pm index f89914e..6899a97 100644 --- a/lib/Net/Cmd.pm +++ b/lib/Net/Cmd.pm @@ -1,4 +1,4 @@ -# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#30 $ +# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#33 $ # # Copyright (c) 1995-1997 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or @@ -21,7 +21,7 @@ BEGIN { } } -$VERSION = "2.23"; +$VERSION = "2.24"; @ISA = qw(Exporter); @EXPORT = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING); @@ -198,7 +198,7 @@ sub command $cmd->dataend() - if(exists ${*$cmd}{'net_cmd_lastch'}); + if(exists ${*$cmd}{'net_cmd_need_crlf'}); if (scalar(@_)) { @@ -392,8 +392,13 @@ sub datasend return 0 unless defined(fileno($cmd)); - return 1 - unless length($line); + unless (length $line) { + # Even though we are not sending anything, the fact we were + # called means that dataend needs to be called before the next + # command, which happens of net_cmd_need_crlf exists + ${*$cmd}{'net_cmd_need_crlf'} ||= 0; + return 1; + } if($cmd->debug) { foreach my $b (split(/\n/,$line)) { @@ -401,23 +406,22 @@ sub datasend } } - # Translate LF => CRLF, but not if the LF is - # already preceeded by a CR - $line =~ s/\G()\n|([^\r\n])\n/$+\015\012/sgo; - - ${*$cmd}{'net_cmd_lastch'} ||= " "; - $line = ${*$cmd}{'net_cmd_lastch'} . $line; + $line =~ s/\r?\n/\r\n/sg; + $line =~ tr/\r\n/\015\012/ unless "\r" eq "\015"; $line =~ s/(\012\.)/$1./sog; + $line =~ s/^\./../ unless ${*$cmd}{'net_cmd_need_crlf'}; - ${*$cmd}{'net_cmd_lastch'} = substr($line,-1,1); + ${*$cmd}{'net_cmd_need_crlf'} = substr($line,-1,1) ne "\012"; - my $len = length($line) - 1; - my $offset = 1; + my $len = length($line); + my $offset = 0; my $win = ""; vec($win,fileno($cmd),1) = 1; my $timeout = $cmd->timeout || undef; + local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS'; + while($len) { my $wout; @@ -442,30 +446,73 @@ sub datasend 1; } -sub dataend +sub rawdatasend { my $cmd = shift; + my $arr = @_ == 1 && ref($_[0]) ? $_[0] : \@_; + my $line = join("" ,@$arr); return 0 unless defined(fileno($cmd)); return 1 - unless(exists ${*$cmd}{'net_cmd_lastch'}); + unless length($line); - if(${*$cmd}{'net_cmd_lastch'} eq "\015") + if($cmd->debug) { - syswrite($cmd,"\012",1); + my $b = "$cmd>>> "; + print STDERR $b,join("\n$b",split(/\n/,$line)),"\n"; } - elsif(${*$cmd}{'net_cmd_lastch'} ne "\012") + + my $len = length($line); + my $offset = 0; + my $win = ""; + vec($win,fileno($cmd),1) = 1; + my $timeout = $cmd->timeout || undef; + + local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS'; + while($len) { - syswrite($cmd,"\015\012",2); + 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_need_crlf'}); + + local $SIG{PIPE} = 'IGNORE' unless $^O eq 'MacOS'; + syswrite($cmd,"\015\012",2) + if ${*$cmd}{'net_cmd_need_crlf'}; + $cmd->debug_print(1, ".\n") if($cmd->debug); syswrite($cmd,".\015\012",3); - delete ${*$cmd}{'net_cmd_lastch'}; + delete ${*$cmd}{'net_cmd_need_crlf'}; $cmd->response() == CMD_OK; } @@ -670,6 +717,11 @@ some C calls into your method. Unget a line of text from the server. +=item rawdatasend ( DATA ) + +Send data to the remote server without performing any conversions. C +is a scalar. + =item read_until_dot () Read data from the remote server until a line consisting of a single '.'. @@ -707,6 +759,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/Cmd.pm#30 $> +I<$Id: //depot/libnet/Net/Cmd.pm#33 $> =cut diff --git a/lib/Net/Domain.pm b/lib/Net/Domain.pm index b79ec8f..c213ce9 100644 --- a/lib/Net/Domain.pm +++ b/lib/Net/Domain.pm @@ -16,7 +16,7 @@ use Net::Config; @ISA = qw(Exporter); @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname); -$VERSION = "2.17"; # $Id: //depot/libnet/Net/Domain.pm#19 $ +$VERSION = "2.18"; # $Id: //depot/libnet/Net/Domain.pm#20 $ my($host,$domain,$fqdn) = (undef,undef,undef); @@ -164,6 +164,11 @@ sub _hostdomain { : undef; }; + if ( $^O eq 'VMS' ) { + $dom ||= $ENV{'TCPIP$INET_DOMAIN'} + || $ENV{'UCX$INET_DOMAIN'}; + } + chop($dom = `domainname 2>/dev/null`) unless(defined $dom || $^O =~ /^(?:cygwin|MSWin32)/); @@ -331,6 +336,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/Domain.pm#19 $> +I<$Id: //depot/libnet/Net/Domain.pm#20 $> =cut diff --git a/lib/Net/FTP.pm b/lib/Net/FTP.pm index 054ce0f..19420a1 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.67"; # $Id: //depot/libnet/Net/FTP.pm#70 $ +$VERSION = "2.69"; # $Id: //depot/libnet/Net/FTP.pm#75 $ @ISA = qw(Exporter Net::Cmd IO::Socket::INET); # Someday I will "use constant", when I am not bothered to much about @@ -70,6 +70,7 @@ sub new delete $arg{Port}; $fire_type = $arg{FirewallType} || $ENV{FTP_FIREWALL_TYPE} + || $NetConfig{firewall_type} || undef; } } @@ -391,6 +392,23 @@ sub type ${*$ftp}{'net_ftp_type'} = join(" ",$type,@_); +sub alloc +{ + my $ftp = shift; + my $size = shift; + my $oldval = ${*$ftp}{'net_ftp_allo'}; + + return $oldval + unless (defined $size); + + return undef + unless ($ftp->_ALLO($size,@_)); + + ${*$ftp}{'net_ftp_allo'} = join(" ",$size,@_); + + $oldval; +} + $oldval; } @@ -465,6 +483,7 @@ sub get if($ref = ${*$ftp}{'net_ftp_hash'}); my $blksize = ${*$ftp}{'net_ftp_blksize'}; + local $\; # Just in case while(1) { @@ -481,8 +500,7 @@ sub get print $hashh "#" x (int($count / $hashb)); $count %= $hashb; } - my $written = syswrite($loc,$buf,$len); - unless(defined($written) && $written == $len) + unless(print $loc $buf) { carp "Cannot write to Local file $local: $!\n"; $data->abort; @@ -686,7 +704,17 @@ sub _store_cmd require File::Basename; $remote = File::Basename::basename($local); } - + if( defined ${*$ftp}{'net_ftp_allo'} ) + { + delete ${*$ftp}{'net_ftp_allo'}; + } else + { + # if the user hasn't already invoked the alloc method since the last + # _store_cmd call, figure out if the local file is a regular file(not + # a pipe, or device) and if so get the file size from stat, and send + # an ALLO command before sending the STOR, STOU, or APPE command. + $ftp->_ALLO(-s _) if -f $loc; # no ALLO if sending data from a pipe + } croak("Bad remote filename '$remote'\n") if $remote =~ /[\r\n]/s; @@ -729,7 +757,7 @@ sub _store_cmd while(1) { - last unless $len = sysread($loc,$buf="",$blksize); + last unless $len = read($loc,$buf="",$blksize); if (trEBCDIC && $ftp->type ne 'I') { @@ -1149,6 +1177,7 @@ sub cmd { shift->command(@_)->response() } # sub _ABOR { shift->command("ABOR")->response() == CMD_OK } +sub _ALLO { shift->command("ALLO",@_)->response() == CMD_OK} sub _CDUP { shift->command("CDUP")->response() == CMD_OK } sub _NOOP { shift->command("NOOP")->response() == CMD_OK } sub _PASV { shift->command("PASV")->response() == CMD_OK } @@ -1179,7 +1208,6 @@ 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(@_) } @@ -1198,10 +1226,18 @@ Net::FTP - FTP Client class use Net::FTP; - $ftp = Net::FTP->new("some.host.name", Debug => 0); - $ftp->login("anonymous",'-anonymous@'); - $ftp->cwd("/pub"); - $ftp->get("that.file"); + $ftp = Net::FTP->new("some.host.name", Debug => 0) + or die "Cannot connect to some.host.name: $@"; + + $ftp->login("anonymous",'-anonymous@') + or die "Cannot login ", $ftp->message; + + $ftp->cwd("/pub") + or die "Cannot change working directory ", $ftp->message; + + $ftp->get("that.file") + or die "get failed ", $ftp->message; + $ftp->quit; =head1 DESCRIPTION @@ -1381,6 +1417,20 @@ Returns the full pathname to the new directory. =item ls ( [ DIR ] ) +=item alloc ( SIZE [, RECORD_SIZE] ) + +The alloc command allows you to give the ftp server a hint about the size +of the file about to be transfered using the ALLO ftp command. Some storage +systems use this to make intelligent decisions about how to store the file. +The C argument represents the size of the file in bytes. The +C argument indicates a mazimum record or page size for files +sent with a record or page structure. + +The size of the file will be determined, and sent to the server +automatically for normal files so that this method need only be called if +you are transfering data from a socket, named pipe, or other stream not +associated with a normal file. + Get a directory listing of C, or the current directory. In an array context, returns a list of lines returned from the server. In @@ -1629,10 +1679,6 @@ The following RFC959 commands have not been implemented: =over 4 -=item B - -Allocates storage for the file to be transferred. - =item B Mount a different file system structure without changing login or @@ -1720,6 +1766,6 @@ under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/FTP.pm#70 $> +I<$Id: //depot/libnet/Net/FTP.pm#75 $> =cut diff --git a/lib/Net/FTP/A.pm b/lib/Net/FTP/A.pm index 764e915..d068828 100644 --- a/lib/Net/FTP/A.pm +++ b/lib/Net/FTP/A.pm @@ -1,4 +1,4 @@ -## $Id: //depot/libnet/Net/FTP/A.pm#16 $ +## $Id: //depot/libnet/Net/FTP/A.pm#17 $ ## Package to read/write on ASCII data connections ## @@ -10,7 +10,7 @@ use Carp; require Net::FTP::dataconn; @ISA = qw(Net::FTP::dataconn); -$VERSION = "1.15"; +$VERSION = "1.16"; sub read { my $data = shift; @@ -71,7 +71,7 @@ sub write { my $size = shift || croak 'write($buf,$size,[$timeout])'; my $timeout = @_ ? shift : $data->timeout; - (my $tmp = substr($buf,0,$size)) =~ s/\n/\015\012/sg; + (my $tmp = substr($buf,0,$size)) =~ s/\r?\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 diff --git a/lib/Net/NNTP.pm b/lib/Net/NNTP.pm index 0076405..79261f8 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.21"; # $Id: //depot/libnet/Net/NNTP.pm#15 $ +$VERSION = "2.22"; # $Id: //depot/libnet/Net/NNTP.pm#18 $ @ISA = qw(Net::Cmd IO::Socket::INET); sub new @@ -87,7 +87,7 @@ sub debug_text my $inout = shift; my $text = shift; - if(($nntp->code == 350 && $text =~ /^(\S+)/) + if((ref($nntp) and $nntp->code == 350 and $text =~ /^(\S+)/) || ($text =~ /^(authinfo\s+pass)/io)) { $text = "$1 ....\n" @@ -882,6 +882,10 @@ C and C methods from L C can be either an array of lines or a reference to an array. +The message, either sent via C or as the C +parameter, must be in the format as described by RFC822 and must +contain From:, Newsgroups: and Subject: headers. + =item postfh () Post a new article to the news server using a tied filehandle. If @@ -1113,6 +1117,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/NNTP.pm#15 $> +I<$Id: //depot/libnet/Net/NNTP.pm#18 $> =cut diff --git a/lib/Net/POP3.pm b/lib/Net/POP3.pm index 3263f47..7cd44ef 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.24"; # $Id: //depot/libnet/Net/POP3.pm#23 $ +$VERSION = "2.24"; # $Id: //depot/libnet/Net/POP3.pm#24 $ @ISA = qw(Net::Cmd IO::Socket::INET); @@ -373,6 +373,17 @@ Net::POP3 - Post Office Protocol 3 Client class (RFC1939) $pop = Net::POP3->new('pop3host'); $pop = Net::POP3->new('pop3host', Timeout => 60); + if ($pop->login($username, $password) > 0) { + my $msgnums = $pop->list; # hashref of msgnum => size + foreach my $msgnum (keys %$msgnums) { + my $msg = $pop->get($msgnum); + print @$msg; + $pop->delete($msgnum); + } + } + + $pop->quit; + =head1 DESCRIPTION This module implements a client interface to the POP3 protocol, enabling @@ -383,10 +394,6 @@ 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 on the object. -=head1 EXAMPLES - - Need some small examples in here :-) - =head1 CONSTRUCTOR =over 4 @@ -540,6 +547,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/POP3.pm#23 $> +I<$Id: //depot/libnet/Net/POP3.pm#24 $> =cut diff --git a/lib/Net/README.libnet b/lib/Net/README.libnet index fd115a2..ca47fe5 100644 --- a/lib/Net/README.libnet +++ b/lib/Net/README.libnet @@ -3,7 +3,7 @@ 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 +can be found a various places on the WEB, for a starting point look at: http://www.yahoo.com/Computers_and_Internet/Standards/RFCs/ diff --git a/lib/Net/SMTP.pm b/lib/Net/SMTP.pm index 613d1db..be64037 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.25"; # $Id: //depot/libnet/Net/SMTP.pm#26 $ +$VERSION = "2.26"; # $Id: //depot/libnet/Net/SMTP.pm#31 $ @ISA = qw(Net::Cmd IO::Socket::INET); @@ -26,11 +26,11 @@ sub new my $type = ref($self) || $self; my $host = shift if @_ % 2; my %arg = @_; - my $hosts = defined $host ? [ $host ] : $NetConfig{smtp_hosts}; + my $hosts = defined $host ? $host : $NetConfig{smtp_hosts}; my $obj; my $h; - foreach $h (@{$hosts}) + foreach $h (@{ref($hosts) ? $hosts : [ $hosts ]}) { $obj = $type->SUPER::new(PeerAddr => ($host = $h), PeerPort => $arg{Port} || 'smtp(25)', @@ -56,6 +56,7 @@ sub new return undef; } + ${*$obj}{'net_smtp_exact_addr'} = $arg{ExactAddresses}; ${*$obj}{'net_smtp_host'} = $host; (${*$obj}{'net_smtp_banner'}) = $obj->message; @@ -167,9 +168,10 @@ sub hello if $ok = $me->_HELO($domain); } - $ok && $msg[0] =~ /\A\s*(\S+)/ - ? $1 - : undef; + return undef unless $ok; + + $msg[0] =~ /\A\s*(\S+)/; + return ($1 || " "); } sub supports { @@ -183,16 +185,25 @@ sub supports { } sub _addr { + my $self = shift; my $addr = shift; $addr = "" unless defined $addr; - $addr =~ s/^\s*?\s*$//sg; + + if (${*$self}{'net_smtp_exact_addr'}) { + return $1 if $addr =~ /^\s*(<.*>)\s*$/s; + } + else { + return $1 if $addr =~ /(<[^>]*>)/; + $addr =~ s/^\s+|\s+$//sg; + } + "<$addr>"; } sub mail { my $me = shift; - my $addr = _addr(shift); + my $addr = _addr($me, shift); my $opts = ""; if(@_) @@ -220,7 +231,7 @@ sub mail { if(exists $esmtp->{DSN}) { - $opts .= " RET=" . uc $v + $opts .= " RET=" . ((uc($v) eq "FULL") ? "FULL" : "HDRS"); } else { @@ -230,13 +241,36 @@ sub mail if(defined($v = delete $opt{Bits})) { - if(exists $esmtp->{'8BITMIME'}) + if($v eq "8") + { + if(exists $esmtp->{'8BITMIME'}) + { + $opts .= " BODY=8BITMIME"; + } + else + { + carp 'Net::SMTP::mail: 8BITMIME option not supported by host'; + } + } + elsif($v eq "binary") + { + if(exists $esmtp->{'BINARYMIME'} && exists $esmtp->{'CHUNKING'}) + { + $opts .= " BODY=BINARYMIME"; + ${*$me}{'net_smtp_chunking'} = 1; + } + else + { + carp 'Net::SMTP::mail: BINARYMIME option not supported by host'; + } + } + elsif(exists $esmtp->{'8BITMIME'} or exists $esmtp->{'BINARYMIME'}) { - $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT" + $opts .= " BODY=7BIT"; } else { - carp 'Net::SMTP::mail: 8BITMIME option not supported by host'; + carp 'Net::SMTP::mail: 8BITMIME and BINARYMIME options not supported by host'; } } @@ -244,7 +278,7 @@ sub mail { if(exists $esmtp->{CHECKPOINT}) { - $opts .= " TRANSID=" . _addr($v); + $opts .= " TRANSID=" . _addr($me, $v); } else { @@ -279,9 +313,9 @@ sub mail $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 send { my $me = shift; $me->_SEND("FROM:" . _addr($me, $_[0])) } +sub send_or_mail { my $me = shift; $me->_SOML("FROM:" . _addr($me, $_[0])) } +sub send_and_mail { my $me = shift; $me->_SAML("FROM:" . _addr($me, $_[0])) } sub reset { @@ -338,7 +372,7 @@ sub recipient my $addr; foreach $addr (@_) { - if($smtp->_RCPT("TO:" . _addr($addr) . $opts)) { + if($smtp->_RCPT("TO:" . _addr($smtp, $addr) . $opts)) { push(@ok,$addr) if $skip_bad; } elsif(!$skip_bad) { @@ -359,10 +393,51 @@ sub data { my $me = shift; - my $ok = $me->_DATA() && $me->datasend(@_); + if(exists ${*$me}{'net_smtp_chunking'}) + { + carp 'Net::SMTP::data: CHUNKING extension in use, must call bdat instead'; + } + else + { + my $ok = $me->_DATA() && $me->datasend(@_); + + $ok && @_ ? $me->dataend + : $ok; + } +} + +sub bdat +{ + my $me = shift; + + if(exists ${*$me}{'net_smtp_chunking'}) + { + my $data = shift; - $ok && @_ ? $me->dataend - : $ok; + $me->_BDAT(length $data) && $me->rawdatasend($data) && + $me->response() == CMD_OK; + } + else + { + carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead'; + } +} + +sub bdatlast +{ + my $me = shift; + + if(exists ${*$me}{'net_smtp_chunking'}) + { + my $data = shift; + + $me->_BDAT(length $data, "LAST") && $me->rawdatasend($data) && + $me->response() == CMD_OK; + } + else + { + carp 'Net::SMTP::bdat: CHUNKING extension is not in use, call data instead'; + } } sub datafh { @@ -421,6 +496,7 @@ sub _RSET { shift->command("RSET")->response() == CMD_OK } sub _NOOP { shift->command("NOOP")->response() == CMD_OK } sub _QUIT { shift->command("QUIT")->response() == CMD_OK } sub _DATA { shift->command("DATA")->response() == CMD_MORE } +sub _BDAT { shift->command("BDAT", @_) } sub _TURN { shift->unsupported(@_); } sub _ETRN { shift->command("ETRN", @_)->response() == CMD_OK } sub _AUTH { shift->command("AUTH", @_)->response() == CMD_OK } @@ -494,6 +570,9 @@ known as mailhost: This is the constructor for a new Net::SMTP object. C is the name of the remote host to which an SMTP connection is required. +If C is an array reference then each value will be attempted +in turn until a connection is made. + If C is not given, then the C specified in C will be used. @@ -510,6 +589,10 @@ 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) +B - If true the all ADDRESS arguments must be as +defined by C in RFC2822. If not given, or false, then +Net::SMTP will attempt to extract the address from the value passed. + B - Enable debugging information @@ -575,11 +658,13 @@ The C method can some additional ESMTP OPTIONS which is passed in hash like fashion, using key and value pairs. Possible options are: Size => - Return => - Bits => "7" | "8" + Return => "FULL" | "HDRS" + Bits => "7" | "8" | "binary" Transaction =>
Envelope => +The C and C parameters are used for DSN (Delivery +Status Notification). =item reset () @@ -650,8 +735,15 @@ Send the QUIT command to the remote SMTP server and close the socket connection. =head1 ADDRESSES -All methods that accept addresses expect the address to be a valid rfc2821-quoted address, although -Net::SMTP will accept accept the address surrounded by angle brackets. +Net::SMTP attempts to DWIM with addresses that are passed. For +example an application might extract The From: line from an email +and pass that to mail(). While this may work, it is not reccomended. +The application should really use a module like L +to extract the mail address and pass that. + +If C is passed to the contructor, then addresses +should be a valid rfc2821-quoted address, although Net::SMTP will +accept accept the address surrounded by angle brackets. funny user@domain WRONG "funny user"@domain RIGHT, recommended @@ -673,6 +765,6 @@ it under the same terms as Perl itself. =for html
-I<$Id: //depot/libnet/Net/SMTP.pm#26 $> +I<$Id: //depot/libnet/Net/SMTP.pm#31 $> =cut diff --git a/lib/Net/libnetFAQ.pod b/lib/Net/libnetFAQ.pod index d370e84..9858f2b 100644 --- a/lib/Net/libnetFAQ.pod +++ b/lib/Net/libnetFAQ.pod @@ -9,7 +9,7 @@ libnetFAQ - libnet Frequently Asked Questions This document is distributed with the libnet distribution, and is also available on the libnet web page at - http://www.pobox.com/~gbarr/libnet/ + http://search.cpan.org/~gbarr/libnet/ =head2 How to contribute to this document @@ -70,7 +70,7 @@ in The latest release and information is also available on the libnet web page at - http://www.pobox.com/~gbarr/libnet/ + http://search.cpan.org/~gbarr/libnet/ =head1 Using Net::FTP @@ -303,5 +303,5 @@ All rights reserved. =for html
-I<$Id: //depot/libnet/Net/libnetFAQ.pod#5 $> +I<$Id: //depot/libnet/Net/libnetFAQ.pod#6 $> diff --git a/lib/Net/t/hostname.t b/lib/Net/t/hostname.t index 7e94b23..e085591 100644 --- a/lib/Net/t/hostname.t +++ b/lib/Net/t/hostname.t @@ -32,11 +32,11 @@ else { print "not ok 1\n"; } -# This checks that hostname does not overwrite $_ +# This check thats hostanme does not overwrite $_ my @domain = qw(foo.example.com bar.example.jp); my @copy = @domain; -my @dummy = grep { hostname && $_ } @domain; +my @dummy = grep { hostname eq $_ } @domain; ($domain[0] && $domain[0] eq $copy[0]) ? print "ok 2\n"