diff options
author | Graham Barr <gbarr@pobox.com> | 2003-05-20 11:07:21 +0000 |
---|---|---|
committer | Graham Barr <gbarr@pobox.com> | 2003-05-20 11:07:21 +0000 |
commit | 9a1c66bdf9eac4e3741897fcf999609fd82d4f76 (patch) | |
tree | 72dd57242a91137eada6747a3b9f814807aa4b44 | |
parent | 140a1182bfc7f97afce0d1114a56826b24a4d85d (diff) | |
download | perl-libnet-9a1c66bdf9eac4e3741897fcf999609fd82d4f76.tar.gz |
Net::SMTP, Net::Cmd
- Support for BINARYMIME (patch from Richard Coles)
-rw-r--r-- | Net/Cmd.pm | 56 | ||||
-rw-r--r-- | Net/SMTP.pm | 83 |
2 files changed, 128 insertions, 11 deletions
@@ -1,4 +1,4 @@ -# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#31 $ +# Net::Cmd.pm $Id: //depot/libnet/Net/Cmd.pm#32 $ # # Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved. # This program is free software; you can redistribute it and/or @@ -444,6 +444,53 @@ sub datasend 1; } +sub rawdatasend +{ + my $cmd = shift; + my $arr = @_ == 1 && ref($_[0]) ? $_[0] : \@_; + my $line = join("" ,@$arr); + + return 0 unless defined(fileno($cmd)); + + return 1 + unless length($line); + + if($cmd->debug) + { + my $b = "$cmd>>> "; + print STDERR $b,join("\n$b",split(/\n/,$line)),"\n"; + } + + my $len = length($line); + my $offset = 0; + my $win = ""; + vec($win,fileno($cmd),1) = 1; + my $timeout = $cmd->timeout || undef; + + 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; @@ -666,6 +713,11 @@ some C<debug_print> 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<DATA> +is a scalar. + =item read_until_dot () Read data from the remote server until a line consisting of a single '.'. @@ -703,6 +755,6 @@ it under the same terms as Perl itself. =for html <hr> -I<$Id: //depot/libnet/Net/Cmd.pm#31 $> +I<$Id: //depot/libnet/Net/Cmd.pm#32 $> =cut diff --git a/Net/SMTP.pm b/Net/SMTP.pm index b5efb95..8a7d2ed 100644 --- a/Net/SMTP.pm +++ b/Net/SMTP.pm @@ -16,7 +16,7 @@ use IO::Socket; use Net::Cmd; use Net::Config; -$VERSION = "2.26"; # $Id: //depot/libnet/Net/SMTP.pm#28 $ +$VERSION = "2.26"; # $Id: //depot/libnet/Net/SMTP.pm#29 $ @ISA = qw(Net::Cmd IO::Socket::INET); @@ -240,13 +240,36 @@ sub mail if(defined($v = delete $opt{Bits})) { - if(exists $esmtp->{'8BITMIME'}) + if($v eq "8") { - $opts .= $v == 8 ? " BODY=8BITMIME" : " BODY=7BIT" + if(exists $esmtp->{'8BITMIME'}) + { + $opts .= " BODY=8BITMIME"; + } + else + { + carp 'Net::SMTP::mail: 8BITMIME option not supported by host'; + } + } + elsif($v eq "binary") + { + if(exists $esmtp->{'BINARYMIME'} && exists $esmtp->{'CHUNKING'}) + { + $opts .= " BODY=BINARYMIME"; + ${*$me}{'net_smtp_chunking'} = 1; + } + else + { + carp 'Net::SMTP::mail: BINARYMIME option not supported by host'; + } + } + elsif(exists $esmtp->{'8BITMIME'} or exists $esmtp->{'BINARYMIME'}) + { + $opts .= " BODY=7BIT"; } else { - carp 'Net::SMTP::mail: 8BITMIME option not supported by host'; + carp 'Net::SMTP::mail: 8BITMIME and BINARYMIME options not supported by host'; } } @@ -369,10 +392,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; + + $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'; + } +} - $ok && @_ ? $me->dataend - : $ok; +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 { @@ -431,6 +495,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 } @@ -590,7 +655,7 @@ in hash like fashion, using key and value pairs. Possible options are: Size => <bytes> Return => "FULL" | "HDRS" - Bits => "7" | "8" + Bits => "7" | "8" | "binary" Transaction => <ADDRESS> Envelope => <ENVID> @@ -696,6 +761,6 @@ it under the same terms as Perl itself. =for html <hr> -I<$Id: //depot/libnet/Net/SMTP.pm#28 $> +I<$Id: //depot/libnet/Net/SMTP.pm#29 $> =cut |