Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

182 lines (154 sloc) 4.233 kB
# Copyright 2002-2005 Interchange Development Group (http://www.icdevgroup.org/)
# Licensed under the GNU GPL v2. See file LICENSE for details.
# $Id: email.tag,v 1.12 2005-11-08 18:14:42 jon Exp $
UserTag email Order to subject reply from extra
UserTag email hasEndTag
UserTag email addAttr
UserTag email Interpolate
UserTag email Routine <<EOR
my $Have_mime_lite;
BEGIN {
eval {
require MIME::Lite;
$Have_mime_lite = 1;
};
}
sub {
my ($to, $subject, $reply, $from, $extra, $opt, $body) = @_;
my $ok = 0;
my @extra;
use vars qw/ $Tag /;
$subject = '<no subject>' unless defined $subject && $subject;
if (! $from) {
$from = $Vend::Cfg->{MailOrderTo};
$from =~ s/,.*//;
}
# Prevent header injections from spammers' hostile content
for ($to, $subject, $reply, $from) {
# unfold valid RFC 2822 "2.2.3. Long Header Fields"
s/\r?\n([ \t]+)/$1/g;
# now remove any invalid extra lines left over
s/[\r\n](.*)//s
and ::logError("Header injection attempted in email tag: %s", $1);
}
$reply = '' unless defined $reply;
$reply = "Reply-to: $reply\n" if $reply;
for (grep /\S/, split /[\r\n]+/, $extra) {
# require header conformance with RFC 2822 section 2.2
push (@extra, $_), next if /^[\x21-\x39\x3b-\x7e]+:[\x00-\x09\x0b\x0c\x0e-\x7f]+$/;
::logError("Invalid header given to email tag: %s", $_);
}
unshift @extra, "From: $from" if $from;
ATTACH: {
#::logDebug("Checking for attachment");
last ATTACH unless $opt->{attach} || $opt->{html};
unless ($Have_mime_lite) {
::logError("email tag: attachment without MIME::Lite installed.");
last ATTACH;
}
my $att1_format;
if($opt->{html}) {
$opt->{mimetype} ||= 'multipart/alternative';
$att1_format = 'flowed';
}
else {
$opt->{mimetype} ||= 'multipart/mixed';
}
my $att = $opt->{attach};
my @attach;
my @extra_headers;
for(@extra) {
m{(.*?):\s+(.*)};
my $name = $1 or next;
next if lc($name) eq 'from';
my $content = $2 or next;
$name =~ s/[-_]+/-/g;
$name =~ s/\b(\w)/\U$1/g;
push @extra_headers, "$name:", $content;
}
my $msg = new MIME::Lite
To => $to,
From => $from,
Subject => $subject,
Type => $opt->{mimetype},
Cc => $opt->{cc},
@extra_headers,
;
$opt->{body_mime} ||= 'text/plain';
$opt->{body_encoding} ||= '8bit';
$msg->attach(
Type => $opt->{body_mime},
Encoding => $opt->{body_encoding},
Data => $body,
Disposition => $opt->{body_disposition} || 'inline',
Format => $opt->{body_format} || $att1_format,
);
if(! ref($att) ) {
my $fn = $att;
$att = [ { path => $fn } ];
}
elsif(ref($att) eq 'HASH') {
$att = [ $att ];
}
$att ||= [];
if($opt->{html}) {
unshift @$att, {
type => 'text/html',
data => $opt->{html},
disposition => 'inline',
};
}
my %encoding_types = (
'text/plain' => '8bit',
'text/html' => 'quoted-printable',
);
for my $ref (@$att) {
next unless $ref;
next unless $ref->{path} || $ref->{data};
unless ($ref->{filename}) {
my $fn = $ref->{path};
$fn =~ s:.*[\\/]::;
$ref->{filename} = $fn;
}
$ref->{type} ||= 'AUTO';
$ref->{disposition} ||= 'attachment';
if(! $ref->{encoding}) {
$ref->{encoding} = $encoding_types{$ref->{type}};
}
eval {
$msg->attach(
Type => $ref->{type},
Path => $ref->{path},
Data => $ref->{data},
Filename => $ref->{filename},
Encoding => $ref->{encoding},
Disposition => $ref->{disposition},
);
};
if($@) {
::logError("email tag: failed to attach %s: %s", $ref->{path}, $@);
next;
}
}
my $body = $msg->as_string;
#::logDebug("Mail body: \n$body");
if($opt->{test}) {
return $body;
}
else {
return $Tag->email_raw({}, $body);
}
}
$ok = send_mail($to, $subject, $body, $reply, 0, @extra);
if (!$ok) {
logError("Unable to send mail using $Vend::Cfg->{SendMailProgram}\n" .
"To '$to'\n" .
"From '$from'\n" .
"With extra headers '$extra'\n" .
"With reply-to '$reply'\n" .
"With subject '$subject'\n" .
"And body:\n$body");
}
return $opt->{hide} ? '' : $ok;
}
EOR
Jump to Line
Something went wrong with that request. Please try again.