[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