1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
package Bio::Graphics::Browser2::SendMail;
# $Id: UserDB.pm 23607 2010-07-30 17:34:25Z cnvandev $
use strict;
use Bio::Graphics::Browser2;
use CGI qw(:standard);
use DBI;
use Digest::SHA qw(sha1_hex sha1);
use JSON;
use Text::ParseWords 'quotewords';
use Digest::MD5 qw(md5_hex);
use Carp qw(confess cluck croak);
# Do Sendmail - Handles outgoing email using either Net::SMTP or Net::SMTP::SSL as required.
# The format of the smtp argument is:
#
# smtp.server.com:port:encryption:username:password
#
# This has up to five fields. Only the first field is required.
# The port is assumed to be 25 unless ssl encryption is specified, in which case it defaults to 465.
# The protocol is either "plain" or "ssl", "plain" assumed.
# The username and password may be required by the SMTP server to send outgoing mail.
sub do_sendmail {
my $self = shift;
my $args = shift;
my $globals = shift;
eval {
$globals->smtp or die "No SMTP server found in globals";
my ($server, $port, $protocol, $username, $password) = split ':', $globals->smtp;
$protocol ||= 'plain';
$port ||= $protocol eq 'plain' ? 25 : 465;
$protocol =~ /plain|ssl/ or die 'encryption must be either "plain" or "ssl"';
# At least some SMTP servers will refuse to accept mail
# unless From matches the authentication username.
my $smtp_from = $username ? $username : $args->{from};
my $smtp_sender;
if ($protocol eq 'plain') {
eval "require Net::SMTP" unless Net::SMTP->can('new');
$smtp_sender = 'Net::SMTP';
} else {
eval "require Net::SMTP::SSL" unless Net::SMTP::SSL->can('new');
$smtp_sender = 'Net::SMTP::SSL';
}
my $smtp_obj = $smtp_sender->new(
$server,
Port => $port,
Debug => 0,
)
or die "Could not connect to outgoing mail server $server";
if ($username) {
$smtp_obj->auth($username, $password)
or die "Could not authenticate with outgoing mail server $server: ",$smtp_obj->message
}
$smtp_obj->mail("$smtp_from\n") or die $smtp_obj->message;
$smtp_obj->to("$args->{to}\n") or die $smtp_obj->message;
$smtp_obj->data() or die $smtp_obj->message;
$smtp_obj->datasend("From: \"$args->{from_title}\" <$args->{from}>\n")
or die $smtp_obj->message;
$smtp_obj->datasend("To: $args->{to}\n") or die $smtp_obj->message;
$smtp_obj->datasend("Reply-to: $args->{from}\n") or die $smtp_obj->message;
$smtp_obj->datasend("Subject: $args->{subject}\n") or die $smtp_obj->message;
$smtp_obj->datasend("Content-type: text/html; charset=ISO-8859-1\n")
or die $smtp_obj->message
if $args->{HTML};
$smtp_obj->datasend("\n") or die $smtp_obj->message;
$smtp_obj->datasend($args->{msg}) or die $smtp_obj->message;
$smtp_obj->datasend("\n") or die $smtp_obj->message;
$smtp_obj->dataend() or die $smtp_obj->message;
$smtp_obj->quit();
};
warn $@ if $@;
return (0, $@) if $@;
return (1,'');
}
1;
__END__
|
