Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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.