Mail-SendEasy-1.2/ 40777 0 0 0 10035453471 12123 5ustar usergroupMail-SendEasy-1.2/Changes100666 0 0 1023 10035452310 13476 0ustar usergroupRevision history for Perl extension Mail::SendEasy. 1.2 2004-04-09 - Fixed bug for spaces between ":" and "<" on command MAIL. Thanks to Dave Rogers that sent that: | According to RFC821 there cannot be a space between | the ':' and the '<' in the "MAIL FROM:" or | the "MAIL TO:" exchange. 1.1 2004-02-05 - Fixed recursivety/loop use of the object. - Fixed auth() call for SMTP servers that doesn't have AUTH. 1.0 2004-01-23 18:20:59 - original version; Mail-SendEasy-1.2/lib/ 40777 0 0 0 10035453471 12671 5ustar usergroupMail-SendEasy-1.2/lib/Mail/ 40777 0 0 0 10035453471 13553 5ustar usergroupMail-SendEasy-1.2/lib/Mail/SendEasy/ 40777 0 0 0 10035453471 15266 5ustar usergroupMail-SendEasy-1.2/lib/Mail/SendEasy/AUTH.pm100666 0 0 11256 10035452611 16502 0ustar usergroup############################################################################# ## This file was generated automatically by Class::HPLOO/0.12 ## ## Original file: ./lib/Mail/SendEasy/AUTH.hploo ## Generation date: 2004-04-09 04:49:29 ## ## ** Do not change this file, use the original HPLOO source! ** ############################################################################# ############################################################################# ## Name: AUTH.pm ## Purpose: Mail::SendEasy::AUTH ## Author: Graciliano M. P. ## Modified by: ## Created: 2004-01-23 ## RCS-ID: ## Copyright: (c) 2004 Graciliano M. P. ## Licence: This program is free software; you can redistribute it and/or ## modify it under the same terms as Perl itself ############################################################################# { package Mail::SendEasy::AUTH ; use strict qw(vars) ; no warnings ; my (%CLASS_HPLOO) ; sub new { my $class = shift ; my $this = bless({} , $class) ; no warnings ; my $undef = \'' ; sub UNDEF {$undef} ; if ( $CLASS_HPLOO{ATTR} ) { foreach my $Key ( keys %{$CLASS_HPLOO{ATTR}} ) { tie( $this->{$Key} => 'Class::HPLOO::TIESCALAR' , $CLASS_HPLOO{ATTR}{$Key}{tp} , $CLASS_HPLOO{ATTR}{$Key}{pr} , \$this->{CLASS_HPLOO_ATTR}{$Key} ) if !exists $this->{$Key} ; } } my $ret_this = defined &AUTH ? $this->AUTH(@_) : undef ; if ( ref($ret_this) && UNIVERSAL::isa($ret_this,$class) ) { $this = $ret_this ; if ( $CLASS_HPLOO{ATTR} && UNIVERSAL::isa($this,'HASH') ) { foreach my $Key ( keys %{$CLASS_HPLOO{ATTR}} ) { tie( $this->{$Key} => 'Class::HPLOO::TIESCALAR' , $CLASS_HPLOO{ATTR}{$Key}{tp} , $CLASS_HPLOO{ATTR}{$Key}{pr} , \$this->{CLASS_HPLOO_ATTR}{$Key} ) if !exists $this->{$Key} ; } } } elsif ( $ret_this == $undef ) { $this = undef ; } return $this ; } use vars qw($VERSION) ; $VERSION = '0.01' ; my %AUTH_TYPES = ( PLAIN => 1 , LOGIN => 1 , CRAM_MD5 => 0 , ) ; { eval(q`use Digest::HMAC_MD5 qw(hmac_md5_hex)`) ; $AUTH_TYPES{CRAM_MD5} = 1 if defined &hmac_md5_hex ; } sub AUTH { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my $user = shift(@_) ; my $pass = shift(@_) ; my @authtypes = @_ ; @_ = () ; my $auth_sub ; foreach my $auth ( @authtypes ) { my $name = uc($auth) ; if ( $AUTH_TYPES{$name} ) { $auth_sub = $name ; last ;} } $auth_sub = 'PLAIN' if !@authtypes && !$auth_sub ; return UNDEF if !$auth_sub || $user eq '' || $pass eq '' ; $this->{USER} = $user ; $this->{PASS} = $pass ; $this->{AUTHSUB} = $auth_sub ; } sub type { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; $this->{AUTHSUB} } sub start { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my $start = $this->{AUTHSUB} . "_start" ; return &$start($this , @_) if defined &$start ; return ; } sub step { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my $step = $this->{AUTHSUB} . "_step" ; return &$step($this , @_) if defined &$step ; return ; } ############# sub PLAIN_start { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my @parts = map { defined $this->{$_} ? $this->{$_} : ''} qw(USER USER PASS); return join("\0", @parts) ; } ############# sub LOGIN_step { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my $string = shift(@_) ; $string =~ /password/i ? $this->{PASS} : $string =~ /username/i ? $this->{USER} : '' ; } ############# sub CRAM_MD5_step { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my $string = shift(@_) ; my ($user, $pass) = map { defined $this->{$_} ? $this->{$_} : '' } qw(USER PASS) ; $user . " " . hmac_md5_hex($string,$pass); return $user ; } } 1; __END__ =head1 NAME Mail::SendEasy::AUTH - Handles the authentication response. =head1 DESCRIPTION This module will handles the authentication response to the SMTP server. =head1 SUPPORTED AUTH PLAIN LOGIN CRAM_MD5 =head1 USAGE B See L. =head1 AUTHOR Graciliano M. P. =head1 COPYRIGHT This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Mail-SendEasy-1.2/lib/Mail/SendEasy/Base64.pm100666 0 0 5204 10004330607 16735 0ustar usergroup############################################################################# ## Name: Base64.pm ## Purpose: Mail::SendEasy::Base64 ## Author: Graciliano M. P. ## Modified by: ## Created: 25/5/2003 ## RCS-ID: ## Copyright: (c) 2003 Graciliano M. P. ## Licence: This program is free software; you can redistribute it and/or ## modify it under the same terms as Perl itself ############################################################################# package Mail::SendEasy::Base64 ; use strict qw(vars) ; no warnings ; use vars qw($VERSION @ISA) ; our $VERSION = '1.0' ; require Exporter; @ISA = qw(Exporter); our @EXPORT = qw(encode_base64 decode_base64) ; our @EXPORT_OK = @EXPORT ; my ($BASE64_PM) ; eval("use MIME::Base64 ()") ; if ( defined &MIME::Base64::encode_base64 ) { $BASE64_PM = 1 ;} ################# # ENCODE_BASE64 # ################# sub encode_base64 { if ( $BASE64_PM ) { return &MIME::Base64::encode_base64($_[0]) ;} else { return &_encode_base64_pure_perl($_[0]) ;} } ############################ # _ENCODE_BASE64_PURE_PERL # ############################ sub _encode_base64_pure_perl { my $res = ""; my $eol = $_[1]; $eol = "\n" unless defined $eol; pos($_[0]) = 0; # ensure start at the beginning while ($_[0] =~ /(.{1,45})/gs) { $res .= substr(pack('u', $1), 1); chop($res); } $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs # fix padding at the end my $padding = (3 - length($_[0]) % 3) % 3; $res =~ s/.{$padding}$/'=' x $padding/e if $padding; # break encoded string into lines of no more than 76 characters each if (length $eol) { $res =~ s/(.{1,76})/$1$eol/g; } $res; } ################# # DECODE_BASE64 # ################# sub decode_base64 { if ( $BASE64_PM ) { return &MIME::Base64::decode_base64($_[0]) ;} else { return &_decode_base64_pure_perl($_[0]) ;} } ############################ # _DECODE_BASE64_PURE_PERL # ############################ sub _decode_base64_pure_perl { local($^W) = 0 ; my $str = shift ; my $res = ""; $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars if (length($str) % 4) { #require Carp; #Carp::carp("Length of base64 data not a multiple of 4") } $str =~ s/=+$//; # remove padding $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format while ($str =~ /(.{1,60})/gs) { my $len = chr(32 + length($1)*3/4); # compute length byte $res .= unpack("u", $len . $1 ); # uudecode } $res; } ####### # END # ####### 1; Mail-SendEasy-1.2/lib/Mail/SendEasy/IOScalar.pm100666 0 0 4546 10004345301 17353 0ustar usergroup############################################################################# ## Name: IOScalar.pm ## Purpose: Mail::SendEasy::IOScalar ## Author: Graciliano M. P. ## Modified by: ## Created: 25/5/2003 ## RCS-ID: ## Copyright: (c) 2003 Graciliano M. P. ## Licence: This program is free software; you can redistribute it and/or ## modify it under the same terms as Perl itself ############################################################################# package Mail::SendEasy::IOScalar ; use strict qw(vars) ; use vars qw($VERSION @ISA) ; our $VERSION = '0.01' ; sub new { my $proto = shift; my $class = ref($proto) || $proto ; my $sref = shift ; my $self = bless \do { local *FH }, $class ; tie *$self, $class, $self ; if (!defined $sref) { my $s ; $sref = \$s ;} *$self->{Pos} = 0; *$self->{SR} = $sref; $self; } sub print { my $self = shift; *$self->{Pos} = length(${*$self->{SR}} .= join('', @_)); 1; } sub write { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $data = substr($_[1], $off, $n); $n = length($data); $self->print($data); return $n; } sub eof { my $self = shift; (*$self->{Pos} >= length(${*$self->{SR}})); } sub seek { my ($self, $pos, $whence) = @_; my $eofpos = length(${*$self->{SR}}); if ($whence == 0) { *$self->{Pos} = $pos } ### SEEK_SET elsif ($whence == 1) { *$self->{Pos} += $pos } ### SEEK_CUR elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos} ### SEEK_END if (*$self->{Pos} < 0) { *$self->{Pos} = 0 } if (*$self->{Pos} > $eofpos) { *$self->{Pos} = $eofpos } 1; } sub tell { *{shift()}->{Pos} } sub close { my $self = shift ; %{*$self} = () ; 1 ;} sub syswrite { shift->write(@_) ;} sub sysseek { shift->seek (@_) ;} sub flush {} sub autoflush {} sub binmode {} sub DESTROY { shift->close ;} sub TIEHANDLE { ((defined($_[1]) && UNIVERSAL::isa($_[1],'Mail::SendEasy::IOScalar')) ? $_[1] : shift->new(@_)) ; } sub PRINT { shift->print(@_) } sub PRINTF { shift->print(sprintf(shift, @_)) } sub WRITE { shift->write(@_); } sub CLOSE { shift->close(@_); } sub SEEK { shift->seek(@_); } sub TELL { shift->tell(@_); } sub EOF { shift->eof(@_); } ####### # END # ####### 1; Mail-SendEasy-1.2/lib/Mail/SendEasy/SMTP.pm100666 0 0 25066 10035452611 16530 0ustar usergroup############################################################################# ## This file was generated automatically by Class::HPLOO/0.12 ## ## Original file: ./lib/Mail/SendEasy/SMTP.hploo ## Generation date: 2004-04-09 04:49:29 ## ## ** Do not change this file, use the original HPLOO source! ** ############################################################################# ############################################################################# ## Name: SMTP.pm ## Purpose: Mail::SendEasy::SMTP ## Author: Graciliano M. P. ## Modified by: ## Created: 2004-01-23 ## RCS-ID: ## Copyright: (c) 2004 Graciliano M. P. ## Licence: This program is free software; you can redistribute it and/or ## modify it under the same terms as Perl itself ############################################################################# { package Mail::SendEasy::SMTP ; use strict qw(vars) ; no warnings ; my (%CLASS_HPLOO) ; sub new { my $class = shift ; my $this = bless({} , $class) ; no warnings ; my $undef = \'' ; sub UNDEF {$undef} ; if ( $CLASS_HPLOO{ATTR} ) { foreach my $Key ( keys %{$CLASS_HPLOO{ATTR}} ) { tie( $this->{$Key} => 'Class::HPLOO::TIESCALAR' , $CLASS_HPLOO{ATTR}{$Key}{tp} , $CLASS_HPLOO{ATTR}{$Key}{pr} , \$this->{CLASS_HPLOO_ATTR}{$Key} ) if !exists $this->{$Key} ; } } my $ret_this = defined &SMTP ? $this->SMTP(@_) : undef ; if ( ref($ret_this) && UNIVERSAL::isa($ret_this,$class) ) { $this = $ret_this ; if ( $CLASS_HPLOO{ATTR} && UNIVERSAL::isa($this,'HASH') ) { foreach my $Key ( keys %{$CLASS_HPLOO{ATTR}} ) { tie( $this->{$Key} => 'Class::HPLOO::TIESCALAR' , $CLASS_HPLOO{ATTR}{$Key}{tp} , $CLASS_HPLOO{ATTR}{$Key}{pr} , \$this->{CLASS_HPLOO_ATTR}{$Key} ) if !exists $this->{$Key} ; } } } elsif ( $ret_this == $undef ) { $this = undef ; } return $this ; } use IO::Socket ; use IO::Select ; use Mail::SendEasy::AUTH ; use Mail::SendEasy::Base64 ; no warnings ; use vars qw($VERSION) ; $VERSION = '0.01' ; sub SMTP { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my $host = shift(@_) ; my $port = shift(@_) ; my $timeout = shift(@_) ; my $user = shift(@_) ; my $pass = shift(@_) ; my $from_sendeasy = shift(@_) ; $this->{HOST} = $host ; $this->{PORT} = $port || 25 ; $this->{TIMEOUT} = $timeout || 120 ; $this->{USER} = $user ; $this->{PASS} = $pass ; $this->{SENDEASY} = 1 if $from_sendeasy ; for (1..2) { last if $this->connect($_) ;} return UNDEF if !$this->{SOCKET} ; } sub connect { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my $n = shift(@_) ; my $sock = new IO::Socket::INET( PeerAddr => $this->{HOST} , PeerPort => $this->{PORT} , Proto => 'tcp' , Timeout => $this->{TIMEOUT} , ) ; if (!$sock) { $this->warn("ERROR: Can't connect to $this->{HOST}:$this->{PORT}\n") if (!$n || $n > 1) ; return ; } $sock->autoflush(1) ; $this->{SOCKET} = $sock ; if ( $this->response !~ /^2/ ) { $this->close("ERROR: Connection error on host $this->{HOST}:$this->{PORT}\n") if (!$n || $n > 1) ; return ; } if ( $this->EHLO('main') !~ /^2/ ) { $this->close("ERROR: Error on EHLO") ; return ; } else { my @response = $this->last_response ; foreach my $response_i ( @response ) { next if $$response_i[0] !~ /^2/ ; my ($key , $val) = ( $$response_i[1] =~ /^(\S+)\s*(.*)/s ); $this->{INF}{$key} = $val ; } } return 1 ; } sub is_connected { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; return 1 if $this->{SOCKET} && $this->{SOCKET}->connected ; return undef ; } sub auth_types { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my @types = split(/\s+/s , $this->{INF}{AUTH}) ; return @types ; } sub auth { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my $user = shift(@_) ; my $pass = shift(@_) ; my @types = @_ ; @_ = () ; $user = $this->{USER} if $user eq '' ; $pass = $this->{PASS} if $pass eq '' ; @types = $this->auth_types if !@types ; my $auth = Mail::SendEasy::AUTH->new($user , $pass , @types) ; if ( $auth && $this->AUTH( $auth->type ) =~ /^3/ ) { if ( my $init = $auth->start ) { $this->cmd(encode_base64($init, '')) ; return 1 if $this->response == 235 ; } my @response = $this->last_response ; while ( $response[0][0] == 334 ) { my $message = decode_base64( $response[0][1] ) ; my $return = $auth->step($message) ; $this->cmd(encode_base64($return, '')) ; @response = $this->response ; return 1 if $response[0][0] == 235 ; last if $response[0][0] == 535 ; } } $this->warn("Authentication error!\n") ; return undef ; } sub EHLO { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; $this->cmd("EHLO",@_) ; $this->response ;} sub AUTH { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; $this->cmd("AUTH",@_) ; $this->response ;} sub MAIL { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; $this->cmd("MAIL",@_) ; $this->response ;} sub RCPT { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; $this->cmd("RCPT",@_) ; $this->response ;} sub DATA { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; $this->cmd("DATA") ; $this->response ;} sub DATAEND { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; $this->cmd(".") ; $this->response ;} sub QUIT { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; $this->cmd("QUIT") ; return wantarray ? [200,''] : 200 ;} sub close { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my $error = shift(@_) ; $this->warn($error) if $error ; return if !$this->{SOCKET} ; $this->QUIT ; close( delete $this->{SOCKET} ) ; } sub warn { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my $error = shift(@_) ; return if !$error ; if ( $this->{SENDEASY} ) { Mail::SendEasy::warn($error) ;} else { warn($error) ;} } sub print { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my $data = shift(@_) ; $this->connect if !$this->is_connected ; return if !$this->{SOCKET} ; my $sock = $this->{SOCKET} ; print $sock $data ; } sub cmd { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; my @cmds = @_ ; @_ = () ; $this->connect if !$this->is_connected ; return if !$this->{SOCKET} ; my $sock = $this->{SOCKET} ; my $cmd = join(" ", @cmds) ; $cmd =~ s/[\r\n]+$//s ; $cmd =~ s/(?:\r\n?|\n)/ /gs ; $cmd .= "\015\012" ; print $sock $cmd ; } sub response { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; $this->connect if !$this->is_connected ; return if !$this->{SOCKET} ; local($/) ; $/ = "\n" ; my $sock = $this->{SOCKET} ; my $sel = IO::Select->new($sock) ; my ($line , @lines) ; if ( $sel->can_read( $this->{TIMEOUT} ) ) { while(1) { chomp($line = <$sock>) ; my ($code , $more , $msg) = ( $line =~ /^(\d+)(.?)(.*)/s ) ; $msg =~ s/\s+$//s ; push(@lines , [$code , $msg]) ; last if $more ne '-' ; } } $this->{LAST_RESPONSE} = \@lines ; return( @lines ) if wantarray ; return $lines[0][0] ; return ; } sub last_response { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; return wantarray ? @{$this->{LAST_RESPONSE}} : @{$this->{LAST_RESPONSE}}[0]->[0] } ; sub last_response_msg { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; @{$this->{LAST_RESPONSE}}[0]->[1] } ; sub last_response_line { my $this = ref($_[0]) && UNIVERSAL::isa($_[0],'UNIVERSAL') ? shift : undef ; @{$this->{LAST_RESPONSE}}[0]->[0] . " " . @{$this->{LAST_RESPONSE}}[0]->[1] } ; } 1; __END__ =head1 NAME Mail::SendEasy::SMTP - Handles the communication with the SMTP server without dependencies. =head1 DESCRIPTION This module will handle the communication with the SMTP server. It hasn't dependencies and supports authentication. =head1 USAGE use Mail::SendEasy ; $smtp = Mail::SendEasy::SMTP->new( 'domain.foo' , 25 , 120 ) ; if ( !$smtp->auth ) { warn($smtp->last_response_line) ;} if ( $smtp->MAIL("FROM:<$mail{from}>") !~ /^2/ ) { warn($smtp->last_response_line) ;} if ( $smtp->RCPT("TO:<$to>") !~ /^2/ ) { warn($smtp->last_response_line) ;} if ( $smtp->RCPT("TO:<$to>") !~ /^2/ ) { warn($smtp->last_response_line) ;} if ( $smtp->DATA =~ /^3/ ) { $smtp->print("To: foo@foo") ; $smtp->print("Subject: test") ; $smtp->print("\n") ; $smtp->print("This is a sample MSG!") ; if ( $smtp->DATAEND !~ /^2/ ) { warn($smtp->last_response_line) ;} } $smtp->close ; =head1 METHODS =head2 new ($host , $port , $timeout , $user , $pass) Create the SMTP object and connects to the server. =head2 connect Connect to the server. =head2 auth_types The authentication types supported by the SMTP server. =head2 auth($user , $pass) Does the authentication. =head2 print (data) Send I to the socket connection. =head2 cmd (CMD , @MORE) Send a command to the server. =head2 response Returns the code response. If I returns an ARRAY with the response lines. =head2 last_response Returns an ARRAY with the response lines. =head2 last_response_msg The last response text. =head2 last_response_line The last response line (code and text). =head2 close B and close the connection. =head1 AUTHOR Graciliano M. P. =head1 COPYRIGHT This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Mail-SendEasy-1.2/lib/Mail/SendEasy.pm100666 0 0 44420 10035452536 15746 0ustar usergroup############################################################################# ## Name: SendEasy.pm ## Purpose: Mail::SendEasy ## Author: Graciliano M. P. ## Modified by: ## Created: 2004-01-23 ## RCS-ID: ## Copyright: (c) 2004 Graciliano M. P. ## Licence: This program is free software; you can redistribute it and/or ## modify it under the same terms as Perl itself ############################################################################# package Mail::SendEasy ; use 5.006 ; use strict qw(vars); no warnings ; use vars qw($VERSION @ISA) ; $VERSION = '1.2' ; ########### # REQUIRE # ########### use Time::Local ; use Mail::SendEasy::SMTP ; use Mail::SendEasy::Base64 ; use Mail::SendEasy::IOScalar ; my $ARCHZIP_PM ; eval("use Archive::Zip ()") ; if ( defined &Archive::Zip::new ) { $ARCHZIP_PM = 1 ;} ######## # VARS # ######## my $RN = "\015\012" ; my $ER ; ####### # NEW # ####### sub new { my $this = shift ; return( $this ) if ref($this) ; my $class = $this || __PACKAGE__ ; $this = bless({} , $class) ; my ( %args ) = @_ ; if ( !defined $args{smtp} ) { $args{smtp} = 'localhost' ;} if ( $args{port} !~ /^\d+$/ ) { $args{port} = 25 ;} if ( $args{timeout} !~ /^\d+$/ ) { $args{timeout} = 30 ;} $this->{SMTP} = Mail::SendEasy::SMTP->new( $args{smtp} , $args{port} , $args{timeout} , $args{user} , $args{pass} , 1 ) ; return $this ; } ######## # SEND # ######## sub send { my $this = UNIVERSAL::isa($_[0] , 'Mail::SendEasy') ? shift : undef ; my $SMTP = $this->{SMTP} ; $ER = undef ; my %mail ; while (@_) { my $k = lc(shift @_) ; $k =~ s/_//gs ; $k =~ s/\W//gs ; $k =~ s/s$// if $k !~ /^(?:pass)$/ ; my $v = shift @_ ; if ( !ref($v) && $k !~ /^(?:msg|message|html|msghtml)$/ ) { $v =~ s/^\s+//gs ; $v =~ s/\s+$//gs ; } $mail{$k} = $v ; } if ( !defined $mail{msg} && defined $mail{message} ) { $mail{msg} = delete $mail{message} ;} if ( !defined $mail{html} && defined $mail{msghtml} ) { $mail{html} = delete $mail{msghtml} ;} if ( !defined $mail{anex} && defined $mail{attach} ) { $mail{anex} = delete $mail{attach} ;} if ( !defined $mail{from} ) { $ER = "Blank From adress!" ; return( undef ) ;} if ( !defined $mail{to} ) { $ER = "Blank recipient (to)!" ; return( undef ) ;} if ( !$SMTP ) { if ( !defined $mail{smtp} ) { $mail{smtp} = 'localhost' ;} if ( $mail{port} !~ /^\d+$/ ) { $mail{port} = 25 ;} if ( $mail{timeout} !~ /^\d+$/ ) { $mail{timeout} = 30 ;} $SMTP = Mail::SendEasy::SMTP->new($mail{smtp} , $mail{port} , $mail{timeout} , $mail{user} , $mail{pass} , 1) if !$SMTP ; } if (!$SMTP) { return ;} ## Check mails ################ { my @from = &_check_emails( $mail{from} ) ; return( undef ) if $ER ; if ($#from > 0) { $ER = "More than one From: " . join(" ; ", @from) ; return( undef ) ;} $mail{from} = @from[0] ; my @to = &_check_emails( $mail{to} ) ; return( undef ) if $ER ; $mail{to} = \@to ; if ( defined $mail{cc} ) { my @cc = &_check_emails( $mail{cc} ) ; return( undef ) if $ER ; $mail{cc} = \@cc ; } if ( defined $mail{reply} ) { my @reply = &_check_emails( $mail{reply} ) ; return( undef ) if $ER ; $mail{reply} = @reply[0] ; delete $mail{reply} if $mail{reply} eq '' ; } if ( defined $mail{error} ) { my @error = &_check_emails( $mail{error} ) ; return( undef ) if $ER ; $mail{error} = @error[0] ; delete $mail{error} if $mail{error} eq '' ; } } ## ANEXS ###################### if ( defined $mail{anex} ) { my @anex = $mail{anex} ; @anex = @{$mail{anex}} if ref($mail{anex}) eq 'ARRAY' ; foreach my $anex_i ( @anex ) { &_to_one_line($anex_i) ; if ($anex_i eq '') { next ;} $anex_i =~ s/[\/\\]+/\//gs ; if (!-e $anex_i) { $ER = "Invalid Anex: $anex_i" ; return( undef ) ;} if (-d $anex_i) { $ER = "Anex is a directory: $anex_i" ; return( undef ) ;} $anex_i =~ s/\/$// ; } my @anex_part ; if ( $ARCHZIP_PM && $mail{zipanex} ) { my ($filename , $zip_content) = &_zip_anexs($mail{zipanex},@anex) ; my %part = ( 'Content-Type' => "application/octet-stream; name=\"$filename\"" , 'Content-Transfer-Encoding' => 'base64' , 'Content-Disposition' => "attachment; filename=\"$filename\"" , 'content' => &encode_base64( $zip_content ) , ); push(@anex_part , \%part) ; } else { foreach my $anex_i ( @anex ) { my ($filename) = ( $anex_i =~ /\/*([^\/]+)$/ ); my %part = ( 'Content-Type' => "application/octet-stream; name=\"$filename\"" , 'Content-Transfer-Encoding' => 'base64' , 'Content-Disposition' => "attachment; filename=\"$filename\"" , 'content' => &encode_base64( &cat($anex_i) ) , ); push(@anex_part , \%part) ; } } delete $mail{anex} ; $mail{anex} = \@anex_part if @anex_part ; } ## MIME ####################### delete $mail{MIME} ; $mail{MIME}{Date} = &time_to_date() ; $mail{MIME}{From} = $mail{from} ; if ( $mail{fromtitle} =~ /\S/s ) { my $title = delete $mail{fromtitle} ; $title =~ s/[\r\n]+/ /gs ; $title =~ s/<.*?>//gs ; $title =~ s/^\s+//gs ; $title =~ s/\s+$//gs ; $title =~ s/"/'/gs ; $mail{MIME}{From} = qq`"$title" <$mail{from}>` if $title ne '' ; } $mail{MIME}{To} = join(" , ", @{$mail{to}} ) ; $mail{MIME}{Cc} = join(" , ", @{$mail{cc}} ) if $mail{cc} ; $mail{MIME}{'Reply-To'} = $mail{reply} if $mail{reply} ; $mail{MIME}{'Errors-To'} = $mail{error} if $mail{error} ; $mail{MIME}{'Subject'} = $mail{subject} if $mail{subject} ; $mail{MIME}{'Mime-version'} = '1.0' ; $mail{MIME}{'X-Mailer'} = "Mail::SendEasy/$VERSION Perl/$]-$^O" ; $mail{MIME}{'Msg-ID'} = $mail{msgid} ; if ( defined $mail{msg} ) { $mail{msg} =~ s/\r\n?/\n/gs ; if ( $mail{msg} !~ /\n\n$/s) { $mail{msg} =~ s/\n?$/\n\n/s ;} my %part = ( 'Content-Type' => 'text/plain; charset=ISO-8859-1' , 'Content-Transfer-Encoding' => 'quoted-printable' , 'content' => &_encode_qp( $mail{msg} ) , ); push(@{$mail{MIME}{part}} , \%part ) ; } if ( defined $mail{html} ) { $mail{msg} =~ s/\r\n?/\n/gs ; my %part = ( 'Content-Type' => 'text/html; charset=ISO-8859-1' , 'Content-Transfer-Encoding' => 'quoted-printable' , 'content' => &_encode_qp( $mail{html} ) , ); push(@{$mail{MIME}{part}} , \%part ) ; } ## Content { my $msg_part ; ## Alternative if ( $#{ $mail{MIME}{part} } == 1 ) { my $boudary = &_new_boundary() ; $msg_part .= qq`Content-Type: multipart/alternative; boundary="$boudary"\n\n`; $msg_part .= "This is a multi-part message in MIME format.\n" ; $msg_part .= "This message is in 2 versions: TXT and HTML\n" ; $msg_part .= "You need a reader with MIME to read this message!\n\n" ; $msg_part .= &_new_part($boudary , @{$mail{MIME}{part}}[0]) ; $msg_part .= &_new_part($boudary , @{$mail{MIME}{part}}[1]) ; $msg_part .= qq`--$boudary--\n` ; delete $mail{MIME}{part} ; } else { $msg_part .= &_new_part('' , @{$mail{MIME}{part}}[0]) ;} ## Mixed if ( $mail{anex} ) { my @anex = @{$mail{anex}} ; my $boudary = &_new_boundary() ; $mail{MIME}{content} .= qq`Content-Type: multipart/mixed; boundary="$boudary"\n\n`; $mail{MIME}{content} .= &_new_part($boudary , $msg_part) ; foreach my $anex_i ( @anex ) { $mail{MIME}{content} .= &_new_part($boudary , $anex_i) ; $anex_i = undef ; } $mail{MIME}{content} .= qq`--$boudary--\n` ; delete $mail{anex} ; } else { $mail{MIME}{content} = $msg_part ;} } $mail{MIME}{content} =~ s/\r\n?/\n/gs ; ## SEND ##################### if ( ($SMTP->{USER} ne '' || $SMTP->{PASS} ne '') && $SMTP->auth_types ) { if ( !$SMTP->auth ) { return ;} } if ( $SMTP->MAIL("FROM:<$mail{from}>") !~ /^2/ ) { $ER = "MAIL FROM error (". $SMTP->last_response_line .")!" ; $SMTP->close ; return ;} foreach my $to ( @{$mail{to}} ) { if ( $SMTP->RCPT("TO:<$to>") !~ /^2/ ) { $ER = "RCPT error (". $SMTP->last_response_line .")!" ; $SMTP->close ; return ;} } foreach my $to ( @{$mail{cc}} ) { if ( $SMTP->RCPT("TO:<$to>") !~ /^2/ ) { $ER = "RCPT error (". $SMTP->last_response_line .")!" ; $SMTP->close ; return ;} } if ( $SMTP->DATA =~ /^3/ ) { &_send_MIME($SMTP , %mail) ; if ( $SMTP->DATAEND !~ /^2/ ) { $ER = "Message transmission failed (". $SMTP->last_response_line .")!" ; $SMTP->close ; return ;} } else { $ER = "Can't send data (". $SMTP->last_response_line .")!" ; $SMTP->close ; return ;} $SMTP->close ; return 1 ; } ############## # _SEND_MIME # ############## sub _send_MIME { my ( $SMTP , %mail ) = @_ ; my @order = qw( Date From To Cc Reply-To Errors-To Subject Msg-ID X-Mailer Mime-version ); foreach my $order_i ( @order ) { if ( !defined $mail{MIME}{$order_i} ) { next ;} $SMTP->print("$order_i: " . $mail{MIME}{$order_i} . $RN) ; } $mail{MIME}{content} =~ s/\n/$RN/gs ; $SMTP->print($mail{MIME}{content}) ; } ############# # _NEW_PART # ############# sub _new_part { my ( $boudary , $part ) = @_ ; my $new_part ; if ( !ref($part) ) { $new_part .= "--$boudary\n" if $boudary ; $new_part .= $part ; $new_part .= "\n" if $boudary ; return( $new_part ) ; } my @order = qw( Content-Type Content-Transfer-Encoding Content-Disposition ); $new_part .= "--$boudary\n" if $boudary ; foreach my $order_i ( @order ) { if ( !defined $$part{$order_i} ) { next ;} my $val = $$part{$order_i} ; $new_part .= "$order_i: $val\n" ; } $new_part .= "\n" ; $new_part .= $$part{content} ; $new_part .= "\n" if $boudary ; return( $new_part ) ; } ################# # _NEW_BOUNDARY # ################# sub _new_boundary { push my @lyb1,(qw(0 1 2 3 4 5 6 7 8 9 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z) ) ; push my @lyb2,(qw(0 1 2 3 4 5 6 7 8 9) ) ; my $boudary = "--=_Mail_SendEasy_" ; while( length($boudary) < 25 ) { $boudary .= @lyb1[rand(@lyb1)] ;} $boudary .= '_' ; while( length($boudary) < 31 ) { $boudary .= @lyb2[rand(@lyb2)] ;} $boudary .= '_' ; $boudary .= time() ; return( $boudary ) ; } ############## # _ENCODE_QP # From MIME::QuotedPrint ############## sub _encode_qp { my $res = shift; $res =~ s/^\./\.\./gom ; $res =~ s/\r\n?/\n/gs ; $res =~ s/([^ \t\n!<>~-])/sprintf("=%02X", ord($1))/eg ; $res =~ s/([ \t]+)$/ join('', map { sprintf("=%02X", ord($_)) } split('', $1) )/egm ; my $brokenlines = "" ; $brokenlines .= "$1=\n" while $res =~ s/(.*?^[^\n]{73} (?: [^=\n]{2} (?! [^=\n]{0,1} $) # 75 not followed by .?\n |[^=\n] (?! [^=\n]{0,2} $) # 74 not followed by .?.?\n | (?! [^=\n]{0,3} $) # 73 not followed by .?.?.?\n ))//xsm ; return "$brokenlines$res" ; } ################ # _TO_ONE_LINE # ################ sub _to_one_line { $_[0] =~ s/[\r\n]+/ /gs ; $_[0] =~ s/^\s+//gs ; $_[0] =~ s/\s+$//gs ; } ################# # _CHECK_EMAILS # ################# sub _check_emails { my @mails = split(/\s*(?:[;:,]+|\s+)\s*/s , $_[0]) ; @mails = @{$_[0]} if ref($_[0]) eq 'ARRAY' ; foreach my $mails_i ( @mails ) { &_to_one_line($mails_i) ; if ($mails_i eq '') { next ;} if (! &_format($mails_i) ) { $ER = "Invalid recipient: $mails_i" ; return( undef ) ;} } return( @mails ) ; } ########### # _FORMAT # ########### sub _format { if ( $_[0] eq '' ) { return( undef ) ;} my ( $mail ) = @_ ; my $stat = 1 ; if ($mail !~ /^[\w\.-]+\@localhost$/gsi) { if ($mail !~ /^[\w\.-]+\@(?:[\w-]+\.)*?(?:\w+(?:-\w+)*)(?:\.\w+)+$/ ) { $stat = undef ;} } elsif ($mail !~ /^[\w\.-]+\@[\w-]+$/ ) { $stat = undef ;} return 1 if $stat ; return undef ; } ################ # TIME_TO_DATE # ################ sub time_to_date { # convert a time() value to a date-time string according to RFC 822 my $time = $_[0] || time(); my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my @wdays = qw(Sun Mon Tue Wed Thu Fri Sat); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time) ; my $TZ ; if ( $TZ eq "" ) { # offset in hours my $offset = sprintf "%.1f", (timegm(localtime) - time) / 3600; my $minutes = sprintf "%02d", ( $offset - int($offset) ) * 60; $TZ = sprintf("%+03d", int($offset)) . $minutes; } return join(" ", ($wdays[$wday] . ','), $mday, $months[$mon], $year+1900, sprintf("%02d", $hour) . ":" . sprintf("%02d", $min), $TZ ); } ####### # CAT # ####### sub cat { my ( $file ) = @_ ; if (ref($file) eq 'SCALAR') { $file = ${$file} ;} my $fh = $file ; if (ref($fh) ne 'GLOB') { open($fh,$file) ; binmode($fh) ;} if ( *{$fh}->{DATA} && *{$fh}->{content} ne '' ) { return( *{$fh}->{content} ) ;} my $data ; seek($fh,0,1) if ! *{$fh}->{DATA} ; 1 while( read($fh, $data , 1024*8*2 , length($data) ) ) ; close($fh) ; return( $data ) ; } ######### # ERROR # ######### sub error { return( $ER ) ;} ######## # WARN # ######## sub warn { my $this = UNIVERSAL::isa($_[0] , 'Mail::SendEasy') ? shift : undef ; $ER = $_[0] ; } ############## # _ZIP_ANEXS # ############## sub _zip_anexs { my $zip_name = shift ; my $def_name ; if ($zip_name !~ /\.zip$/i) { $zip_name = 'anex.zip' ; $def_name = 1 ;} my $zip_content ; my $IO = Mail::SendEasy::IOScalar->new(\$zip_content) ; my $zip = Archive::Zip->new() ; my $anex1 ; foreach my $anex_i ( @_ ) { my ($filename) = ( $anex_i =~ /\/*([^\/]+)$/ ) ; $anex1 = $filename ; $zip->addFile($anex_i , $filename) ; } my $status = $zip->writeToFileHandle($IO) ; if ($def_name && $#_ == 0) { $zip_name = $anex1 ;} $zip_name =~ s/\s+/_/gs ; $zip_name =~ s/^\.+// ; $zip_name =~ s/\.\.+/\./ ; $zip_name =~ s/\.[^\.]+$// ; $zip_name .= ".zip" ; return( $zip_name , $zip_content ) ; } ####### # END # ####### 1; __END__ =head1 NAME Mail::SendEasy - Send plain/html e-mails through SMTP servers (platform independent). Supports SMTP authentication and attachments. =head1 DESCRIPTION This modules will send in a easy way e-mails, and doesn't have dependencies. Soo, you don't need to install I. It supports SMTP authentication and attachments. =head1 USAGE =head2 OO use Mail::SendEasy ; my $mail = new Mail::SendEasy( smtp => 'localhost' , user => 'foo' , pass => 123 , ) ; my $status = $mail->send( from => 'sender@foo.com' , from_title => 'Foo Name' , reply => 're@foo.com' , error => 'error@foo.com' , to => 'recp@domain.foo' , cc => 'recpcopy@domain.foo' , subject => "MAIL Test" , msg => "The Plain Msg..." , html => "The HTML Msg..." , msgid => "0101" , ) ; if (!$status) { print $mail->error ;} =head2 STRUCTURED use Mail::SendEasy ; my $status = Mail::SendEasy::send( smtp => 'localhost' , user => 'foo' , pass => 123 , from => 'sender@foo.com' , from_title => 'Foo Name' , reply => 're@foo.com' , error => 'error@foo.com' , to => 'recp@domain.foo' , cc => 'recpcopy@domain.foo' , subject => "MAIL Test" , msg => "The Plain Msg..." , html => "The HTML Msg..." , msgid => "0101" , ) ; if (!$status) { Mail::SendEasy::error ;} =head1 METHODS =head2 new (%OPTIONS) B<%OPTIONS:> =over 4 =item smtp The SMTP server. (Default: I) =item port The SMTP port. (Default: I<25>) =item timeout The time to wait for the connection and data. (Default: I<120>) =item user The username for authentication. =item pass The password for authentication. =back =head2 send (%OPTIONS) B<%OPTIONS:> =over 4 =item from The e-mail adress of the sender. (Only accept one adress). =item from_title The name or title of the sender. =item reply E-mail used to reply to your e-mail. =item error E-mail to send error messages. =item to Recipient e-mail adresses. =item cc Adresses to receive a copy. =item subject The subject of your e-mail. =item msg The plain message. =item html The HTML message. If used with MSG (plain), the format "multipart/alternative" will be used. Readers that can read HTML messages will use the HTML argument, and readers with only plain messages will use MSG. =item msgid An ID to insert in the e-mail Headers. The header will be: Msg-ID: xxxxx =item anex Send file(s) attached. Just put the right path in the machine for the file. For more than one file use ARRAY ref: ['file1','file2'] ** Will load all the files in the memory. =item zipanex Compress with zip the ANEX (attached) file(s). All the files will be inside the same zip file. If the argument has the extension .zip, will be used for the name of the zip file. If not, the file will be "anex.zip", and if exist only one ANEX, the name will be the same of the ANEX, but with the extension .zip. ** Need the module Archive::Zip installed or the argument will be skipped. ** This will generate the zip file in the memory. =back =head1 SEE ALSO L, L, L. B.> =head1 AUTHOR Graciliano M. P. I will appreciate any type of feedback (include your opinions and/or suggestions). ;-P =head1 COPYRIGHT This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Mail-SendEasy-1.2/Makefile.PL100666 0 0 630 10004310073 14133 0ustar usergroup############### # MAKEFILE.PL # ############### use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Mail::SendEasy' , 'VERSION_FROM' => 'lib/Mail/SendEasy.pm' , #'PREREQ_PM' => {'Foo' => 0.01} , ($] >= 5.005 ? ( ABSTRACT_FROM => 'lib/Mail/SendEasy.pm', AUTHOR => 'Graciliano M. P. ' ) : () ), ); 1; Mail-SendEasy-1.2/MANIFEST100666 0 0 271 10004363547 13331 0ustar usergroupChanges MANIFEST Makefile.PL README lib/Mail/SendEasy.pm lib/Mail/SendEasy/AUTH.pm lib/Mail/SendEasy/Base64.pm lib/Mail/SendEasy/IOScalar.pm lib/Mail/SendEasy/SMTP.pm test.pl Mail-SendEasy-1.2/README100666 0 0 1662 10004363671 13103 0ustar usergroup################## # MAIL::SENDEASY # ################## Mail::SendEasy - Send plain/html e-mails through SMTP servers (platform independent). Supports SMTP authentication and attachments. ############### # DESCRIPTION # ############### This modules will send in a easy way e-mails, and doesn't have dependencies. Soo, you don't need to install I. It supports SMTP authentication and attachments. See POD for more... ################ # INSTALLATION # ################ To install this module type the following: perl Makefile.PL make make test make install ########## # AUTHOR # ########## Graciliano M. P. I will appreciate any type of feedback (include your opinions and/or suggestions). ;-P ############# # COPYRIGHT # ############# This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Mail-SendEasy-1.2/test.pl100666 0 0 3656 10004363345 13542 0ustar usergroup######################### ###use Data::Dumper ; print Dumper( ) ; use Test; BEGIN { plan tests => 6 } ; use Mail::SendEasy ; use strict ; use warnings qw'all' ; ok(1); my ( $host , $user , $pass , $from , $to ) ; if ( !$host || !$user || !$pass ) { print "\n----------------\n" ; print "SMTP SERVER for the tests: " ; chomp( $host = ) ; print "USERNAME: " ; chomp( $user = ) ; print "PASSWORD: " ; chomp( $pass = ) ; print "FROM: " ; chomp( $from = ) ; print "TO: " ; chomp( $to = ) ; } $to ||= $from ; print "\n----------------\n" ; print "SETS:\n" ; print " host: $host\n" ; print " user: $user\n" ; print " pass: $pass\n" ; print " from: $from\n" ; print " to: $to\n" ; print "----------------\n" ; ######################### if ($host && $from) { my $mail = new Mail::SendEasy( smtp => $host , user => $user , pass => $pass , ) ; ok($mail) ; my $status = $mail->send( from => $from , from_title => 'Perl Test' , to => $to , subject => "Mail::SendEasy - Perl Test" , msg => "The Plain Msg..." , html => "The HTML Msg..." , ) ; ok($status) ; if (! $status) { print $mail->error ;} } else { print "## Skiped test from 2..3 (need host && from)\n" ;} ######################### if ( $host && $user && $pass ) { print "## AUTH TESTS:\n" ; my $smtp = Mail::SendEasy::SMTP->new($host) ; ok($smtp) ; ok( $smtp->auth_types ) ; if ( $smtp->auth($user , $pass) ) { ok(1) ;} else { my @response = $smtp->last_response ; foreach my $response_i ( @response ) { warn("AUTH: $$response_i[0] $$response_i[1]\n") ; } } } else { print "## Skiped test from 4..6 (need host && user && pass)\n" ;} ######################### print "\nThe End! By!\n" ; 1 ;