#!/usr/bin/perl -w
-# $Id: t-prot,v 1.280 2010/02/11 11:10:47 jochen Exp $
+# $Id: t-prot,v 1.285 2010/02/15 20:13:00 jochen Exp $
require 5.006;
use strict;
use Fcntl qw(O_EXCL O_WRONLY O_CREAT);
use Getopt::Mixed qw(nextOption);
-use constant VER => '2.14';
+use constant VER => '2.15';
use constant REV => '';
-use constant REL => q$Revision: 1.280 $=~m/(\d+(?:\.\d+)+)/;
+use constant REL => q$Revision: 1.285 $=~m/(\d+(?:\.\d+)+)/;
# MTA expecting mail on STDIN
# (you might have to adjust this if using a different MTA)
use constant SENDMAIL => '/usr/sbin/sendmail -oi';
$ad $ads $bigqn $bigqx $boun $check $check_ratio $cr $diff $elli
$footers $ftr_ad $ftr_ml $hdrs $indent $kamm $kdiff $kminl $kmaxl
$lax $lsig $maxsig $maxlines $mda $ml $gw $ms $ms_smart $msg_quote
- $msg_ratio $mua $nohdr $ofile $pgpshort $pgpmove $pgpmovevrf $sig
- $sigint $sign $spass $spass_prefix $sysl $trad $trsp
+ $msg_ratio $mua $nohdr $ofile $pgpshort $pgpmove $pgpmovevrf $reply
+ $sani $sig $sigint $sign $spass $spass_prefix $sysl $trad $trsp
$gpg_WARNING $gpg_Warning $gpg_Cantcheck $gpg_aka $gpg_bad
$gpg_expired $gpg_good $gpg_bug
--pgp-move-vrf move pgp output if verified and good; requires -Mmutt
--pgp-short hide non-relevant pgp key uids; requires -Mmutt
-r delete mail header lines
+ --reply squeeze multiple reply prefixes in subject line
-S[=n] supress signatures with more than n lines (default $maxsig)
-s delete signature
+ --sani sanitize some header fields
--sigsmax[=n] max number of sigs tolerated, no value for unlimited
--spass enable SpamAssassin workaround
-t delete traditional style TOFU
$sigint = 1;
}
+sub sanitize_hdr {
+ # Undoes MIME quoted-printable word encoding.
+ sub qp_decode {
+ my $word = shift;
+ $word =~ tr/_/\x20/;
+ $word =~ s/=DF/ss/og;
+ $word =~ s/=C4/Ae/og;
+ $word =~ s/=D6/Oe/og;
+ $word =~ s/=DC/Ue/og;
+ $word =~ s/=E4/ae/og;
+ $word =~ s/=F6/oe/og;
+ $word =~ s/=FC/ue/og;
+ $word =~ s/=([0-9A-F]{2})/chr(hex $1)/ioge;
+ $word;
+ }
+
+ sub umlauts {
+ my $word = shift;
+ $word =~ s/ä/ae/og;
+ $word =~ s/Ä/Ae/og;
+ $word =~ s/ö/oe/og;
+ $word =~ s/Ö/Oe/og;
+ $word =~ s/ü/ue/og;
+ $word =~ s/Ü/Ue/og;
+ $word =~ s/ß/ss/og;
+ $word;
+ }
+
+ my $H = shift; # array of header lines
+ my $i;
+
+ for ($i=0; $i<$#$H; $i++) {
+ if ($$H[$i] =~ /^subject: /io) {
+ if ($sani) {
+ $$H[$i] =~ s/=\?iso-8859-15?\?q\?([^?]*)\?=/qp_decode($1)/ioge;
+ $$H[$i] =~ s/^subject: *(.*)/"Subject: " . umlauts($1)/ioe;
+ }
+ if ($reply) {
+ $$H[$i] =~ s/^subject: *(?:(?:Re|Antw(?:ort)?|AW|WG): *)+/Subject: Re: /io;
+ }
+
+ $i++;
+ while ($i<$#$H && $$H[$i] =~ /^\s/) {
+ if ($sani) {
+ $$H[$i] =~ s/=\?iso-8859-15?\?q\?([^?]*)\?=/qp_decode($1)/ioge;
+ $$H[$i] =~ s/^\s+(\S.*)/" " . umlauts($1)/ioe;
+ }
+ if ($reply) {
+ $$H[$i] =~ s/^\s+(?:(?:Re|Antw(?:ort)?|AW|WG): *)+/ /io;
+ }
+ $i++;
+ }
+ }
+ elsif ($sani && $$H[$i] =~ /^(?:from|to): /io) {
+ $$H[$i] =~ s/=\?iso-8859-15?\?q\?([^?]*)\?=/qp_decode($1)/ioge;
+
+ $i++;
+ while ($i<$#$H && $$H[$i] =~ /^\s/) {
+ $$H[$i] =~ s/=\?iso-8859-15?\?q\?([^?]*)\?=/qp_decode($1)/ioge;
+ $i++;
+ }
+ }
+ }
+}
+
# remove_footers(): remove any trailing appearance of footers contained
# in the given directory.
sub remove_footers {
# 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);
# Care for trailing whitespaces:
if ($trsp) {
for ($x=0; $x<scalar(@$lines); $x++) {
- if (!$vrb[$x]) { $$lines[$x] =~ s/[\ \t]+$//; }
+ 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/g; }
+ if (!$vrb[$x]) { $$lines[$x] =~ s/(([.?!])\2\2)\2+/$1/go; }
}
}
if ($cr) {
my $t = 0;
for ($x=scalar(@$lines)-1; $x>=0; $x--) {
- if ((!$vrb[$x]) && $$lines[$x] =~ /^\s*$/) {
+ if ((!$vrb[$x]) &&
+ (($mua eq 'mutt' && $$lines[$x] =~ /^\e[^\a]+\a\s*$/o) ||
+ $$lines[$x] =~ /^\s*$/o))
+ {
if ($t<2) { $t++; } else { splice(@$lines, $x, 1); }
}
else { $t = 0; }
# command line switches
($ad, $ads, $bigqn, $bigqx, $check, $cr, $sysl, $diff, $elli, $footers, $lax,
- $ml, $gw, $ms, $ms_smart, $mda, $mua, $hdrs, $kamm, $lsig, $nohdr, $sig,
- $sigint, $spass, $trad, $trsp) =
- (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
+ $ml, $gw, $ms, $ms_smart, $mda, $mua, $hdrs, $kamm, $lsig, $nohdr, $reply,
+ $sani, $sig, $sigint, $spass, $trad, $trsp) =
+ (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
my $ifile = '-'; # use STDIN if nothing specified
# get command line params:
Getopt::Mixed::init('a A=s c d e h i=s k L=s l m M=s o=s P=s p:s r S:i'.
' s t v w bigq:s body check:s debug>d diff ftr-ad ftr-ml groupwise'.
' help>h kminl=i kmaxl=i kdiff=i lax-security locale=s max-lines=i'.
- ' ms-smart mua>M pgp-short pgp-move pgp-move-vrf sigsmax:i spass'.
- ' version>v');
+ ' ms-smart mua>M pgp-short pgp-move pgp-move-vrf reply sani sigsmax:i'.
+ ' spass version>v');
while (my ($opt, $val, $pretty) = nextOption()) {
if ($opt eq 'a') { $ad = 1; }
elsif ($opt eq 'A') { $ads = $val; }
elsif ($opt eq 'pgp-move') { $pgpmove = 1; }
elsif ($opt eq 'pgp-move-vrf') { $pgpmovevrf = 1; }
elsif ($opt eq 'r') { $hdrs = 1; }
+ elsif ($opt eq 'reply') { $reply = 1; }
elsif ($opt eq 'S') { $lsig = $val ? $val : $maxsig; }
elsif ($opt eq 's') { $sig = 1; }
+ elsif ($opt eq 'sani') { $sani = 1; }
elsif ($opt eq 'sigsmax') { $sign = $val ? $val : undef; }
elsif ($opt eq 'spass') { $spass = 1; }
elsif ($opt eq 't') { $trad = 1; }
else { help(); }
}
Getopt::Mixed::cleanup();
-if (($ml && $footers eq '')|| # no -l without -L
- ($ad && $ads eq '')|| # no -a without -A
- ($nohdr && $pgpshort)|| # --body and --pgp-short are like oil and water
- ($ifile eq '')|| # no empty -i
- ($ofile eq '')) # no empty -o
+if (($ml && $footers eq '')|| # no -l without -L
+ ($ad && $ads eq '')|| # no -a without -A
+ ($nohdr && $pgpshort)|| # --body and --pgp-short are oil and water
+ (($nohdr||$hdrs) && ($sani||$reply))|| # no sanitazing without headers :)
+ ($ifile eq '')|| # no empty -i
+ ($ofile eq '')) # no empty -o
{ help(); }