[interchange-cvs] interchange - jon modified 2 files
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Thu Nov 3 00:16:55 EST 2005
User: jon
Date: 2005-11-03 05:16:55 GMT
Modified: lib/Vend Util.pm
Modified: code/UserTag email_raw.tag
Log:
Add new email interception feature. This allows a developer to set a
global or catalog variable MV_EMAIL_INTERCEPT, which causes all outgoing
email to be rerouted to that email address. This makes it much easier to
do development with functions that involve email because real end-user
email addresses can be used but the developer will receive the mail.
Headers in the form X-Intercepted-To: etc. are added to show what the
original destination of the mail was, and the interception is also noted
in the catalog error log.
Revision Changes Path
2.86 +23 -4 interchange/lib/Vend/Util.pm
rev 2.86, prev_rev 2.85
Index: Util.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Util.pm,v
retrieving revision 2.85
retrieving revision 2.86
diff -u -u -r2.85 -r2.86
--- Util.pm 22 May 2005 12:53:36 -0000 2.85
+++ Util.pm 3 Nov 2005 05:16:55 -0000 2.86
@@ -1,6 +1,6 @@
# Vend::Util - Interchange utility functions
#
-# $Id: Util.pm,v 2.85 2005/05/22 12:53:36 mheins Exp $
+# $Id: Util.pm,v 2.86 2005/11/03 05:16:55 jon Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -88,7 +88,7 @@
use Vend::File;
use subs qw(logError logGlobal);
use vars qw($VERSION @EXPORT @EXPORT_OK);
-$VERSION = substr(q$Revision: 2.85 $, 10);
+$VERSION = substr(q$Revision: 2.86 $, 10);
my $Eval_routine;
my $Eval_routine_file;
@@ -1808,7 +1808,6 @@
sub send_mail {
my($to, $subject, $body, $reply, $use_mime, @extra_headers) = @_;
- my @headers;
if(ref $to) {
my $head = $to;
@@ -1823,7 +1822,7 @@
undef $subject;
for(@$head) {
s/\s+$//;
- if( /^To:\s*(.+)/s ) {
+ if (/^To:\s*(.+)/si) {
$to = $1;
}
elsif (/^Reply-to:\s*(.+)/si) {
@@ -1836,6 +1835,26 @@
push @extra_headers, $_;
}
}
+ }
+
+ # If configured, intercept all outgoing email and re-route
+ if (
+ my $intercept = $::Variable->{MV_EMAIL_INTERCEPT}
+ || $Global::Variable->{MV_EMAIL_INTERCEPT}
+ ) {
+ my @info_headers;
+ $to = "To: $to";
+ for ($to, @extra_headers) {
+ next unless my ($header, $value) = /^(To|Cc|Bcc):\s*(.+)/si;
+ logError(
+ "Intercepting outgoing email (%s: %s) and instead sending to '%s'",
+ $header, $value, $intercept
+ );
+ $_ = "$header: $intercept";
+ push @info_headers, "X-Intercepted-$header: $value";
+ }
+ $to =~ s/^To: //;
+ push @extra_headers, @info_headers;
}
my($ok);
1.6 +27 -3 interchange/code/UserTag/email_raw.tag
rev 1.6, prev_rev 1.5
Index: email_raw.tag
===================================================================
RCS file: /var/cvs/interchange/code/UserTag/email_raw.tag,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -u -r1.5 -r1.6
--- email_raw.tag 10 Feb 2005 14:38:39 -0000 1.5
+++ email_raw.tag 3 Nov 2005 05:16:55 -0000 1.6
@@ -1,16 +1,40 @@
-# Copyright 2002 Interchange Development Group (http://www.icdevgroup.org/)
+# Copyright 2002-2005 Interchange Development Group (http://www.icdevgroup.org/)
# Licensed under the GNU GPL v2. See file LICENSE for details.
-# $Id: email_raw.tag,v 1.5 2005/02/10 14:38:39 docelic Exp $
+# $Id: email_raw.tag,v 1.6 2005/11/03 05:16:55 jon Exp $
UserTag email-raw hasEndTag
UserTag email-raw addAttr
UserTag email-raw Interpolate
-UserTag email-raw Version $Revision: 1.5 $
+UserTag email-raw Version $Revision: 1.6 $
UserTag email-raw Routine <<EOR
sub {
my($opt, $body) = @_;
my($ok);
$body =~ s/^\s+//;
+
+ # If configured, intercept all outgoing email and re-route
+ if (
+ my $intercept = $::Variable->{MV_EMAIL_INTERCEPT}
+ || $Global::Variable->{MV_EMAIL_INTERCEPT}
+ ) {
+ $body =~ s/\A(.*?)\r?\n\r?\n//s;
+ my $header_block = $1;
+ # unfold valid RFC 2822 "2.2.3. Long Header Fields"
+ $header_block =~ s/\r?\n([ \t]+)/$1/g;
+ my @headers;
+ for (split /\r?\n/, $header_block) {
+ if (my ($header, $value) = /^(To|Cc|Bcc):\s*(.+)/si) {
+ logError(
+ "Intercepting outgoing email (%s: %s) and instead sending to '%s'",
+ $header, $value, $intercept
+ );
+ $_ = "$header: $intercept";
+ push @headers, "X-Intercepted-$header: $value";
+ }
+ push @headers, $_;
+ }
+ $body = join("\n", @headers) . "\n\n" . $body;
+ }
SEND: {
open(Vend::MAIL,"|$Vend::Cfg->{SendMailProgram} -t") or last SEND;
More information about the interchange-cvs
mailing list