From 3b1d4f57601233548ea150c74008db47a953462e Mon Sep 17 00:00:00 2001 From: ivan Date: Mon, 15 Feb 2010 02:09:22 +0000 Subject: [PATCH] switch to Email::Sender and add options for every kind of mail encryption & authentication, RT#7285 --- FS/FS/Conf.pm | 28 +++++++++++++- FS/FS/Misc.pm | 115 ++++++++++++--------------------------------------------- debian/control | 2 +- 3 files changed, 51 insertions(+), 94 deletions(-) diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 9d7747980..aaeaa86b6 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1273,6 +1273,32 @@ worry that config_items is freeside-specific and icky. }, { + 'key' => 'smtp-username', + 'section' => '', + 'description' => 'Optional SMTP username for Freeside\'s outgoing mail', + 'type' => 'text', + }, + + { + 'key' => 'smtp-password', + 'section' => '', + 'description' => 'Optional SMTP password for Freeside\'s outgoing mail', + 'type' => 'text', + }, + + { + 'key' => 'smtp-encryption', + 'section' => '', + 'description' => 'Optional SMTP encryption method. The STARTTLS methods require smtp-username and smtp-password to be set.', + 'type' => 'select', + 'select_hash' => [ '25' => 'None (port 25)', + '25-starttls' => 'STARTTLS (port 25)', + '587-starttls' => 'STARTTLS / submission (port 587)', + '465-tls' => 'SMTPS (SSL) (port 465)', + ], + }, + + { 'key' => 'soadefaultttl', 'section' => 'BIND', 'description' => 'SOA default TTL for new domains.', @@ -1942,7 +1968,7 @@ worry that config_items is freeside-specific and icky. { 'key' => 'cust_pkg-change_pkgpart-bill_now', 'section' => '', - 'description' => "When changing packages, bill the new package immediately. Useful for prepaid situations with RADIUS where an Expiration attribute base don the package must be present at all times.", + 'description' => "When changing packages, bill the new package immediately. Useful for prepaid situations with RADIUS where an Expiration attribute based on the package must be present at all times.", 'type' => 'checkbox', }, diff --git a/FS/FS/Misc.pm b/FS/FS/Misc.pm index dca906cde..39be1fb5a 100644 --- a/FS/FS/Misc.pm +++ b/FS/FS/Misc.pm @@ -216,9 +216,10 @@ encoding which, if specified, overrides the default "7bit". use vars qw( $conf ); use Date::Format; -use Mail::Header; -use Mail::Internet 2.00; use MIME::Entity; +use Email::Sender::Simple qw(sendmail); +use Email::Sender::Transport::SMTP; +use Email::Sender::Transport::SMTP::TLS; use FS::UID; FS::UID->install_callback( sub { @@ -234,7 +235,6 @@ sub send_email { # join("\n", map { " $_: ". $options{$_} } keys %options ). "\n" } - $ENV{MAILADDRESS} = $options{'from'}; my $to = ref($options{to}) ? join(', ', @{ $options{to} } ) : $options{to}; my @mimeargs = (); @@ -287,7 +287,7 @@ sub send_email { $domain = $1; } else { warn 'no domain found in invoice from address '. $options{'from'}. - '; constructing Message-ID @example.com'; + '; constructing Message-ID (and saying HELO) @example.com'; $domain = 'example.com'; } my $message_id = join('.', rand()*(2**32), $$, time). "\@$domain"; @@ -333,101 +333,32 @@ sub send_email { } - my $smtpmachine = $conf->config('smtpmachine'); - $!=0; + #send the email - $message->mysmtpsend( 'Host' => $smtpmachine, - 'MailFrom' => $options{'from'}, - ); + my %smtp_opt = ( 'host' => $conf->config('smtpmachine'), + 'helo' => $domain, + ); -} - -#this kludges a "mysmtpsend" method into Mail::Internet for send_email above -#now updated for MailTools v2! -package Mail::Internet; - -use Mail::Address; -use Net::SMTP; -use Net::Domain; - -sub Mail::Internet::mysmtpsend($@) { - my ($self, %opt) = @_; - - my $host = $opt{Host}; - my $envelope = $opt{MailFrom}; # || mailaddress(); - my $quit = 1; - - my ($smtp, @hello); - - push @hello, Hello => $opt{Hello} - if defined $opt{Hello}; - - push @hello, Port => $opt{Port} - if exists $opt{Port}; - - push @hello, Debug => $opt{Debug} - if exists $opt{Debug}; - -# if(!defined $host) -# { local $SIG{__DIE__}; -# my @hosts = qw(mailhost localhost); -# unshift @hosts, split /\:/, $ENV{SMTPHOSTS} -# if defined $ENV{SMTPHOSTS}; -# -# foreach $host (@hosts) -# { $smtp = eval { Net::SMTP->new($host, @hello) }; -# last if defined $smtp; -# } -# } -# elsif(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) - if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) - { $smtp = $host; - $quit = 0; - } - else - { #local $SIG{__DIE__}; - #$smtp = eval { Net::SMTP->new($host, @hello) }; - $smtp = Net::SMTP->new($host, @hello); - } + my($port, $enc) = split('-', ($conf->config('smtp-encryption') || '25') ); + $smtp_opt{'port'} = $port; - unless ( defined($smtp) ) { - my $err = $!; - $err =~ s/Invalid argument/Unknown host/; - return "can't connect to $host: $err" + my $transport; + if ( $enc eq 'starttls' ) { + $smtp_opt{$_} = $conf->config("smtp-$_") for qw(username password); + $transport = Email::Sender::Transport::SMTP::TLS->new( %smtp_opt ); + } else { + if ( $conf->exists('smtp-username') && $conf->exists('smtp-password') ) { + $smtp_opt{"sasl_$_"} = $conf->config("smtp-$_") for qw(username password); } + $smtp_opt{'ssl'} = 1 if $enc eq 'tls'; + $transport = Email::Sender::Transport::SMTP->new( %smtp_opt ); + } - my $head = $self->cleaned_header_dup; - - $head->delete('Bcc'); - - # Who is it to - - my @rcpt = map { ref $_ ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'}; - @rcpt = map { $head->get($_) } qw(To Cc Bcc) - unless @rcpt; - - my @addr = map {$_->address} Mail::Address->parse(@rcpt); - #@addr or return (); - return 'No valid destination addresses found!' - unless(@addr); - - # Send it - - my $ok = $smtp->mail($envelope) - && $smtp->to(@addr) - && $smtp->data(join("", @{$head->header}, "\n", @{$self->body})); + eval { sendmail($message, { transport => $transport }); }; + ref($@) ? ( $@->code ? $@->code.' ' : '' ). $@->message + : $@; - #$quit && $smtp->quit; - #$ok ? @addr : (); - if ( $ok ) { - $quit && $smtp->quit; - return ''; - } else { - return $smtp->code. ' '. $smtp->message; - } } -package FS::Misc; -#eokludge =item send_fax OPTION => VALUE ... diff --git a/debian/control b/debian/control index 75869a07e..4ea4815d2 100644 --- a/debian/control +++ b/debian/control @@ -22,7 +22,7 @@ Description: Billing and trouble ticketing for service providers Package: freeside-lib Architecture: all -Depends: ghostscript | gs-gpl, gsfonts, tetex-base, tetex-bin, libauthen-passphrase-perl, libbusiness-creditcard-perl, libcache-cache-perl, libcache-simple-timedexpiry-perl, libclass-returnvalue-perl, libcrypt-passwdmd5-perl, libdate-manip-perl, libdbd-pg-perl | libdbd-mysql-perl, libdbi-perl, libdbix-dbschema-perl (>= 0.35), libdbix-searchbuilder-perl, libdigest-sha1-perl, libfile-counterfile-perl, libfile-rsync-perl, libfrontier-rpc-perl, libhtml-format-perl, libhtml-tree-perl, libipc-run3-perl, libipc-sharelite-perl, liblingua-en-nameparse-perl, liblocale-maketext-fuzzy-perl, liblocale-maketext-lexicon-perl, liblocale-subcountry-perl, liblog-dispatch-perl, libmailtools-perl (>= 2), libmime-perl (>= 5.424) | libmime-perl (< 5.421), libnet-domain-tld-perl, libnet-scp-perl, libnet-ssh-perl, libnet-whois-raw-perl, libnetaddr-ip-perl, libnumber-format-perl, libregexp-common-perl, libstring-approx-perl, libstring-shellquote-perl, libterm-readkey-perl, libtest-inline-perl, libtext-autoformat-perl, libtext-csv-perl, libtext-template-perl, libtext-wrapper-perl, libtie-ixhash-perl, libtime-duration-perl, libtime-modules-perl, libtimedate-perl, libuniversal-require-perl, liburi-perl, libwant-perl, libwww-perl +Depends: ghostscript | gs-gpl, gsfonts, tetex-base, tetex-bin, libauthen-passphrase-perl, libbusiness-creditcard-perl, libcache-cache-perl, libcache-simple-timedexpiry-perl, libclass-returnvalue-perl, libcrypt-passwdmd5-perl, libdate-manip-perl, libdbd-pg-perl | libdbd-mysql-perl, libdbi-perl, libdbix-dbschema-perl (>= 0.35), libdbix-searchbuilder-perl, libdigest-sha1-perl, libfile-counterfile-perl, libfile-rsync-perl, libfrontier-rpc-perl, libhtml-format-perl, libhtml-tree-perl, libipc-run3-perl, libipc-sharelite-perl, liblingua-en-nameparse-perl, liblocale-maketext-fuzzy-perl, liblocale-maketext-lexicon-perl, liblocale-subcountry-perl, liblog-dispatch-perl, libmailtools-perl (>= 2), libmime-perl (>= 5.424) | libmime-perl (< 5.421), libnet-domain-tld-perl, libnet-scp-perl, libnet-ssh-perl, libnet-whois-raw-perl, libnetaddr-ip-perl, libnumber-format-perl, libregexp-common-perl, libstring-approx-perl, libstring-shellquote-perl, libterm-readkey-perl, libtest-inline-perl, libtext-autoformat-perl, libtext-csv-perl, libtext-template-perl, libtext-wrapper-perl, libtie-ixhash-perl, libtime-duration-perl, libtime-modules-perl, libtimedate-perl, libuniversal-require-perl, liburi-perl, libwant-perl, libwww-perl, libemail-sender-perl, libemail-sender-transport-smtp-tls-perl Recommends: libdbd-pg-perl, libdbd-mysql-perl, rsync Suggests: libbusiness-onlinepayment-perl Description: Libraries for Freeside billing and trouble ticketing -- 2.11.0