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