#!/usr/bin/perl # # © 2003 Jens Gustedt at loria fr # for all changes from the predecessors as cited below. # # Based on fixmail.pl by Boris 'pi' Piwinger <3.14@piology.org>. # Based on tinnef.pl by Gerd Knorr . # # CAUTION: always test this script before you run it in production on real mail, # otherwise you will loose. # # use English; #################### Configuration #################################### # We need at least one hint for successfully converting html to text. The # variable $textifier serves for this purpose. It should contain a command # line to be executed. You should put the strings #s for the source # html file and #t for the target text file. Here come two examples. # If you have recent lynx. Beware that version 2.8.3 has a bug that breaks # its use in a filter. my($textifier)="/usr/bin/lynx -dump -force_html -display_charset=iso-8859-15 file://localhost#s > #t"; # I personally use this one, since the lynx on our system is outdated. #my($textifier)="$ENV{HOME}/bin/html2text -nobs -o #t #s"; # Same idea holds for verifying multipart/signed. Here #t stands for # the text (message) file and #s for the file containing the detached # signature. The program should send all interesting analysis to # stdout. my(%verifier); $verifier{"application/pgp-signed"}="gpg --verify #s #t 2>&1"; $verifier{"application/pgp-signature"}="gpg --verify #s #t 2>&1"; $verifier{"text/pgp-signed"}="gpg --verify-files #t 2>&1"; # Put your favorite place of the MIME modules here. Hack that is # necessary on our not too well equiped departement servers. use lib '/local/www-serveurs/dmtcs/cgi-bin/'; use lib "$ENV{HOME}/perllib/5.8.0/"; ############# no configuration necessary beyond this line ############### ##################### variable definitions ############################## my($outfile) = \*STDOUT; my($erfile) = \*STDERR; my($pager)=0; my($bodystart) = "no configuration necessary beyond this line"; my($bodyend) = "pgp signature for this program"; my($ret) = 0; # We need temporary files to convert between different mime types. # They all will reside in the same directory and removed at the # end unless you want to keep them. use File::Temp qw/ tempfile tempdir /; my($dtempl) = "norm-XXXXX"; my($ptempl) = "part-XXXXX"; ############## command line interpretation ############################# local($rec) = "+ "; use Getopt::Long; Getopt::Long::Configure("bundling_override"); use Pod::Usage; my(@encodings) = ("8bit", "quoted-printable"); my(%opts) = ( 'radical' => 0, 'recurse' => 0, 'flatten' => 0, 'augment' => 1, 'dump' => 1, 'verify' => 0, 'force' => 0, 'from' => 0, 'enc' => "8bit", 'multi' => 0, 'keep' => 0, 'help' => 0, 'verbose' => 0, 'signyourself' => 0, 'verifyourself' => 0, 'install' => 0 ); my(@optkeys) = ( 'radical!', 'recurse!', 'flatten!', 'augment!', 'dump!', 'verify!', 'force!', 'from!', 'enc=s', 'multi!', 'keep!', 'help|h|?+', 'verbose|v+', 'infile=s', 'outdir=s', 'qp' => sub { $opts{enc} = "quoted-printable" }, '8bit' => sub { $opts{enc} = "8bit" }, '7bit' => sub { $opts{enc} = "7bit" }, 'signyourself!', 'verifyourself!', 'install!' ); my(%names) = ( "normail" => { 'radical' => 0, 'recurse' => 0, 'flatten' => 0, 'augment' => 1, 'dump' => 1, 'verify' => 0, 'force' => 0, 'from' => 0, 'enc' => "8bit", 'multi' => 0, 'keep' => 0, 'help' => 0, 'verbose' => 0 }, "norfilter" => { 'radical' => 0, 'recurse' => 1, 'flatten' => 1, 'augment' => 1, 'dump' => 1, 'verify' => 0, 'force' => 1, 'from' => 1, 'enc' => "8bit", 'multi' => 0, 'keep' => 0, 'help' => 0, 'verbose' => 0 }, "norver" => { 'radical' => 0, 'recurse' => 1, 'flatten' => 0, 'augment' => 0, 'dump' => 0, 'verify' => 1, 'force' => 0, 'from' => 0, 'enc' => "8bit", 'multi' => 0, 'keep' => 0, 'help' => 0, 'verbose' => 1 }, "norcheck" => { 'radical' => 0, 'recurse' => 1, 'flatten' => 0, 'augment' => 0, 'dump' => 0, 'verify' => 1, 'force' => 0, 'from' => 0, 'enc' => "8bit", 'multi' => 0, 'keep' => 0, 'help' => 0, 'verbose' => 0 } ); $names{'normail.pl'} = $names{'normail'}; my($progname) = $0; $progname =~ s|/?([^/]+/)*([^/]+)$|$2|g; # Set default values for different invocations. if (defined($names{$progname})){ my(%optshash) = %{$names{$progname}}; foreach $key (keys(%optshash)) { $opts{$key} = $optshash{$key}; } } die "Can't continue.\n" if (!GetOptions (\%opts, @optkeys)); my($dir) = tempdir( $dtempl, CLEANUP => ! $opts{keep}, TMPDIR => 1); if ($opts{signyourself}){ signyourself(); exit $ret; } elsif ($opts{verifyourself}){ verify_yourself(); exit $ret; } elsif ($opts{install}){ install_yourself(); exit $ret; } ################ stream attachments ###################################### # Use a pager if we are interactive if (-t STDOUT && $opts{dump}){ $ENV{LESS} = "-s-e-F" if (!exists($ENV{LESS})); $pager = $ENV{PAGER} || "(less || more)"; $pager=open( STDOUT, "| $pager"); $erfile = \*STDOUT if (-t STDERR); } if ($opts{verbose}>1) { plapper("possible options, values and types"); my($k)=(); for $k0 (@optkeys,()) { if ($k) { if (ref($k0) !~ /CODE/ ) { my($spec); ($k,$spec) = $k =~ /([^+=!]*)([+=!]?.*)/; my(@k) = split(/\|/,$k); my($n) = shift @k; if (!defined($spec) || $spec eq "!" || $spec eq "") { $spec = "bool"; } elsif ($spec =~ /\+/ ) { $spec = "inc"; } elsif ($spec =~ /^=/ ) { ($spec) = $spec =~ /=(.*)/; } if (exists($opts{$n})) { my($str) = "--$n = " .( $spec eq "bool" ? ( $opts{$n} ? "true" : "false") : $opts{$n}) ." ($spec)"; plapper($str); } else { plapper("--$n = undef ($spec)"); } for $k (@k) { plapper(" --$k same as $n"); } $k = $k0; } else { my(@k) = split(/\|/,$k); my($n) = shift @k; plapper("--$n = (CODE)"); for $k (@k) { plapper(" --$k same as $n"); } $k = (); } } else { $k = $k0; } } } if ($opts{help}) { if ($opts{help}<3) { pod2usage(-exitval => 1, -verbose => $opts{help}-1, -output => \*STDERR ); } # Unfortunally the level 2 verbosity of Pod::Usage doesn't seem to be portable. else { if (eval 'require Pod::Text') { import Pod::Text; my $parser = Pod::Text->new (sentence => 0, width => 78); open($we,"<$0"); $parser->parse_from_filehandle($we,$erfile); close($we); } else { print $erfile "Because of configuration problems a manual page can't be printed online. Please consult the sources instead.\n"; } } close($outfile) if ($pager); close(STDERR); exit(1); } my($infile); if (!defined($opts{infile})) { if (@ARGV == 0) { if (-t STDIN){ pod2usage(-message => "$0: No file given and input is a terminal.", -output => \*STDERR); } $infile = \*STDIN; } $opts{infile} = $ARGV[0]; } if (defined($opts{infile})) { plapper("Reading from file $opts{infile}."); open( $infile, $opts{infile}) || die "${rec}Unable to open $opts{infile}, aborting.\n"; } else { plapper("Reading from stdin."); } ############################# Main ################################################ # Distiguish a local variable $aug and the user choice $opts{augment}. my($aug)=$opts{augment}; my($done) = ""; use MIME::Parser; my($top) = normalize_mail($infile); $top->head->add('X-MIME-Parts-handled',$done) if $done; $top->preamble(["This as multipart message in Mime format.\n", "Mime contents possibly augmented by text/plain and/or normalized by $progname.\n"]); $top->sync_headers(Length => 'COMPUTE'); # Composing the From_ line if requested. if ($opts{from}) { # From http://www.qmail.org/man/man5/mbox.html: # The From_ line always looks like From envsender date # moreinfo. envsender is one word, without spaces or tabs; it # is usually the envelope sender of the message. date is the # delivery date of the message. It always contains exactly 24 # characters in asctime format. moreinfo is optional; it may # contain arbitrary information. # Hopefully perl implementations of localtime will always conform to this. my($fromline) = "From normail ".localtime(); # Do timezone only at runtime and if we find the POSIX module. # This interpretation of the ``moreinfo'' seems not to be equal # by all mailers so it is disabled by default. if (exists($opts{tzone})){ if (eval "require POSIX") { import POSIX qw(tzname); $fromline .= " ".tzname(); } # Fall back to environment if POSIX is not available. elsif (defined($ENV{"TZ"})) { $fromline .= " ".$ENV{"TZ"}; } } print $outfile $fromline,"\n"; } if ($opts{dump}){ $top->print($outfile); # Finally the program appends a blank line to the message. If # the last line of the message was a partial line, it writes # two newlines; otherwise it writes one. print $outfile "\n" if ($opts{from}); close($outfile) if ($pager); } close(STDERR); exit $ret; ################################# End of main ############################ sub plapper{ my(@text) = @_; print $erfile "${rec}@{text}\n" if (exists($opts{verbose})&&$opts{verbose}); } sub textize{ plapper("Textizing entity"); my($tfile)=shift; my($ent)=shift; # The file that is created will be deleted with the directory. my($hfh,$hfile)=tempfile( $ptempl, DIR => $dir, SUFFIX => ".htm" ); $ent->bodyhandle->print(\*$hfh); close($hfh); my($exp) = $textifier; $exp =~ s/#s/$hfile/g; $exp =~ s/#t/$tfile/g; plapper( "Running \"$exp\"" )if ($opts{verbose}>1); system("$exp"); } sub interpret{ my($back) = shift; $back >>= 8; if ($back) { if ($back == 1) { plapper("Signature seems to be invalid, code $back."); $ret |= 1; } else { plapper("Verification of signature failed, code $back."); plapper("Of course, for successful verification you need to"); plapper("have the corresponding pgp key in you keyring."); plapper("To get that key a good guess would be to run"); plapper("something like"); plapper("gpg --verbose --recv-key THE_ID_GOES_HERE"); plapper("This should add the key to your keyring and inform you about"); plapper("the name of the person that is responsible for the key."); $ret |= (1<<4); } } } sub verify{ my ($tent) = shift; my ($sent) = shift; my ($stype) = $sent->mime_type; if (defined($verifier{$stype})) { plapper("Verifying entity. Signature type is $stype."); my($th, $tfile) = tempfile( $ptempl, DIR => $dir, SUFFIX => ".txt" ); $tent->bodyhandle->print(\*$th); close($th); my($sh, $sfile) = tempfile( $ptempl, DIR => $dir, SUFFIX => ".sig" ); $sent->bodyhandle->print(\*$sh); close($sh); my($exp) = $verifier{$sent->mime_type}; $exp =~ s/#s/$sfile/g; $exp =~ s/#t/$tfile/g; plapper( "Running \"$exp\"" )if ($opts{verbose}>1); open(ANA,"$exp |"); foreach $line () { chomp $line; plapper ($line); } close(ANA); interpret($CHILD_ERROR); } else { $ret |= (1<<5); plapper("No verifier for type $stype is known. Aborting verification."); } } sub verify_clearsigned{ my ($tent) = shift; my($mbody)=$tent->body; my($issigned)=0; foreach $line (@$mbody){ $issigned = 1 if ($line =~ '^---+BEGIN PGP SIGNED MESSAGE---+$'); } if (! $issigned){ plapper("Text doesn't seem to be signed, so no verification possible."); return 0; } my ($stype)="text/pgp-signed"; if (defined($verifier{$stype})) { plapper("Verifying entity. Signature type is $stype."); my($th, $tfile) = tempfile( $ptempl, DIR => $dir, SUFFIX => ".txt" ); $tent->bodyhandle->print(\*$th); close($th); my($exp) = $verifier{$stype}; $exp =~ s/#t/$tfile/g; plapper( "Running \"$exp\"" )if ($opts{verbose}>1); open(ANA,"$exp |"); foreach $line () { chomp $line; plapper ($line); } close(ANA); interpret($CHILD_ERROR); } else { $ret |= (1<<5); plapper("No verifier for type $stype is known. Aborting verification."); } } sub normalize_mail{ my($body) = shift; my($parser) = MIME::Parser->new; $parser->output_to_core(1); my($here)=(ref($body) eq 'GLOB' ? $parser->parse($body) : $parser->parse_data($body)); # If the parser didn't succeed, better do nothing. if ($here){ $here = normalize($here); $here->sync_headers(Length=>'COMPUTE'); } return $here; } sub normalize { my($ent,$i)=(@_,0); local($rec) = "+$rec"; return $ent if ($opts{dump}&&$ent->head->get('X-MIME-Normalized')); plapper("Normalizing entity ".$ent->mime_type."."); if ($ent->mime_type =~ /^text\//) { $ent->head->replace('Content-transfer-encoding', $opts{enc}) } # html-only mail is first converted to multipart/alternative # and then treated there. if ($aug && $ent->mime_type eq "text/html") { $ent->make_multipart("alternative"); $done.=" text/html"; } if ($opts{verify} && $ent->mime_type eq "text/plain"){ verify_clearsigned($ent); } if ($ent->mime_type =~ /^multipart/) { my($parts)=$ent->{ME_Parts}; local($rec) = "+$rec"; plapper("multipart has ".sprintf("%d",($#{$parts})+1)." parts."); if ($ent->mime_type eq "multipart/alternative") { plapper("Reduce multipart/alternative"); # Collect the html and plain parts. my(@hfound)=(); my(@pfound)=(); # Collects those parts that will be deleted my(@del) = (); my($type)= ( $opts{force} ? "text/plain" : "text/x-plain"); my($charset)="iso-8859-1"; my($fh, $tfile) = tempfile( $ptempl, DIR => $dir, SUFFIX => ".txt" ); close($fh); # process the parts $i=0; while ($i<=$#{$parts}) { my($ttype) = $$parts[$i]->mime_type; plapper("Found mime part of type $ttype"); # Ensure the good encoding of the part. if ( $ttype =~ /^text\//i ) { $$parts[$i]->head->replace('Content-transfer-encoding', $opts{enc}) } # Treat different types. Only text, merely html and plain, for the moment. if ( $ttype =~ /^text\/html/i ) { unshift(@hfound,$i); if ($opts{dump}) { textize($tfile,$$parts[$i]); unshift(@del,$i) if $opts{radical}; } else { plapper ("-> attempt to textify"); } } elsif ($ttype =~ /^text\//i ) { # look if text part is essentially empty # if it is, delete it my($mbody)=$$parts[$i]->body; my(@words)=split(' ', "@$mbody"); if ($#words < 0 ) { plapper("$ttype part was empty"); # the computed plain will be the real plain # this plain will be deleted unshift(@del,$i); } elsif ($ttype =~ /^text\/plain/i ) { unshift(@pfound,$i); if ($opts{verify}){ verify_clearsigned($$parts[$i]); } } } $i++; } plapper("Found ", $#pfound+1, " text/plain part(s)"); plapper("Found ", $#hfound+1, " text/html part(s)"); # Handle the results. # First append new parts. if ($aug && @hfound) { if (@pfound) { # force it to x-plain if wanted if($opts{force} && @hfound) { foreach $ppos (@pfound){ $$parts[$ppos]->head->replace('Content-Type',"text/x-plain"); } } } else { plapper("Found no plain part. The computed plain part will be the real plain"); $type = "text/plain"; } # attach a part that is just the plain that we computed # should be more efficient on spam catchers plapper("Attaching $type entry"); $ent->attach( Path => "$tfile", Type => "$type", Charset => "$charset", Encoding => $opts{enc}); } # Then delete from back to front. if ( @del ) { plapper("Deleting superfluous parts."); $parts=$ent->{ME_Parts}; @del = sort { $a < $b } @del; foreach $pos (@del) { splice(@$parts,$pos,1); } } $done.=" $type"; } elsif ($ent->mime_type eq "multipart/signed") { if ($opts{verify}){ if ($#{$parts}==1) { if ($$parts[1]->mime_type =~ /^application\/.*sign.*/i ) { verify($$parts[0],$$parts[1]); } else { verify($$parts[1],$$parts[0]); } } else { plapper("multipart/signed must consist of exactly two parts. Aborted."); } } plapper("multipart/signed untouched") if ($opts{dump}); } else { plapper("Eventually recurse on other multiparts."); # this is multipart but not alternative # but there might be some multipart/alternative hidden # way down below in the document tree # We delete empty text/* parts. my(@del) = (); while ($i<=$#{$parts}) { my($here) = $$parts[$i]; my($new_head) = $here->head; my ($mtype) = $$parts[$i]->mime_type; plapper("$i: looking at $mtype."); if ($mtype =~ /^multipart\/alternative/i ) { $aug = $opts{augment}; $$parts[$i] = normalize($$parts[$i]); #$$parts[$i]->head($new_head); } elsif ($mtype =~ /^multipart\//i ) { # don't augment html recursively in mixed documents # they are typically just attached files $aug = 0; $$parts[$i] = normalize($$parts[$i]); } elsif ($mtype =~ /^text\/html/) { $$parts[$i]->head->replace('Content-transfer-encoding', $opts{enc}); my($mbody)=$$parts[$i]->body; my(@words)=split(' ', "@$mbody"); if ($#words < 0 ) { plapper("text/* part was empty"); unshift(@del,$i) ; } if ($opts{verify}){ verify_clearsigned($$parts[$i]); } $$parts[$i] = normalize($$parts[$i]); } elsif ($mtype =~ /^text\//) { $$parts[$i]->head->replace('Content-transfer-encoding', $opts{enc}); my($mbody)=$$parts[$i]->body; my(@words)=split(' ', "@$mbody"); if ($#words < 0 ) { plapper("text/* part was empty"); unshift(@del,$i) ; } if ($opts{verify}){ verify_clearsigned($$parts[$i]); } } elsif ($opts{recurse} && $mtype =~ /^message\//i ) { # treat embedded messages the same way as the top level one $aug = $opts{augment}; # Parse the body as a mail. my($nhere)=normalize_mail($here->body); # If the parser didn't succeed, better do nothing. if ($nhere){ my(@nbody) = split /^/,$nhere->stringify; my($nent) = MIME::Entity->build(Data => \@nbody); $nent->make_singlepart(); $nent->head($here->head); $nent->sync_headers(Length=>'COMPUTE'); $$parts[$i] = $nent; } } $i++; } $ent->{ME_Parts} = $parts; $parts = $ent->{ME_Parts}; # Do the deletion foreach $pos (@del) { plapper("Deleting superfluous parts."); splice(@$parts,$pos,1); } $ent->{ME_Parts}=$parts; } # at the end of multipart, check if the document # has shrunk to one part only. If so, reduce. $ent->make_singlepart if (! $opts{multi} && $ent->parts==1); } elsif ($opts{multi}){ $ent->make_multipart("mixed"); } if ($opts{flatten} && length($ent->parts)==1){ if ($ent->head->mime_type =~ /^message\//) { $ent->make_multipart("mixed"); my($parts)=$ent->{ME_Parts}; my($head)=$ent->head; plapper("Flattening plain forwarded message."); my($here)=normalize_mail($$parts[0]->body); if ($here) { $here->make_singlepart(); my($nhead) = $here->head; # Fields that have to be kept. my(%fields) = ( # Those should be unique in the header. 'From' => 'Resent-From', 'Sender' => 'Resent-Sender', 'Subject' => 'X-New-Subject', 'To' => 'Resent-To', 'Message-Id' => 'References', 'Date' => 'X-New-Date', # These may be multiple. 'X-Loop' => 'X-Loop', 'Delivered-To' => 'Delivered-To', 'Received' => 'Received'); foreach $field (keys(%fields)){ my(@lines) = reverse($head->get_all($field)); plapper("Found ", $#lines+1, " $field lines."); foreach $line (@lines){ $nhead->add($fields{$field}, $line, 0); } } } return $here; } } $ent->head->add('X-MIME-Normalized','YES'); return $ent; } sub signyourself{ my($name) = $0; die "${rec}Please provide --outdir for the signed file." if (! defined($opts{outdir})); die "${rec}Could not open myself for signing." if (! open( PROG, "<$name")); my($preamble) = ""; my($body) = ""; my($state)=0; LINE: foreach $line (){ chomp $line; if ($line =~ /^#+ +$bodystart +#+$/ ){ $state =1; } elsif ($state == 0) { $preamble .= "$line\n"; } elsif ($line =~ /^#+ +$bodyend +#+/ ){ last LINE; } else { $body .= "$line\n"; } } close(PROG); chomp $preamble; chomp $body; my($sign) = "/tmp/normail-sign.asc"; die "${rec}Could not open program for signing." if (! open(SIGN,"| gpg --detach-sign --armor > $sign")); print SIGN "$body"; close(SIGN); my($dumpfile) = "$opts{outdir}normail.pl"; die "Could not open file $dumpfile. Perhaps add `/' to `$opts{outdir}'?" if (! open(DUMP, ">$dumpfile")); print DUMP "$preamble ############# $bodystart ############### $body ############# $bodyend ############### "; die "${rec}Could not open signature file." if (! open(SIGN,"<$sign")); foreach $line (){ print DUMP "# $line"; } close(SIGN); unlink($sign); close(DUMP); if (defined($opts{outdir})) { $opts{verbose}++; my($diff) = "diff $name $dumpfile"; my($dpid) = open(DIFF, "$diff|"); if ($dpid) { plapper("The following differences should only consist of the signature:"); foreach $line () { chomp $line; $line =~ s|$dir|| ; plapper("$line"); } waitpid $dpid, 0; #die "${rec}Abort" if("$CHILD_ERROR"); } else { plapper("Execution of `diff' failed, unable to check if signed version is merely identical."); } } plapper("Signed version saved in $dumpfile. Bye."); } sub verify_yourself{ $opts{verbose}=10; plapper("Starting to verify myself."); local($rec)="+$rec"; plapper("Don't forget that verification is only possible for"); plapper("the invariant part (after the user options)."); my($name) = $0; die "${rec}Could not open myself for verifying." if (! open( PROG, "<$name")); my($preamble) = ""; my(@body) = (); my(@sign) = (); my($state)=0; LINE: foreach $line (){ chomp $line; if ($line =~ /^#+ +$bodystart +#+$/ ){ $state =1; } elsif ($state == 0) { $preamble .= "$line\n"; } elsif ($line =~ /^#+ +$bodyend +#+$/ ){ $state = 2; } elsif ($state == 1) { push(@body,"$line\n"); } else { $line =~ s/^# +//g; push(@sign,"$line\n"); } } my($final) = pop(@body); chomp $final; push(@body,$final); my($tent) = MIME::Entity->build(Data => \@body); $tent->sync_headers(Length=>'COMPUTE'); my($sent) = MIME::Entity->build(Data => \@sign, Type => "application/pgp-signed"); $sent->sync_headers(Length=>'COMPUTE'); verify($tent,$sent); } sub install_yourself{ $opts{verbose}=1 if ($opts{verbose}==0); plapper("Trying to install myself."); die "${rec}Can't continue." if ($ret); plapper("Your perl seems to be found in $EXECUTABLE_NAME."); plapper("Other possibilities would be: ".join(" ",findexe("perl"))); die "${rec}$EXECUTABLE_NAME doesn't seem to be executable" if (! -x "$EXECUTABLE_NAME"); my($name) = $0; die "${rec}Could not open myself for signing." if (! open( PROG, "<$name")); my(@body) = (); LINE: foreach $line (){ push(@body,"$line"); } $body[0] =~ s|([\\/][^\\/]*)*[^\\/]*perl[^\\/]*|$EXECUTABLE_NAME|g ; $body[0] .= "\n"; plapper("First line now looks $body[0]"); plapper("External tools for this program are defined by the following lines:"); foreach $i (0..@body){ my($line) = $body[$i]; chomp $line; if ($line =~ /^[^ #%]+(veri|texti)fier/o ){ plapper("line $i: $line"); local($rec)="+$rec"; my($vari,$defi) = ( $line =~ m/([^=]+)="([^"]+)";/ ) ; my($comm) = ( $defi =~ m/(^[^ ]+)/ ); plapper("Looking for $comm."); if (-x "$comm") { plapper("Command $comm is executable, good."); } else { my(@ncomm) = findexe($comm); foreach $ncomm (@ncomm) { plapper("found $ncomm"); } if (@ncomm){ if (length(@ncomm>1)) { plapper("Warning more then one command for $comm found in path."); plapper("These are: ".join(" ",@ncomm)); } $line =~ s/(.*=")([^ "]+)(.*)/$1$ncomm[0]$3/ ; plapper("Line replaced by: $line"); $body[$i] = "$line\n"; eval ("$line"); } } } } plapper("Please check them carefully and look"); plapper("if the arguments passed to them are apropriate."); plapper("They are already used in the following set up. Good luck."); verify_yourself() if (! $opts{force}); die ("${rec}Verification failed. ${rec}If you are sure that you don't want to check use --force. ${rec}Abort") if ($ret); my($exepath); if (!defined($opts{outdir})) { my(@exepath) = split( "\\/", $EXECUTABLE_NAME ); pop(@exepath); my($exepath) = join( substr($EXECUTABLE_NAME,0,1), @exepath); plapper("Proceeding to install the executable, best in $exepath."); while (1) { print STDERR "${rec}Writing in directory $exepath. Do you agree? Y/n: "; my($ans) = scalar ; if ($ans =~ "[nN]") { print STDERR "${rec}Where should put it instead? "; $exepath = scalar ; chomp $exepath; } else { plapper("ok"); last; } } ; } else { $exepath = $opts{outdir}; } if ( ${exepath} !~ m|[\\/]$| ){ my($ch) = ( ${exepath} =~ m|([\\/])| ); if ($ch) { ${exepath} .= "$ch"; } else { print STDERR "${rec}${exepath} looks bizarre to me: no `/' nor `\\'. Cross fingers.\n"; } } my($dumpname) = "${exepath}normail"; if ( -f "$dumpname" ) { print STDERR "${rec}${dumpname} exists. Overwrite? N/y "; my($ans) = scalar ; die "${rec} Aborting" if ($ans !~ /^[yY]/ ); } die "${rec}Could not open $dumpname for writing. Did you forget `/' in `${exepath}'? Abort " if (! open(DUMP,">$dumpname")); foreach $line (@body) { print DUMP "$line"; } close(DUMP); plapper("Could not protect $dumpname by changing filemode.") if ((chmod 0755, $dumpname)<1); my($symlink_exists) = eval { symlink("",""); 1 }; foreach $name (keys(%names)){ if ($name !~ "^normail" ){ if ($symlink_exists) { $name = "$exepath$name"; if ( ! -f "$name" ){ plapper("Creating symlink $name"); plapper("Failed.") if (! symlink("$dumpname","$name")); } else{ plapper("File $name exists, skipped."); } } } } if (! $opts{force} ) { my($fh, $tfile) = tempfile( $ptempl, DIR => $dir, SUFFIX => ".pl" ); close($fh); my($again) = "$dumpname --install --force --outdir=$dir/ 2> /dev/null < /dev/null "; plapper("Creating second stage."); die "${rec}Execution failed. Aborting " if (system("$again")); #system ("echo uiuuui >> $dir/normail " ); my($dpid) = open(DIFF,"diff -s -q $dumpname $dir/normail |"); if ($dpid){ # plapper("See if the result is identical."); foreach $line () { chomp $line; $line =~ s|$dir|| ; plapper("$line"); } waitpid $dpid, 0; die "${rec}Abort" if("$CHILD_ERROR"); } else { plapper("Execution of `diff' failed, unable to check if second stage is identical."); } } plapper("Install was successful. Have fun."); } sub findexe { my($name) = shift; my(@ret) = (); foreach $dir ( split(':',$ENV{PATH}) ){ my($exe) = "$dir/$name"; push(@ret,"$exe") if (-x "$exe"); } return @ret; } __END__ =head1 NAME normail - normalizing mime encoded mail =head1 SYNOPSIS normail [options] [filename] filename should point to a file that contains one single mail. If filename is omitted and STDIN is not a terminal STDIN is used instead. Other names of this file could be C<< norfilter >> (see L), C<< norver >> (see L) or C<< norcheck >> (verify silently) that implement different sets of default options. Give options -hh or -hhh for more information. =head1 OPTIONS Options are normally starting with C<< -- >> and may be abreviated as long as they are unique. Run C<< normail -vv /dev/null >> to see the default settings of all options. =over 8 =item B<--help> Print a brief help message and exits. When this options is repeated help text gets longer and longer. This options has a short form ``-h'' which accumulates. ``-hhh'' should give you the full documentation. =item B<--verbose> Be verbose. This options has a short form ``-v'' which accumulates. ``-vv'' should give you highest level of verbosity. =item B<--{no}radical> elimindate html parts in multipart/alternatives =item B<--{no}recurse> recursively handle attached messages =item B<--{no}flatten> merge headers of message/* only mails =item B<--{no}augment> augment multipart/alternatives with a text/plain part =item B<--{no}force> force a new text/plain part even if there is already one =item B<--{no}dump> dump a possibliy modified mail to stdout =item B<--{no}verify> verify parts that are cryptographically signed =item B<--{no}from> prepend a \"From ...\" line as a separator =item B<--enc 'encoding-name'> use encoding-name for text/* part encoding =item B<--qp> equivalent to C<< --enc 'quoted-printable' >> =item B<--8bit> equivalent to C<< --enc '8bit' >> =item B<--7bit> equivalent to C<< --enc '7bit' >> =item B<--multi> enforces multpart encoding =item B<--keep> keep saved parts in temp directory for debugging =item B<--install> install the script at some location, indicated by =item B<--outdir>=yourFilename the name of the directory to install. `yourFilename' should be terminating with a slash or whatever is necessary on your system. =back =head1 DESCRIPTION B will read the given input file and do someting useful with the contents thereof. normail is a mail filter. Takes multipart or text/html from STDIN, normalizes some MIME-parts and reduces multipart/alternative to singlepart if possible. =head2 Normalization =over 8 =item * eliminate empty text/plain parts from alternatives =item * insert (augment) a text/plain to an alternative if text/html is found. =item * replace base64 encoding for text parts =item * with option --radical on the command line deletes text/html in alternatives. =back If a C<< multipart/alternative >> would have several C<< text/plain >> parts, all but one of them will be typed C<< text/x-plain >>. The C<< text/x-plain >> could be e.g the old bogus C<< text/plain >> part as it was present in the input or the new part that we produced from C<< text/html >>. The second version can be important if you want to make a bare text version of the mail visible for a spam catcher. Finally (with option C<< dump >>, default) writes cleaned MIME mail to STDOUT. =head2 Verification =over 8 =item * print out the nested structure of the message =item * verify cryptographic signatures =back =head1 DOWNLOAD You may find C<< normail >> here: L. =head1 INSTALLATION Something like yourFavoritePathToPerl yourTemporaryPath/normail --install --outdir=/usr/bin/ puts it in a place where your executables are found (here F) and gives it executable rights. In addition it creates some symbolic links if possible. See the description in source that is located near the head of the file if you encounter difficulties in making normail run properly. =head2 System requirements Try to have a recent version of perl installed. If your perl sits in an unconventional place try to run something like yourFavoritePathToPerl yourPathTo/normail ``Unconventional'' here means any other path than indicated in the first line of this script here. But if you followed the install instructions above, this should rarely be necessary. (Rarely here means systems that share a common file sytem, but not your path to perl.) We need the following perl modules: =over 16 =item Getopt::Long =item Pod::Usage =item File::Temp =item MIME::Parser =back =head2 Html Mail Furthermore we need an external program to convert html to plain text, like lynx, see L, or html2text, see L. Therefore, we need at least one hint for successfully converting html to text. The variable C<< $textifier >> serves for this purpose. It should contain a command line to be executed. You should put the strings C<< #s >> for the source html file and C<< #t >> for the target text file. Here come two examples. If you have recent lynx. Beware that version 2.8.3 has a bug that breaks its use in a filter. my($textifier)="/usr/bin/lynx -dump -force_html file://localhost#s > #t"; I personally use this one, since the lynx on our system is outdated. my($textifier)="$ENV{HOME}/bin/html2text -nobs -o #t #s"; =head2 Crytographic Signatures Same idea holds for verifying multipart/signed mime mails or clearsigned text mails. Here C<< #t >> stands for the text (message) file and C<< #s >> for the file containing the signature. The program should send all interesting analysis to stdout. $verifier{"application/pgp-signed"}="gpg --verify #s #t 2>&1"; $verifier{"text/pgp-signed"}="gpg --verify-files #t 2>&1"; =head1 EXAMPLES Use it as filter on mail delivery, or interactively if some bogus mail is unreadable for your bare eyes. =head2 FILTER B always test this script before you run it in production on real mail, otherwise you will loose. With procmail, to normalize all multiparts: # Clean MIME mails :0 * ^Content-Type:.*multipart/ { :0c: tmp/normail :0fhbw | normail --from } If your perl is at a different place than normal (what's that?) put something like | your-path-to-perl your-path-to-normail -from =head2 INTERACTIVE If run in a terminal, normail trys to use your favorite pager for output. If you want to use it with VM in (X)Emacs when the sender supplied an unreadable textversion (or none at all) of his html-mail: (defalias 'normail (read-kbd-macro "e M-< C-SPC M-> C-u M-| norfilter RET C-c C-c")) (define-key vm-mode-map "+" 'normail) When you want to verify structure and/or signature of mime mails: (defalias 'norver (read-kbd-macro "| C-SPC C-a C-w norver RET")) (define-key vm-mode-map "-" 'norver) =head1 COPYRIGHT AND DISCLAIMER =head2 Introduction This code is public domain. It comes with absolutely no warranty. If it eats your mails for lunch, that's your problem. If you don't like this, don't use it. =head2 Copyright This program is Copyright 2003 by Jens Gustedt for all changes from the predecessors as cited in the L. =head2 License This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. =head2 Disclaimer This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. =head2 More information If you do not have a copy of the GNU General Public License write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. =head1 ACKNOWLEDGEMENT =over 8 =item * Based on fixmail.pl by Boris 'pi' Piwinger <3.14@piology.org>. =item * Based on tinnef.pl by Gerd Knorr . =back =cut ############################################################################# ############# pgp signature for this program ############### # -----BEGIN PGP SIGNATURE----- # Version: GnuPG v1.2.4 (GNU/Linux) # # iD8DBQBBb9eSD9PoadrVN+IRAvNQAKCUWiO4qQj7P0TCXFfUd9Vvrv+VDQCfexK0 # w88sAocbQqNWZBkHzG4K/Vs= # =yQyY # -----END PGP SIGNATURE-----