UserDB: log timestamps to second granularity
[interchange.git] / code / UserTag / email_raw.tag
1 # Copyright 2002-2007 Interchange Development Group and others
2
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 2 of the License, or
6 # (at your option) any later version.  See the LICENSE file for details.
7
8 # $Id: email_raw.tag,v 1.8 2007-03-30 23:40:56 pajamian Exp $
9
10 UserTag email-raw hasEndTag
11 UserTag email-raw addAttr
12 UserTag email-raw Interpolate
13 UserTag email-raw Version     $Revision: 1.8 $
14 UserTag email-raw Routine     <<EOR
15 sub {
16     my($opt, $body) = @_;
17     my($ok);
18     $body =~ s/^\s+//;
19
20         # If configured, intercept all outgoing email and re-route
21         if (
22                 my $intercept = $::Variable->{MV_EMAIL_INTERCEPT}
23                                 || $Global::Variable->{MV_EMAIL_INTERCEPT}
24         ) {
25                 $body =~ s/\A(.*?)\r?\n\r?\n//s;
26                 my $header_block = $1;
27                 # unfold valid RFC 2822 "2.2.3. Long Header Fields"
28                 $header_block =~ s/\r?\n([ \t]+)/$1/g;
29                 my @headers;
30                 for (split /\r?\n/, $header_block) {
31                         if (my ($header, $value) = /^(To|Cc|Bcc):\s*(.+)/si) {
32                                 logError(
33                                         "Intercepting outgoing email (%s: %s) and instead sending to '%s'",
34                                         $header, $value, $intercept
35                                 );
36                                 $_ = "$header: $intercept";
37                                 push @headers, "X-Intercepted-$header: $value";
38                         }
39                         push @headers, $_;
40                 }
41                 $body = join("\n", @headers) . "\n\n" . $body;
42         }
43
44     SEND: {
45         my $using = $Vend::Cfg->{SendMailProgram};
46
47         if (lc $using eq 'none') {
48                 $ok = 1;
49                 last SEND;
50         } elsif (lc $using eq 'net::smtp') {
51                 $body =~ s/^(.+?)(?:\r?\n){2}//s;
52                 my $headers = $1;
53                 last SEND unless $headers;
54                 my @head = split(/\r?\n/,$headers);
55                 $ok = send_mail(\@head,$body);
56         } else {
57                 open(Vend::MAIL,"|$using -t") or last SEND;
58                 print Vend::MAIL $body
59                         or last SEND;
60                 close Vend::MAIL
61                         or last SEND;
62                 $ok = ($? == 0);
63         }
64     }
65
66     if (!$ok) {
67         ::logError("Unable to send mail using $Vend::Cfg->{SendMailProgram}\n" .
68             "Message follows:\n\n$body");
69     }
70
71     return $opt->{hide} ? '' : $ok;
72 }
73 EOR