[Mailman-Users] PATCH: Prevent 'demime' from swallowing envelope "From_"
Tom Neff
tneff at bigfoot.com
Tue Nov 14 20:29:26 CET 2000
As promised (a day late), here is the patch for demime.
Demime is the most powerful tool I know about for extracting PLAIN TEXT
from mail messages with any of the following problems:
* Binary attachments (winmail.dat, my_dog_skip.jpg, ruinyerpc.exe);
* Multipart "Outlook-Ese" bundles of plain text, HTML, and/or Rich Text
repeating the same message content;
* Text messages sent in ONLY rich text or HTML.
The author is Nick Simicich <njs at scifi.squawk.com> and the latest version
is available at http://scifi.squawk.com/demime.html .
My patch, based on demime 0.97b, addresses one small point: When you feed
demime a full Unix-formatted mail message including the leading "From_" or
"Envelope From" header line, it swallows it, which can complicate subsquent
processing if you use demime as one "stage" of a mail processing pipe.
This patch saves the "envelope from" if it is seen, and re-emits it at the
beginning of the output message.
I freely release it for Nick or other users to do anything they want.
Hopefully nothing is line-wrapped to illegibity below.
*** demime.orig Wed Aug 23 11:38:27 2000
--- demime Tue Nov 14 14:07:49 2000
***************
*** 1,5 ****
--- 1,7 ----
#! /usr/bin/perl -wT
+ # Patched to pass through envelope "From_" - 11/14/2000 tneff
+
# The following changes are likely to make "taint" much happier.
$ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr/sbin';
***************
*** 886,897 ****
}
! sub parsehead (\@\$\$\%\@\%\@) { # Parse header producing keyed list of
headers and other
# indexes to headers. Also folds lines to single line.
# Used on main header and section headers in mime sections.
use strict;
! # die "Wrong number of args to parsehead." if (@_ != 7);
! my ($mail, $endhead, $fromhead, $headtypes, $headarr, $head,
$headkey) = @_;
my $line;
my $l;
my $lag = "";
--- 888,899 ----
}
! sub parsehead (\@\$\$\%\@\%\@\$) { # Parse header producing keyed list of
headers and other ### tneff
# indexes to headers. Also folds lines to single line.
# Used on main header and section headers in mime sections.
use strict;
! # die "Wrong number of args to parsehead." if (@_ != 8); ### tneff
! my ($mail, $endhead, $fromhead, $headtypes, $headarr, $head,
$headkey, $envfrom) = @_; ### tneff
my $line;
my $l;
my $lag = "";
***************
*** 920,925 ****
--- 922,928 ----
$headarr->[$#{$headarr}] = $head->{$lag, $i}; # Replace last array
element with continuation
} elsif ($line=~ /^from\s([^ ]*)/i) {
$$fromhead = $1;
+ $$envfrom = $line;
}
}
while (defined $mail->[$$endhead] and $mail->[$$endhead] =~ /^$/) {
***************
*** 950,962 ****
no strict;
}
! sub headout (\@\%$) { # Headout prints a structured, reformatted header
use strict;
! my ($headkey, $head, $deferred_message) = @_;
my $line;
my $tline;
my @line;
my ($i, $j, $k, $hkl);
for($i = 0; $i < @$headkey; $i += 3) {
# print "$i $headkey->[$i+2]: $headkey->[$i+1]\n";
$j = 0;
--- 953,966 ----
no strict;
}
! sub headout (\@\%$$) { # Headout prints a structured, reformatted header
### tneff
use strict;
! my ($headkey, $head, $deferred_message, $envfrom) = @_; ### tneff
my $line;
my $tline;
my @line;
my ($i, $j, $k, $hkl);
+ mail_print ($envfrom) if $envfrom; ### tneff
for($i = 0; $i < @$headkey; $i += 3) {
# print "$i $headkey->[$i+2]: $headkey->[$i+1]\n";
$j = 0;
***************
*** 1316,1323 ****
my $recurdepth = shift;
my $inhead = shift;
my @routine = ();
! my $endhead; my $fromhead; my %headtypes; my @headarr; my %head; my
@headkey; my @head;
! parsehead(@$inhead, $endhead, $fromhead, %headtypes, @head, %head,
@headkey);
if(defined $head{'content-type', 0} and $head{'content-type',0} =~
/^multipart\/alternative;.*?(boundary)=(?:(")([^"]*?)(")|([^;]+)(?:[;]|$))/
i) { # nothing #
# print "Quote = $2, delimiter = $3, Quote = $4, 5 = $5, 6 = $6, 7 =
$7\n";
--- 1320,1327 ----
my $recurdepth = shift;
my $inhead = shift;
my @routine = ();
! my $endhead; my $fromhead; my %headtypes; my @headarr; my %head; my
@headkey; my @head; my $envfrom; ### tneff
! parsehead(@$inhead, $endhead, $fromhead, %headtypes, @head, %head,
@headkey, $envfrom);
if(defined $head{'content-type', 0} and $head{'content-type',0} =~
/^multipart\/alternative;.*?(boundary)=(?:(")([^"]*?)(")|([^;]+)(?:[;]|$))/
i) { # nothing #
# print "Quote = $2, delimiter = $3, Quote = $4, 5 = $5, 6 = $6, 7 =
$7\n";
***************
*** 1387,1392 ****
--- 1391,1397 ----
my %headtypes = ();
my @headkey = ();
my $fromhead = "";
+ my $envfrom = ""; ### tneff
my $endhead = $[;
***************
*** 1395,1401 ****
# Parse out the mainline mail header.
! parsehead(@$mail, $endhead, $fromhead, %headtypes, @head, %head,
@headkey);
my $content_transfer_encoding = $head{'content-transfer-encoding', 0};
--- 1400,1406 ----
# Parse out the mainline mail header.
! parsehead(@$mail, $endhead, $fromhead, %headtypes, @head, %head,
@headkey, $envfrom); ### tneff
my $content_transfer_encoding = $head{'content-transfer-encoding', 0};
***************
*** 1461,1467 ****
# return &EX_OK;
# }
# end untested code
! headout(@headkey, %head, $deferred_message);
mail_print "\n";
textout([ @{$mail}[$endhead..$#{$mail}] ],
$content_transfer_encoding);
--- 1466,1472 ----
# return &EX_OK;
# }
# end untested code
! headout(@headkey, %head, $deferred_message, $envfrom); ### tneff
mail_print "\n";
textout([ @{$mail}[$endhead..$#{$mail}] ],
$content_transfer_encoding);
***************
*** 1472,1478 ****
my ($saverich) = split(/;/,$head{'content-type',0});
$head{'content-type',0} = "text/plain; charset=\"us-ascii\"";
adj_msgid if $recurdepth == 1;
! headout(@headkey, %head, $deferred_message);
mail_print "X-Converted-To-Plain-Text: from $saverich by
$main::demime_version\n\n";
my @body = @{$mail}[$endhead..$#{$mail}];
richout(\@body, $content_transfer_encoding);
--- 1477,1483 ----
my ($saverich) = split(/;/,$head{'content-type',0});
$head{'content-type',0} = "text/plain; charset=\"us-ascii\"";
adj_msgid if $recurdepth == 1;
! headout(@headkey, %head, $deferred_message, $envfrom); ### tneff
mail_print "X-Converted-To-Plain-Text: from $saverich by
$main::demime_version\n\n";
my @body = @{$mail}[$endhead..$#{$mail}];
richout(\@body, $content_transfer_encoding);
***************
*** 1484,1490 ****
$head{'content-type',0} = "text/plain; charset=\"us-ascii\"";
adj_msgid if $recurdepth == 1;
! headout(@headkey, %head, $deferred_message);
mail_print "X-Converted-To-Plain-Text: from $saverich by
$main::demime_version\n\n";
htmlout([@{$mail}[$endhead..$#{$mail}]],$content_transfer_encoding);
--- 1489,1495 ----
$head{'content-type',0} = "text/plain; charset=\"us-ascii\"";
adj_msgid if $recurdepth == 1;
! headout(@headkey, %head, $deferred_message, $envfrom); ### tneff
mail_print "X-Converted-To-Plain-Text: from $saverich by
$main::demime_version\n\n";
htmlout([@{$mail}[$endhead..$#{$mail}]],$content_transfer_encoding);
***************
*** 1496,1502 ****
$head{'content-type',0} = "text/plain; charset=\"us-ascii\"";
adj_msgid if $recurdepth == 1;
! headout(@headkey, %head, $deferred_message);
mail_print "X-Converted-To-Plain-Text: from $saverich by
$main::demime_version\n\n";
my @body = @{$mail}[$endhead..$#{$mail}];
--- 1501,1507 ----
$head{'content-type',0} = "text/plain; charset=\"us-ascii\"";
adj_msgid if $recurdepth == 1;
! headout(@headkey, %head, $deferred_message, $envfrom); ### tneff
mail_print "X-Converted-To-Plain-Text: from $saverich by
$main::demime_version\n\n";
my @body = @{$mail}[$endhead..$#{$mail}];
***************
*** 1535,1541 ****
my ($saverich) = split(/;/,$head{'content-type',0});
$head{'content-type',0} = "text/plain; charset=\"us-ascii\"";
adj_msgid if $recurdepth == 1;
! headout(@headkey, %head, $deferred_message);
mail_print "X-Converted-To-Plain-Text: from $saverich by
$main::demime_version\n";
mail_print ("X-Converted-To-Plain-Text: Alternative section used was ",
$sections[$winsect]->[2],"\n\n");
--- 1540,1546 ----
my ($saverich) = split(/;/,$head{'content-type',0});
$head{'content-type',0} = "text/plain; charset=\"us-ascii\"";
adj_msgid if $recurdepth == 1;
! headout(@headkey, %head, $deferred_message, $envfrom); ### tneff
mail_print "X-Converted-To-Plain-Text: from $saverich by
$main::demime_version\n";
mail_print ("X-Converted-To-Plain-Text: Alternative section used was ",
$sections[$winsect]->[2],"\n\n");
***************
*** 1546,1553 ****
my @headarr = ();
my %head = ();
my @headkey = ();
parsehead(@{$sections[$winsect]->[4]},
! $endhead, $fromhead, %headtypes, @head, %head, @headkey);
&{$routine[$winval]}($sections[$winsect]->[3],
$head{'content-transfer-encoding',0});
--- 1551,1559 ----
my @headarr = ();
my %head = ();
my @headkey = ();
+ my $envfrom = ""; ### tneff
parsehead(@{$sections[$winsect]->[4]},
! $endhead, $fromhead, %headtypes, @head, %head, @headkey, $envfrom);
### tneff
&{$routine[$winval]}($sections[$winsect]->[3],
$head{'content-transfer-encoding',0});
***************
*** 1601,1607 ****
# print "The winning section has $winval\n";
$head{'content-type',0} = "text/plain; charset=\"us-ascii\"";
adj_msgid if $recurdepth == 1;
! headout(@headkey, %head, $deferred_message);
mail_print "X-Converted-To-Plain-Text: from $saverich by
$main::demime_version\n";
mail_print ("X-Converted-To-Plain-Text: Alternative section used was ",
$sections[$winsect]->[2],"\n\n");
--- 1607,1613 ----
# print "The winning section has $winval\n";
$head{'content-type',0} = "text/plain; charset=\"us-ascii\"";
adj_msgid if $recurdepth == 1;
! headout(@headkey, %head, $deferred_message, $envfrom); ### tneff
mail_print "X-Converted-To-Plain-Text: from $saverich by
$main::demime_version\n";
mail_print ("X-Converted-To-Plain-Text: Alternative section used was ",
$sections[$winsect]->[2],"\n\n");
***************
*** 1615,1622 ****
my @headarr = ();
my %head = ();
my @headkey = ();
parsehead(@{$sections[$i]->[4]},
! $endhead, $fromhead, %headtypes, @head, %head, @headkey);
if(defined $selval{$s}) {
# if(defined $head{"content-transfer-encoding",0}) {
# my $cte = lc $head{'content-transfer-encoding',0};
--- 1621,1629 ----
my @headarr = ();
my %head = ();
my @headkey = ();
+ my $envfrom = ""; ### tneff
parsehead(@{$sections[$i]->[4]},
! $endhead, $fromhead, %headtypes, @head, %head, @headkey,
$envfrom); ### tneff
if(defined $selval{$s}) {
# if(defined $head{"content-transfer-encoding",0}) {
# my $cte = lc $head{'content-transfer-encoding',0};
More information about the Mailman-Users
mailing list