- my $lines = shift;
-
- my ($j, $x, $verb) = (0, 0, 0);
- my (@ads, @hdr, @bo1, @bo2, @ftr, @sig, @vrb, @att) =
- ((), (), (), (), (), (), (), (), ());
-
- # First, remove and store lines we might need later...
- # Remove headers:
- for ($x=0; $x<$#$lines; $x++) { if (@$lines[$x] =~ /^$/) { last; }; }
- @hdr = @$lines[0..$x];
- splice(@$lines, 0, $x+1);
-
- # See if we have a multipart content type. If yes, see if it is already
- # ripped (e.g. by mutt(1)), otherwise only leave the first part if it
- # is plain text (if not, we are done - non-text messages are not our
- # business).
- if (lc($mua) ne 'mutt') {
- for ($x=0; $x<scalar(@hdr); $x++) {
- if ($hdr[$x] =~ /^Content-Type:\s+(.*)$/i) {
- my $foo = $1;
-
- if ($foo =~ /^multipart\//i) {
- undef $foo;
-
- if ($hdr[$x] =~ /\Wboundary="([^"]+)"/i) { $foo = $1; }
- else {
- for (my $z=1; $x+$z<@hdr && $hdr[$x+$z]=~/^\s/; $z++) {
- if ($hdr[$x] =~ /\Wboundary="?([\S]+)"?$/i) {
- $foo = $1;
- last;
- }
- }
- }
-
- if (defined $foo) {
- for (my $x=0; $x<scalar(@$lines); $x++) {
- if (index($$lines[$x], '--'.$foo)!=0) { next; }
-
- my $bar = 'text/plain';
- for ($x++; $x<@$lines && $$lines[$x]!~/^$/; $x++)
- {
- if ($$lines[$x] =~ /^Content-Type:\s+(.*)$/i) {
- $bar = $1;
- }
- }
- if ($x>=scalar(@$lines)) { exit($EX_DATAERR); }
-
- if ($bar =~ /^text\/plain/i) {
- my $z;
- for ($z=1; $x+$z<@$lines; $z++) {
- if (index($$lines[$x+$z], '--'.$foo)==0) {
- last;
- }
- }
- if ($x+$z>=scalar(@$lines)) { exit($EX_DATAERR); }
-
- @bo2 = @$lines[$x+$z..$#$lines];
- splice(@$lines, $x+$z);
- if ($$lines[$#$lines] =~ /^\s*$/) {
- unshift(@bo2, pop @$lines);
- }
- @bo1 = @$lines[0..$x];
- splice(@$lines, 0, $x+1);
- last;
- }
- else {
- write_msg(($mda?"|$sendmail $mda":">$ofile"),
- ($hdrs?undef:\@hdr), $lines);
- exit;
- }
- }
- }
- }
- last;
- }
- }
- }
-
-
- # Protect verbatims:
- $verb = 0;
- for ($x=0; $x<scalar(@$lines); $x++) {
- if ($$lines[$x] =~ /^\s*#v([+-])\s*$/) {
- $verb = $1 eq '+' ? 1 : 0;
- }
- $vrb[$x] = $verb;
- }
-
-
- if (lc($mua) eq 'mutt') {
- # Remove all but the first attachment (if this is text/plain)
- # mutt did introduce (bah!). Remember, all this ugliness could
- # be replaced with a proper and clean edit_filter patch in
- # mutt(1) itself...
- for ($x=0; $x<scalar(@$lines); $x++) {
- if ($vrb[$x]) { next; }
- # The following regexp's are quite ugly because for most users
- # these lines are coloured using termcap... (bah!)
- if (($$lines[$x] =~ /^[^>[]*\[-- Attachment #(\d+)(: .*)? --\]\s*$/ &&
- (($1 ne '1') ||
- ($x<scalar(@$lines) &&
- $$lines[$x+1] !~ /^[^>[]*\[-- Type: text\/plain/))) ||
- ($$lines[$x] =~ /^[^>[]*\[-- End of .* data --\]\s*$/))
- {
- @att = @$lines[$x..$#$lines];
- splice(@$lines, $x);
- if (scalar(@$lines) && $$lines[$#$lines] =~ /^\s*$/) {
- unshift(@att, pop(@$lines));
- }
- last;
- }
- }
-
- # Pipe message/rfc822 parts to another instance of process_msg()
- # for further processing.
- # Please note that we cannot see what a hierarchy the original
- # message had -- if there were message/rfc822 parts within other
- # message/rfc822 parts constellations can occur which we cannot
- # resolve. Therefore we simply do not even try to be smart. This
- # should work for most situations:
- if (scalar(@att)) {
- for ($x=0; $x<$#att; $x++) {
- if ($vrb[scalar(@$lines)+$x]) { next; }
- # The following regexp is quite ugly because for most
- # users the line is coloured using termcap... (bah!)
- if ($att[$x]=~/^[^>[]*\[-- Attachment #\d+(: .*)? --\]\s*$/ &&
- $att[$x+1] =~ /^[^>[]*\[-- Type: message\/rfc822/)
- {
- $x += 2;
- while ($att[$x] !~ /^\s*$/) { $x++; }
- $x++;
-
- my @tmp = @att[$x..$#att];
- process_msg(\@tmp);
- splice(@att, $x, scalar(@att)-$x, @tmp);
- }
- }
- }
- }
-
- # Remove ML footers:
- remove_footers($lines, \@ftr, $footers, undef);
-
- # Remove ad footers:
- remove_footers($lines, \@ads, $ads, undef);
-
- # Remove signature:
- if (scalar(@$lines)) {
- for ($x=0; $x<scalar(@$lines); $x++) {
- if ((!$vrb[$x]) && $$lines[$x] =~ /^-- $/) {
- if ($diff) {
- for (my $i=1; $x+$i+1<scalar(@$lines); $i++) {
- if ($$lines[$x+$i] =~ /^\-{3}\ .+/ &&
- $$lines[$x+$i+1] =~ /^\+{3}\ .+/)
- {
- $sig = 0;
- @sig = @$lines[$x..$#$lines];
- splice(@$lines, $x);
- last;
- }
- }
- if (scalar(@sig)) { last; }
- }
-
- if ($sig || ($lsig && ($#$lines-$x>$lsig))) {
- if ($lsig && !$sig) {
- push(@sig, "[---=| Overlong signature removed by $0: " .
- (scalar(@$lines)-$x) . " lines snipped |=---]\n");
- }
- splice(@$lines, $x);
- }
- elsif ($#$lines-$x<=($lsig?$lsig:$maxsig)) {
- @sig = @$lines[$x..$#$lines];
- splice(@$lines, $x);
- }
- last;
- }
- }
- }
-
- # Now care about TOFU.
- # One common mispractice is M$ style TOFU:
- if ($ms) {
- # bloat this array if you want more internationalization:
- my @tofu = ('Original Message',
- 'Ursprüngliche Nachricht',
- 'Ursprungliche Nachricht',
- 'Mensagem original');
-
- DONE: for ($x=0; $x<scalar(@$lines); $x++) {
- if (!$vrb[$x]) {
- foreach my $tmp (@tofu) {
- if ($$lines[$x] =~ /^-+\s?$tmp\s?-+\s*$/) {
- $x++;
- last DONE;
- }
- }
- }
- }
-
- $j = scalar(@$lines)-$x;
- splice(@$lines, $x);
- }
-
- # Nothing? Then try traditional TOFU:
- if ($trad && (!$j) && !$vrb[$#$lines]) {
- if (scalar(@$lines) && $$lines[$#$lines] =~ /^\s*$/) {
- unshift(@sig, pop(@$lines));
- }
- while (scalar(@$lines) && $$lines[$#$lines] =~ /^\s*$/) {
- pop(@$lines);
- }
- while (scalar(@$lines) && $$lines[$#$lines] =~ /^$indent/) {
- $j++;
- pop(@$lines);
- }
- }
-
- # OK, if we found TOFU, we will leave a message that we were here...
- if ($j) {
- # make sendmail bounce if we shall be picky
- # and indeed found something:
- if ($mda) {
- print STDERR $boun;
-
- if ($sysl) {
- eval { require Sys::Syslog; };
- if ($@) { warn $@; } else {
- Sys::Syslog::setlogsock('unix');
- Sys::Syslog::openlog("$0[$$]", 'pid', 'mail');
- Sys::Syslog::syslog('debug', 'bounced message %s', $hdr[0]);
- Sys::Syslog::closelog();
- }
- }
-
- exit $EX_BOUNCE;
- }
-
- push(@$lines, "[---=| TOFU protection by $0: $j lines snipped |=---]\n");
- }
-
-
- # Care for trailing whitespaces:
- if ($trsp) {
- for ($x=0; $x<scalar(@$lines); $x++) {
- if (!$vrb[$x]) { $$lines[$x] =~ s/[\ \t]+$//; }
- }
- }
-
- # Care for punctuation abuse:
- if ($elli) {
- for ($x=0; $x<scalar(@$lines); $x++) {
- if (!$vrb[$x]) { $$lines[$x] =~ s/([.?!])(\1{2})\1+/$1 . $2/eg; }
- }
- }
-
- # (Nearly) at last care for multiple blank lines. (Do not do this
- # earlier -- the way it is done right now would screw up the verbatim
- # list)
- if ($cr) {
- my $t = 0;
- for ($x=scalar(@$lines)-1; $x>=0; $x--) {
- if ((!$vrb[$x]) && $$lines[$x] =~ /^\s*$/) {
- if ($t<2) { $t++; } else { splice(@$lines, $x, 1); }
- }
- else { $t = 0; }
- }
- }
-
- # Everything changing the body is done now. Time to fix the line count
- # header so naive clients do not get confused. Just to be sure, append
- # the old line count to X-headers.
- my $l = scalar(@bo1) + scalar(@$lines) + scalar(@att) + scalar(@bo2) +
- (!$sig?scalar(@sig):0) + (!$ml?scalar(@ftr):0) +
- (!$ad?scalar(@ads):0);
- for ($x=0; $x<scalar(@hdr); $x++) {
- if ($hdr[$x] =~ s/^(Lines:\s+)(\d+)(\s*)?$/$1 . $l . ($3?$3:'')/e &&
- $2!=$l)
- {
- $hdr[$#hdr] = "X-Old-Lines: $2\n";
- push(@hdr, "\n");
- }
- }
-
- # Finally, before leaving we put everything back in right order.
- unshift(@$lines, (!$hdrs?@hdr:()), @bo1);
- push(@$lines, (!$sig?@sig:()), (!$ad?@ads:()), (!$ml?@ftr:()), @att,
- @bo2);
+ my $lines = shift;
+
+ my ($j, $x, $verb) = (0, 0, 0);
+ my (@ads, @hdr, @bo1, @bo2, @ftr, @sig, @vrb, @att) =
+ ((), (), (), (), (), (), (), (), ());
+
+ # Remove and store lines we might need later...
+ # Remove headers:
+ if (!$nohdr) {
+ for ($x=0; $x<$#$lines; $x++) { if (@$lines[$x] =~ /^$/) { last; }; }
+ @hdr = @$lines[0..$x];
+ splice(@$lines, 0, $x+1);
+ }
+ # remember the original body lines count
+ my $linecount = scalar(@$lines);
+
+ # Sanitize header fields:
+ if ($reply || $sani) { sanitize_hdr(\@hdr); }
+
+ # Remove ML footers:
+ remove_footers($lines, \@ftr, $footers, undef, $ftr_ml);
+
+ # Remove ad footers:
+ remove_footers($lines, \@ads, $ads, undef, $ftr_ad);
+
+ # See if we have a multipart content type. If yes, see if it is already
+ # ripped (e.g. by you MUA, assuming it does not get special treatment with
+ # --mua=foo), otherwise only leave the first part if it is plain text (if
+ # not, we are done - non-text messages are not our business).
+ if ($mua ne 'mutt') {
+ for ($x=0; $x<scalar(@hdr); $x++) {
+ if ($hdr[$x] =~ /^Content-[Tt]ype:\s+(.*)$/) {
+ my $foo = $1;
+
+ if ($foo =~ m!^multipart/!) {
+ undef $foo;
+
+ if ($hdr[$x] =~ /\Wboundary="([^"]+)"/i) { $foo = $1; }
+ else {
+ for (my $z=1; $x+$z<@hdr && $hdr[$x+$z]=~/^\s/; $z++) {
+ if ($hdr[$x] =~ /\Wboundary="?([^"\s]+)"?$/i) {
+ $foo = $1;
+ last;
+ }
+ }
+ }
+
+ if (defined $foo) {
+ for (my $x=0; $x<scalar(@$lines); $x++) {
+ if (index($$lines[$x], '--'.$foo)!=0) { next; }
+
+ my $bar = 'text/plain';
+ for ($x++; $x<@$lines && $$lines[$x]!~/^$/; $x++)
+ {
+ if ($$lines[$x] =~ /^Content-[Tt]ype:\s+(.*)/) {
+ $bar = $1;
+ }
+ }
+ if ($x>=scalar(@$lines)) { exit(EX_DATAERR); }
+
+ if ($bar =~ m!^text/plain!i) {
+ my $z;
+ for ($z=1; $x+$z<@$lines; $z++) {
+ if (index($$lines[$x+$z], '--'.$foo)==0) {
+ last;
+ }
+ }
+ if ($x+$z>=scalar(@$lines)) { exit(EX_DATAERR); }
+
+ @bo2 = @$lines[$x+$z..$#$lines];
+ splice(@$lines, $x+$z);
+ if ($$lines[$#$lines] =~ /^\s*$/) {
+ unshift(@bo2, pop @$lines);
+ }
+ @bo1 = @$lines[0..$x];
+ splice(@$lines, 0, $x+1);
+
+ # remove mailing list and ad footers within this
+ # attachment:
+ remove_footers($lines, \@ftr, $footers, undef, $ftr_ml);
+ remove_footers($lines, \@ads, $ads, undef, $ftr_ad);
+
+ last;
+ }
+ else {
+ write_msg(($mda?'|'.SENDMAIL." $mda":">$ofile"),
+ ($hdrs?undef:\@hdr), $lines);
+ exit;
+ }
+ }
+ }
+ }
+ last;
+ }
+ }
+ }
+
+
+ # Protect verbatims:
+ $verb = 0;
+ for ($x=0; $x<scalar(@$lines); $x++) {
+ if ($$lines[$x] =~ /^\s*#v([+-])$/o) {
+ $verb = $1 eq '+' ? 1 : 0;
+ $vrb[$x] = 1;
+ } elsif ($diff && $$lines[$x] =~ /^[0-9]+a([0-9]+),([0-9]+)$/o) {
+ # Detect and protect standard diffs.
+ # Skip and proceed to next line if premature file end or diff line
+ # numbers implausible (so it might be not a diff at all).
+ if ($1>$2 || $x+$2-$1+1>$#$lines) { next; }
+ $vrb[$x] = 1;
+ for (my $i=0; $i<$2-$1+1; $i++) { $vrb[++$x] = 1; }
+ } elsif ($diff &&
+ $$lines[$x] =~ /^([0-9]+),([0-9]+)c([0-9]+),([0-9]+)$/o) {
+ if ($1!=$3 || $1>$2 || $3>$4 || $x+$2-$1+$4-$3+3>$#$lines) { next; }
+ $vrb[$x] = 1;
+ for (my $i=0; $i<$2-$1+$4-$3+3; $i++) { $vrb[++$x] = 1; }
+ } elsif ($diff &&
+ $$lines[$x] =~ /^--- ./o &&
+ $$lines[$x+1] =~ /^\+\+\+ ./o &&
+ $$lines[$x+2] =~ /^@@ -[0-9]+,([0-9]+) \+[0-9]+,([0-9]+) @@/o
+ ) {
+ # Detect and protect unified diffs.
+ # Proceed only as far as the diff should go.
+ my $minus = $1;
+ my $plus = $2;
+ $vrb[$x++] = 1;
+ $vrb[$x++] = 1;
+ $vrb[$x++] = 1;
+ for (my $cminus = 0, my $cplus = 0;
+ $cminus<=$minus && $cplus<=$plus && $x<$#$lines;
+ $x++) {
+ $vrb[$x] = 1;
+ if ($$lines[$x] !~ /^\+/) { $cminus++; };
+ if ($$lines[$x] !~ /^-/) { $cplus++; };
+ }
+ $x-=1;
+ } else { $vrb[$x] = $verb; }
+ }
+
+ # Calculate quoting ratio (with respect to verbatims):
+ if ($check && scalar(@$lines)) {
+ my ($y, $z) = (0, 0);
+ for ($x=0; $x<scalar(@$lines); $x++) {
+ if (!$vrb[$x]) {
+ $z++;
+ if (index($$lines[$x], $indent)==0) { $y++; }
+ }
+ }
+
+ if ($y/$z>=$check_ratio) {
+ print $msg_ratio;
+ exit EX_UNAVAILABLE;
+ }
+ }
+
+ if ($mua eq 'mutt') {
+ # See if we find pgp output generated by mutt before we scramble
+ # the thing. If yes, see if we can beautify it.
+ if ($pgpshort || $pgpmove || $pgpmovevrf) { pgp($lines, \@vrb, \@hdr); }
+
+ # Remove all but the first attachment (if this is text/plain)
+ # mutt did introduce (bah!). Remember, all this ugliness could
+ # be replaced with a proper and clean edit_filter patch in
+ # mutt(1) itself...
+ for ($x=$#$lines; $x>=0; $x--) {
+ if ($vrb[$x]) { next; }
+ # The following regexp's are quite ugly because for most users
+ # these lines are coloured using termcap... (bah!)
+ if (($$lines[$x] =~
+ /^(?:\e[^\a]+\a)?\Q$mutt_attachment\E(\d+)/o &&
+ (($1 ne '1') ||
+ ($x<$#$lines &&
+ $$lines[$x+1] !~ m!^
+ (?:\e[^\a]+\a)?
+ (?:\Q$mutt_contenttype\E)
+ (?:text/plain|application/pgp)
+ !oxi))) ||
+ ($$lines[$x] =~ /^
+ (?:\e[^\a]+\a)?
+ (?:\Q$mutt_pgpsigned\E |
+ \Q$mutt_pgpclearsigned\E|
+ \Q$mutt_pgpcryptend\E|
+ \Q$mutt_pgpencrypted\E)
+ /ox))
+ {
+ # Strip attachments to prepare further processing
+ unshift(@att, @$lines[$x..$#$lines]);
+ splice(@$lines, $x);
+ # Try to fix trailing empty lines
+ while (scalar(@$lines) && $$lines[$#$lines] =~
+ /^(?:\e[^\a]+\a)?\s*$/) {
+ unshift(@att, pop(@$lines));
+ }
+
+ # Remove ML and ad footers within attachments:
+ my @tmp;
+ if ($ml) { remove_footers($lines, \@tmp, $footers, undef); }
+ if ($ad) { remove_footers($lines, \@tmp, $ads, undef); }
+ $x = scalar(@$lines);
+ }
+ }
+
+ # care about the rest
+ if (scalar(@att)) {
+ for ($x=0; $x<$#att; $x++) {
+ if ($vrb[scalar(@$lines)+$x]) { next; }
+
+ # Pipe message/rfc822 parts to another instance of
+ # process_msg() for further processing.
+ # Please note that we cannot see what a hierarchy the
+ # original message had -- if there were message/rfc822
+ # parts within other message/rfc822 parts constellations
+ # can occur which we cannot resolve. Therefore we simply
+ # do not even try to be smart. This should work for most
+ # situations.
+ # The following regexp is quite ugly because for most
+ # users the line is coloured using termcap... (bah!)
+ if ($att[$x] =~
+ /^(?:\e[^\a]+\a)?\Q$mutt_attachment\E\d+/o &&
+ $att[$x+1] =~ m!^
+ (?:\e[^\a]+\a)?
+ (?:\Q$mutt_contenttype\E) (?:message/rfc822|multipart/alternative)
+ !ox)
+ {
+ $x += 2;
+ while ($att[$x] !~ /^\s*$/) { $x++; }
+ $x++;
+
+ my @tmp = @att[$x..$#att];
+ process_msg(\@tmp);
+ splice(@att, $x, scalar(@att)-$x, @tmp);
+ $x += scalar(@tmp);
+ }
+ }
+ }
+ }
+
+ # Remove signature:
+ if (scalar(@$lines)) {
+ my $sn = 0;
+ my $chk_empty = 1;
+ my $empty = 0;
+
+ for ($x = $#$lines; $x>=0; $x--) {
+ if (!$vrb[$x]) {
+ if ($$lines[$x] =~ /^-- $/) {
+ if ($diff) {
+ for (my $i=1; $x+$i+1<scalar(@$lines); $i++) {
+ if ($$lines[$x+$i] =~ /^-{3}\s+\S/ &&
+ $$lines[$x+$i+1] =~ /^\+{3}\s+\S/)
+ {
+ $sig = 0;
+ unshift(@sig, @$lines[$x..$#$lines]);
+ splice(@$lines, $x);
+ last;
+ }
+ }
+ if (scalar(@sig)) {
+ if (defined($sign) && ++$sn==$sign) { last; } else { next; }
+ }
+ }
+
+ if ($sig || ($lsig && ($#$lines-$x-$empty>$lsig))) {
+ if ($lsig && !$sig) {
+ unshift(@sig, "[---=| Overlong signature removed by $0: " .
+ (scalar(@$lines)-$x) . " lines snipped |=---]\n");
+ }
+ splice(@$lines, $x);
+ }
+ else {
+ unshift(@sig, @$lines[$x..$#$lines]);
+ splice(@$lines, $x);
+ }
+ if (defined($sign) && ++$sn==$sign) { last; } else { next; }
+ }
+ # any trailing newlines?
+ elsif ($chk_empty && $$lines[$x] =~ /^\s*$/) { $empty++; }
+ elsif ($chk_empty) { $chk_empty = 0; }
+ }
+ }
+ }
+
+ # Fix quote markers to adhere to RFC 3676, this changes "> >" to ">> " (if
+ # the default $indent is used). The space after ">" is not mandatory by RFC
+ # but makes the result more readable.
+ if ($fixind) {
+ for ($x=0; $x<scalar(@$lines); $x++) {
+ if (!$vrb[$x] && index($$lines[$x], $indent)==0) {
+ # We match space at the beginning to prevent removal of spaces
+ # directly after the last quote mark.
+ $$lines[$x] =~ /^((\Q$indent\E| )*\Q$indent\E ?)(.*)$/;
+ my $tmp = $1;
+ my $len = length $1;
+ my $rest = $3; # if anything follows after the quote
+ $tmp =~ tr/ //d;
+ $tmp .= ' ' if $rest; # don't create trailing whitespace
+ substr($$lines[$x], 0, $len, $tmp);
+ }
+ }
+ }
+
+ # See if there is some Kammquoting to fix:
+ if ($kamm) { decomb($lines, \@vrb); }
+
+ # Now care about TOFU.
+ # One common mispractice is M$ and Groupwise style TOFU:
+ if ($ms||$gw) {
+ # bloat this array if you want more internationalization:
+ my @tofu = ('Original Message',
+ 'Original-Nachricht',
+ 'Urspr..?ngliche Nachricht',
+ 'Mensagem original',
+ 'Ursprungligt meddelande',
+ 'Oorspronkelijk bericht',
+ 'Message d\'origine',
+ 'Origin message',
+ 'Forwarded message',
+ 'Weitergeleitete Nachricht / Forwarded Message',
+ '[A-Za-z ]+ <(\w[\w.+-]*@(?:[\w.+-]+\.)+[A-Za-z]{2,})> schrieb:');
+ my $k = 0; # any text above?
+ my $tmp = 0; # flagged if inside PGP or SSL output
+
+ DONE: for ($x=0; $x<scalar(@$lines); $x++) {
+ if (!$vrb[$x]) {
+ foreach my $tmp (@tofu) {
+ if (($ms && $$lines[$x] =~ /^\s?-+\s?$tmp\s?-+/) ||
+ ($gw &&
+ ($$lines[$x] =~ /^>>>[^\<]+<[^\>]+> \d\d?\/\d\d?\/\d\d? \d\d?:\d\d [AP]M >>>/ ||
+ $$lines[$x] =~ /^>>> On [A-Z][a-z][a-z]?, [A-Z][a-z][a-z]? \d\d?, \d\d\d\d at [ \d]\d:\d\d [AP]M, in message/))) {
+ $x++;
+ $trad = 0;
+ if ($k) { $bigqn = 0; }
+ last DONE;
+ }
+ }
+
+ if ((!$k) && $$lines[$x] !~ /^\s*$/o &&
+ ((!$mua) ||
+ ($mua eq 'mutt' &&
+ # this line seems not necessary since mutt-1.5.18:
+ $$lines[$x] !~ /^\e[^\a]+\a$/o &&
+ $$lines[$x] !~
+ /^(?:\e[^\a]+\a)?(?:\Q$mutt_attachment\E)/o &&
+ $$lines[$x] !~
+ /^(?:\e[^\a]+\a)?(?:\Q$mutt_contenttype\E)/o)) &&
+ ((!$spass) || index($$lines[$x], $spass_prefix)!=0))
+ {
+ if ($mua eq 'mutt' && (!$tmp) &&
+ ($$lines[$x] =~
+ /^(?:\e[^\a]+\a)?(?:\Q$mutt_pgpoutstart\E)/o ||
+ $$lines[$x] =~
+ /^(?:\e[^\a]+\a)?(?:\Q$mutt_ssloutstart\E)/o)) {
+ $tmp = 1;
+ } elsif ($mua eq 'mutt' && $tmp &&
+ ($$lines[$x] =~
+ /^(?:\e[^\a]+\a)?(?:\Q$mutt_beginsigned\E)/o ||
+ $$lines[$x] =~
+ /^(?:\e[^\a]+\a)?(?:\Q$mutt_pgpcryptstart\E)/o ||
+ $$lines[$x] =~
+ /^(?:\e[^\a]+\a)?(?:\Q$mutt_pgpclearsigstart\E)/o)) {
+ $tmp = 0;
+ } elsif (!$tmp) {
+ $k = 1;
+ }
+ }
+ }
+ }
+
+ # try to avoid false positives and only delete m$ style tofu if
+ # there is text above
+ if ($k) {
+ if (!$ms_smart) { goto CLEAN; }
+
+ # first, see if there is pgp stuff inside the tofu:
+ my $p = 0; # levels of pgp signed parts
+
+ for (my $i=$x+1; $i<scalar(@$lines); $i++) {
+ if ($$lines[$i] =~
+ /^(?:\e[^\a]+\a)?(?:\Q$mutt_pgpclearsigstart\E)/o) {
+ $p++;
+ }
+ }
+ if ($p) {
+ STAIRS: for (my $i=0; $i<scalar(@att); $i++) {
+ if ($p==0 && $att[$i] =~ /^(?:\e[^\a]+\a)?\[-- /o) {
+ splice(@att, 0, $i);
+ unshift(@att, "\n");
+ goto CLEAN;
+ } elsif ($att[$i] =~
+ /^(?:\e[^\a]+\a)?(?:\Q$mutt_pgpclearsigned\E)/o) {
+ splice(@att, 0, $i+1);
+ $p--;
+ goto STAIRS;
+ }
+ }
+ splice(@att);
+ }
+
+ # now removing is safe:
+ CLEAN: $j = scalar(@$lines)-$x;
+ splice(@$lines, $x);
+ }
+ }
+
+ # Nothing? Then try traditional TOFU (deleting M$ style TOFU is done
+ # much more aggressively, so we won't need to search any more if we
+ # did find some):
+ if ($trad && (!$j) && !$vrb[$#$lines]) {
+ if (scalar(@$lines) && $$lines[$#$lines] =~ /^\s*$/) {
+ unshift(@sig, pop(@$lines));
+ }
+
+ my $k;
+ my $x = 1;
+
+ for (my $i=$#$lines; $i>=0; $i--) {
+ if ($vrb[$i]) { last; }
+ if (index($$lines[$i], $indent)==0) {
+ $j++;
+ $k = $i;
+ }
+ elsif ($$lines[$i] !~ /^\s*$/) { last; }
+ }
+
+ if ($j) {
+ # if there is no text above, we will assume the message is meant
+ # as forwarding and therefore OK
+ for (my $i=$k-1; $i>=0; $i--) {
+ if ($$lines[$i] !~ /^\s*$/o) {
+ $x = 0;
+ last;
+ }
+ }
+ if ($x) {
+ $j = 0;
+ } else {
+ splice(@$lines, $k);
+ }
+ }
+ }
+
+ # OK, if we found TOFU, we will leave a message that we were here...
+ if ($j) {
+ # make sendmail bounce if we shall be picky
+ # and indeed found something:
+ if ($mda) {
+ if ($mda ne '1') {
+ print STDERR $boun;
+
+ if ($sysl) {
+ eval { require Sys::Syslog; };
+ if ($@) { warn $@; } else {
+ Sys::Syslog::setlogsock('unix');
+ Sys::Syslog::openlog("$0[$$]", 'pid', 'mail');
+ Sys::Syslog::syslog('debug', 'bounced message %s', $hdr[0]);
+ Sys::Syslog::closelog();
+ }
+ }
+ }
+
+ exit EX_BOUNCE;
+ }
+
+ # if we were invoked just for checking and indeed found something,
+ # print out the error message and quit:
+ if ($check) {
+ print $msg_quote;
+ exit EX_UNAVAILABLE;
+ }
+
+ push(@$lines, "[---=| TOFU protection by $0: " .
+ "$j lines snipped |=---]\n");
+ }
+ elsif ($mda eq '1') { exit EX_OK; }
+
+ # Care for huge blocks of quoted original message:
+ if ($bigqn) { debigq($lines, \@vrb); }
+
+ # Care for trailing whitespaces:
+ if ($trsp) {
+ for ($x=0; $x<scalar(@$lines); $x++) {
+ if (!$vrb[$x]) { $$lines[$x] =~ s/[\ \t]+$//o; }
+ }
+ }
+
+ # Care for punctuation abuse:
+ if ($elli) {
+ for ($x=0; $x<scalar(@$lines); $x++) {
+ if (!$vrb[$x]) { $$lines[$x] =~ s/(([.?!])\2\2)\2+/$1/go; }
+ }
+ }
+
+ # (Nearly) at last care for multiple blank lines. (Do not do this
+ # earlier -- the way it is done right now would screw up the verbatim
+ # list)
+ if ($cr) {
+ # When handling regular TOFU above we move the last empty line from
+ # the body to the signature. This prevents the correct removal of
+ # empty lines before a signature (one line less is removed than it
+ # should) when -c and -t are used. This fixes it.
+ if (scalar(@sig) && $sig[0] =~ /^\s*$/) {
+ push(@$lines, shift(@sig));
+ }
+
+ my $t = 0;
+ for ($x=scalar(@$lines)-1; $x>=0; $x--) {
+ if ((!$vrb[$x]) &&
+ (($mua eq 'mutt' && $$lines[$x] =~ /^\e[^\a]+\a\s*$/o) ||
+ $$lines[$x] =~ /^\s*$/o))
+ {
+ if ($t<$cr) { $t++; } else { splice(@$lines, $x, 1); }
+ }
+ else { $t = 0; }
+ }
+ }
+
+ # Everything changing the body is done now. Time to fix the line count
+ # header so naive clients do not get confused. Just to be sure, append
+ # the old line count to X-headers.
+ my $l = scalar(@bo1) + scalar(@$lines) + scalar(@att) + scalar(@bo2) +
+ (!$sig?scalar(@sig):0) + (!$ml?scalar(@ftr):0) +
+ (!$ad?scalar(@ads):0);
+ if ($linecount-$l!=0) {
+ for ($x=0; $x<scalar(@hdr); $x++) {
+ if ($hdr[$x] =~
+ s/^(Lines:\s+)(\d+)/$1.($2-$linecount+$l)/e)
+ {
+ $hdr[$#hdr] = "X-Old-Lines: $2\n";
+ push(@hdr, "\n");
+ }
+ }
+ }
+
+ # Finally, before leaving we put everything back in right order.
+ unshift(@$lines, (!$hdrs?@hdr:()), @bo1);
+ push(@$lines, (!$sig?@sig:()), (!$ad?@ads:()), (!$ml?@ftr:()), @att,
+ @bo2);
projects / pkg / t-prot.git / blobdiff