# Copyright 2002-2007 Interchange Development Group and others

#

# This program is free software; you can redistribute it and/or modify

# it under the terms of the GNU General Public License as published by

# the Free Software Foundation; either version 2 of the License, or

# (at your option) any later version. See the LICENSE file for details.

#

# $Id: email.tag,v 1.14 2007-03-30 23:40:56 pajamian 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;

my $sent_with_attach = 0;

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 {

$body =~ s/^(.+?)(?:\r?\n){2}//s;

my $headers = $1;

last SEND unless $headers;

my @head = split(/\r?\n/,$headers);

$ok = send_mail(\@head,$body);

$sent_with_attach = 1;

}

}

$ok = send_mail($to, $subject, $body, $reply, 0, @extra)

unless $sent_with_attach;

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