#!/usr/bin/perl # $Id: mailfilter,v 1.12 2003/12/24 09:38:09 psionic Exp $ # # How to use: # You need to specify mailfilter as your showproc. So, you'll need to add # these two lines to your .mhprofile. # # showproc: /path/to/mailfilter # showmimeproc: /path/to/mailfilter # # Notes: # This program will create mhl.html. This file is *required* to display # readable headers in w3m, links, or lynx. # After it is created, feel free to edit it further to suit your needs. # See mhl(1) and mh-format(5) for more information on formatting. # # Features: # - Automatically open html mail in w3m (see $BROWSER) # - Automagically verify pgp signatures # - Non-displayable attachments are linked for download availability # - Uses settings from .mh_profile (if any) # - Automatically fetch pgp public keys [Added 2003/08/13] # - Support for screen. (See SCREEN_POLICY below) [Added 2003/08/13] # # Problems: # - Doesn't let you fully customize mhstore-store parameters. # For now, if you insist on having your own mhstore-store entries, you # *MUST* use %m%P as the FIRST part of the filename. # use strict; use Symbol; # Fix for 5.005_03 # User settings, change these to suit your enviroment: {{{ # Screen policy - This setting determines how to (if at all) interact with {{{ # the screen program. Setting this value to "0" means it doesn't invoke screen # at all. A value of 1 will use screen (and invoke a new window) only if you # are currently running IN a screen session. Finally, a value of 2 will force # it to ALWAYS use screen, regardless of whether or not you are currently # in a screen session or not. my $SCREEN_POLICY = 1; #}}} # PGP stuff, I'll add more here later as I need them. {{{ my %pgp = ( # Command to verify a pgp signed email. %s is the "sig" file, %f is the content. pgp_verify_command => "gpg --no-secmem-warning --quiet --no-verbose --batch --output - --verify %s %f", # Command to receive an unknown public key. %i is the key id. pgp_recvkey_command => "gpg --no-secmem-warning --no-verbose --batch --output - --recv-key %i", # Automatically download pgp keys? pgp_recvkey_auto => 1, ); #}}} # Plain-text types to be displayed. Content-Types not matched here will be {{{ # shown as links at the bottom of the email (if the mail is multipart) # These can be regular expressions. my @plaintext_types = ( 'text/.*', 'message/delivery-status', ); #}}} # End user configuration }}} # Basic setup and shenanigans! {{{ # Read in .mh_profile {{{ my $mhp = $ENV{"HOME"}."/.mh_profile"; $mhp = $ENV{"MH"} if ($ENV{"MH"}); my %mh; open(MHPROFILE, "< $mhp") or die("Unable to open $mhp for reading.\n$!\n"); while () { chomp(); m/([A-Za-z-]+):\s*(.*)$/; $mh{lc($1)} = $2; $mh{lc($1)} = $ENV{"HOME"} . "/$2" if (lc($1) eq 'path' && $2 !~ m,^/,); } close(MHPROFILE); # Verify *required* parts of mh_profile {{{ #}}} #}}} # Viewer detection #{{{ my %viewers = ( # Web Browsers 'browsers' => ['w3m', 'links', 'lynx'], 'lynx' => "lynx -force_html -vikeys", 'links' => "links", 'w3m' => "| w3m -title -T text/html", # Pagers 'pagers' => ['envpager', 'less', 'pg', 'more'], 'less' => "| less", 'more' => "| more", 'pg' => "| pg", 'envpager' => "| " .$ENV{'PAGER'}, # Editors 'editors' => ['envvisual', 'enveditor', 'vi', 'pico', 'joe', 'emacs'], 'vi' => "vi", 'emacs' => "emacs", 'pico' => "pico", 'joe' => "joe", 'enveditor' => $ENV{'EDITOR'}, 'envvisual' => $ENV{'VISUAL'}, # A last resort. 'lastresort' => ['cat'], 'cat' => "| cat -v", # Debug 'debug' => ['devnull'], 'devnull' => '> /dev/null' ); my $VBROWSER; my (@v); # UNCOMMENT TO SEND MAIL TO /dev/null or cat (FOR DEBUGGING) #push(@v,@{$viewers{debug}}); #push(@v, @{$viewers{lastresort}}); push(@v, @{$viewers{browsers}}); push(@v, @{$viewers{pagers}}); push(@v, @{$viewers{editors}}); push(@v, @{$viewers{lastresort}}); foreach my $viewer (@v) { my $rview = $viewers{"$viewer"}; if ($rview =~ m/^\s*>/) { $VBROWSER = $viewers{$viewer}; last; } $rview =~ s/^(\|?\s+)?([^\s]+)(\s?.*)$/$2/; foreach (split(":",$ENV{PATH})) { $VBROWSER = $viewers{$viewer} if (-x "$_/$rview"); } last if ($VBROWSER); } print STDERR "Using this viewer: $VBROWSER\n"; my $BROWSER = $VBROWSER;; if ($VBROWSER !~ /^\|/) { $BROWSER = "> /tmp/" . mktemp(); } #}}} my $TMP = $mh{'nmh-storage'}; $TMP = "/tmp" unless($TMP); #nmh defaults to /tmp # HTML Enable? {{{ my $HTML_ENABLE; $HTML_ENABLE = 1 if ($VBROWSER =~ /(w3m|links|lynx)/); my $MHL_PROG = "/usr/local/libexec/nmh/mhl"; my $MHL_HTML_OPTS = "-form mhl.html"; my $MHL_PLAIN_OPTS = ""; my $MHL_OPTS = ($HTML_ENABLE) ? $MHL_HTML_OPTS : $MHL_PLAIN_OPTS; #}}} # We need mhl.html, write it if it doesn't exist. {{{ unless (-e $mh{'path'}."/mhl.html") { print STDERR $mh{'path'}."/mhl.html does not exist. Creating it.\n"; open(MHLHTML, "> ".$mh{'path'}."/mhl.html") or die("Failed trying to open ".$mh{'path'}."/mhl.html for writing.\n$!\n"); print MHLHTML << "END_MHLHTML"; ; html overflowtext="",overflowoffset=0 compwidth=1 : : : Subject:decode : : : Date:formatfield="%<(nodate{text})%{text}%|%(pretty{text})%>" :
From:decode :
To: :
cc: Subject:decode :
User-Agent:formatfield="%<{text}%{text}
%>" X-Mailer:formatfield="%<{text}%{text}
%>" X-Spam-Level:formatfield="%<{text}%{text}
%>" :
body:nocomponent,overflowtext=,overflowoffset=0,noleftadjust END_MHLHTML close(MHLHTML); } #}}} # Screen support (w00t!) {{{ my $SCREEN_STY; unless ($VBROWSER =~ m/^>/) { if (($ENV{"STY"} && $SCREEN_POLICY == 1) || ($SCREEN_POLICY == 2)) { print STDERR "Screen session detected...\n"; $SCREEN_STY = $ENV{"STY"}; # If our browser is a pipe-to browser, we can't do that with screen... if ($VBROWSER =~ /^\|/) { $BROWSER = "> /tmp/" . mktemp(); $VBROWSER =~ s/^\|\s*//; } } } #}}} #}}} # Set $mail, $folder, $base, other useful variables. {{{ my ($mail) = $ARGV[0]; my ($folder) = `folder -fast`; chomp($folder); my $base; $base = $mh{'path'} if ($folder !~ m,^/,); my ($file) = "$base/$folder/$mail"; my $browser_content_type; my $browser_done_headers; my $pre; #}}} # Read in the mail headers {{{ my %headers; my @order; my ($is_html,$done_headers) = (0,0); my $header; my $from_line; print STDERR "Reading mail headers\n"; open(MAIL, "< $file") or die("Unable to open $file.\n$!\n"); $from_line = ; chomp($from_line); my $boundary; my %ticks; my $lookforctype = 0; my @part_types; while () { chomp(); if ($done_headers == 0) { if (m/^$/) { $done_headers = 1; next; } if (s/^([A-Za-z-]+):\s+//) { my $a = $1; unless ($a =~ m/^Content-Type$/i) { $ticks{$1}++; $a .= "_" . $ticks{$1}; } $header = $a; push(@order,$header); } if (defined($headers{$header})) { $headers{$header} .= "\n" . $_; } else { $headers{$header} .= $_; } } else { chomp(); unless ($boundary) { ($boundary) = grep(/^content-type$/i,keys(%headers)); $boundary = $headers{$boundary}; $boundary =~ m/boundary="([^"]+)"/; $boundary = $1; } #print $_ . "\n"; if ($_ eq "--$boundary") { $lookforctype = 1; next; } #if ($lookforctype == 1) { #if (m,^Content-Type: ([a-z-]+/[a-z-]+),i) { #print "Part " . (scalar(@part_types) + 1) . ": $1\n"; ##push(@part_types,$1); #$lookforctype = 0; #} #} } } close(MAIL); # We're done reading the headers }}} #{{{ Useful Variables (content-typpe, tempfile template, ...) my ($ctype) = grep(/^content-type$/i,keys(%headers)); $ctype = $headers{$ctype}; $ctype =~ s/;.*$//; my $fr = $folder; $fr =~ s,^.*/([^/]+)$,$1,; my $template = "$mail"; my $templatereg = '^'.$mail.'\.[0-9]+\.'; #}}} # Handle the mail, multipart or otherwise, it doesn't matter anymore! =) {{{ $ctype = "text/plain" if ($ctype =~ m/^$/); print STDERR "Parsing multipart mail ($ctype)\n"; system("rm $TMP/$template* > /dev/null 2>&1"); my %parts; my @partlist = split("\n",`mhlist -noheaders 2> /dev/null`); my @fileparts; my $x = 1; foreach (@partlist) { next if (m,multipart,i); chomp(); s/^\s+//; my ($part,$type,$size,$desc) = split(/\s+/,$_,4); push(@part_types,$type); $parts{$x} = { 'type' => $type, 'size' => $size, 'desc' => $desc, 'part' => $x }; my $storefile = `mhstore -part $part 2>&1`; chomp($storefile); if ($storefile =~ m/^storing/) { #$storefile =~ s/^mhstore:.*//; # Slurp out errors $storefile =~ s/^.*as file //; $parts{$x}->{'file'} = $storefile; push(@fileparts,"$storefile"); $x++; } } #system("mhstore"); #print "Files: " . join(" | ", @fileparts) . "\n"; # If part 2 is html, then open it first assuming that this email was dually # sent as text/plain and text/html. my $mailpart; if ( ($HTML_ENABLE) && ($parts{2}{type} =~ m/\.html$/ && ($mailpart = $parts{2})) || ($parts{1}{type} =~ m/\.html$/ && ($mailpart = $parts{1})) ) { my $tmpfile = "$TMP/.headers.$fr.$mail"; print STDERR "Starting browser (Probably HTML Mail)\n"; open(BROWSER, "$BROWSER"); browser_set_content_type("text/plain") unless ($HTML_ENABLE); browser_set_content_type("text/html") if ($HTML_ENABLE);; mhl_write_headers($tmpfile); browser_print("< $tmpfile","text/mail-header"); browser_print("< $TMP/$mailpart"); undef($parts{$_}); mime_for_you(\%parts,@fileparts); close(BROWSER); check_open_browser(); system("rm $tmpfile"); } else { # This doesn't appear to be an html mail, let's deduce what it is... print STDERR "Starting browser (Multipart mail)\n"; open(BROWSER, "$BROWSER"); browser_set_content_type("text/plain") unless ($HTML_ENABLE); browser_set_content_type("text/html") if ($HTML_ENABLE);; print STDERR "Browser type: $browser_content_type\n"; my $tmpfile = "$TMP/.headers.$fr.$mail"; mhl_write_headers($tmpfile); #print STDERR "Printing headers ($tmpfile)\n"; browser_print("< $tmpfile","text/mail-header"); # Do PGP stuff first? my $DO_PGP; my $PGP_TYPE; chomp(my $pgp_plain_test = `head -n 1 $fileparts[0]`); if ($pgp_plain_test eq '-----BEGIN PGP SIGNED MESSAGE-----') { $DO_PGP = 1; $PGP_TYPE = 1; } if (scalar(grep(/application\/pgp-signature?/,@part_types)) > 0) { $DO_PGP = 1; my $count = 0; foreach my $part (@fileparts) { my $type = $part_types[$count]; if ( (!defined($PGP_TYPE->{'plain'})) && ($type =~ m,text/(plain|html),) ) { $PGP_TYPE->{'plain'} = $part; $PGP_TYPE->{'plainidx'} = $count + 1; $PGP_TYPE->{'plaintype'} = $type; } if ( (!defined($PGP_TYPE->{'sig'})) && ($type =~ m,application/pgp-signature?,) ) { print STDERR "Sig: $part\n"; $PGP_TYPE->{'sig'} = $part; $PGP_TYPE->{'sigidx'} = $count + 1; } $count++; } } if ($DO_PGP) { # pgp-signed email {{{ print STDERR "pgp signature found, invoking pgp...\n"; my $pgp_verify = $pgp{'pgp_verify_command'}; if (ref($PGP_TYPE) eq '') { $pgp_verify =~ s,%s,,; $pgp_verify =~ s,%f,$fileparts[0],; } else { $pgp_verify =~ s,%s,$PGP_TYPE->{'sig'},; $pgp_verify =~ s,%f,$PGP_TYPE->{'plain'},; } my $buffer; #open(PGP_VERIFY, "$pgp_verify 2>&1 | "); #$buffer = ; #close(PGP_VERIFY); # Simpler... $buffer = `$pgp_verify 2>&1`; # If we don't have this public key, fetch it. my ($key,$status) = split("\n",$buffer); $key =~ s/^.*key ID //; if ($status =~ m,Can't check signature: public key not found,) { print STDERR "Public key not found, $key.\n";; print STDERR "gpg said:\n" . $buffer . "\n"; if ($pgp{"pgp_recvkey_auto"}) { print STDERR "Key not found in keyring, automatically fetching...\n"; my $pgp_recvkey = $pgp{"pgp_recvkey_command"}; $pgp_recvkey =~ s/%i/$key/g; # Grab key, and reverify if we fetched it. #$buffer = `$pgp_recvkey`; system("$pgp_recvkey"); $buffer = ""; print STDERR $buffer . "\n"; if ($? == 0) { $buffer .= "Key ID $key did not exist in your keyring, it was fetched automatically\n"; $buffer .= `$pgp_verify 2>&1`; } else { $buffer .= "Failed to fetch key from keyserver. Exit code $?\n"; $buffer .= "Key ID: $key\n"; } } } $buffer =~ s/gpg:\s*//g; browser_print(\$buffer, "text/signature-result",2); undef $parts{$PGP_TYPE->{'sigidx'}} if (ref($PGP_TYPE) eq 'HASH'); } #}}} print STDERR "Printing part #1: " . $fileparts[0] . "\n"; browser_print("< " . $fileparts[0], $parts{1}{'type'}); undef($parts{1}); mime_for_you(\%parts,@fileparts) if (scalar(@fileparts) > 1); close(BROWSER); check_open_browser(\@fileparts); system("rm $tmpfile > /dev/null 2>&1"); } unless (($ENV{"STY"} && $SCREEN_POLICY == 1) || ($SCREEN_POLICY == 2)) { foreach (@fileparts) { system("rm $_ > /dev/null 2>&1"); } } # }}} sub mhl_write_headers { #{{{ my ($out) = shift; open(MHLWRITE, "| $MHL_PROG $MHL_OPTS > $out") or die("Failed trying to pipe to $MHL_PROG\n$!\n"); print MHLWRITE "$from_line\n"; foreach (@order) { my $a = $_; $a =~ s/^([A-Za-z-]+)_[0-9]+$/\1/; print MHLWRITE "$a: $headers{$_}\n"; } close(MHLWRITE); } #}}} sub browser_print { #{{{ my ($what,$type,$splitter) = @_; my $contents; print STDERR "Printing type $type\n"; if (ref($what) eq 'GLOB') { $contents = $what; } elsif (ref($what) eq 'SCALAR') { $contents = Symbol::gensym(); # Fix for 5.005_03 pipe($contents,WRITER); # hehe.. print WRITER $$what; close(WRITER); } else { $contents = Symbol::gensym(); # Fix for 5.005_03 open($contents,$what) or die("Unable to open $what for reading.\nreason> $!\n"); } my ($not_real_html); if ($browser_done_headers) { if ($browser_content_type eq 'text/html') { if ($browser_content_type ne $type) { if ($type eq 'text/mail-header') { $not_real_html = 2; } else { $not_real_html = 1; } } else { $not_real_html = 0 } } else { if ($type eq 'text/mail-header') { $not_real_html = 2; } else { $not_real_html = 1; } } } else { $not_real_html = 2; } if ($splitter == 1) { if ($HTML_ENABLE) { print BROWSER "
"; } else { #print BROWSER "\033[1m;--------\033[0m;"; print BROWSER "-----------------\n"; } } my $header_cc_kludge = 0; #if ($browser_content_type eq 'text/html' && $type ne 'text/html' && $browser_done_headers && $type !~ m,text/(signature-result|mail-header), && !$pre) { print BROWSER "
"; $pre = 1; }
   if ($browser_content_type eq 'text/html' && $type ne 'text/html' && $browser_done_headers && $type !~ m,text/(signature-result|mail-header), && !$pre) { print BROWSER ""; $pre = 1; }

   while (<$contents>) { 
      if ( ($not_real_html) && ($HTML_ENABLE) ) {
	 if ($not_real_html == 1) {;
	    s//>/g 
	 } elsif ($not_real_html == 2) {
	    # God, I love perl...
	    s,<((?!(/?(html|head|title|body|br|hr)))[^>]*)>,<$1>,g;
	 }

	 # Lame kludge :(
	 if (!$browser_done_headers) {
	    print BROWSER "
\n" if (($header_cc_kludge) && (m/^Subject:/)); $header_cc_kludge = 1 if ((!$header_cc_kludge) && (m/^cc:/)); } s/\n/
\n/g if ($pre); print BROWSER $_; #print BROWSER "
\n" if ($not_real_html != 2) && ($browser_content_type eq 'text/html' && $type ne 'text/html' && $browser_done_headers); #print BROWSER "
\n" if ($browser_content_type eq 'text/html' && $type ne 'text/html' && $browser_done_headers); print BROWSER "
" if ($browser_done_headers && $browser_content_type eq 'text/html' && $type eq 'text/signature-result'); if ((!$browser_done_headers) && (m/^(\n|
)$/)) { $browser_done_headers = 1; if ($browser_content_type eq 'text/html') { if ($browser_content_type ne $type) { $not_real_html = 1; } else { $not_real_html = 0; } } else { $not_real_html = 1; } if ($browser_content_type eq 'text/html' && $type ne 'text/html' && $browser_done_headers && $type !~ m,text/(signature-result|mail-header), && !$pre) { print BROWSER ""; $pre = 1; } #if ($browser_content_type eq 'text/html' && $type ne 'text/html' && $browser_done_headers && $type !~ m,text/(signature-result|mail-header), && !$pre) { print BROWSER "
"; $pre = 1; }
	 }
      } else {
	 print BROWSER $_;
      }

   }

   #if ($browser_content_type eq 'text/html' && $type ne 'text/html' && $browser_done_headers && $type !~ m,text/(signature-result|mail-header), && $pre) { print BROWSER "
"; $pre = 0; } if ($browser_content_type eq 'text/html' && $type ne 'text/html' && $browser_done_headers && $type !~ m,text/(signature-result|mail-header), && $pre) { print BROWSER ""; $pre = 0; } if ($splitter == 2) { if ($HTML_ENABLE) { print BROWSER "
"; } else { #print BROWSER "\033[1m;--------\033[0m;"; print BROWSER "-----------------\n"; } } close($contents) if (ref($what) ne 'GLOB'); $| = 0; } #}}} sub browser_set_content_type { #{{{ my $type = shift; $browser_content_type = $type; } #}}} sub handle_mime_attachment { #{{{ my ($part,$file,$defer) = @_; my $yep; my $spl = 0; foreach my $pt (@plaintext_types) { #print STDERR "$file> ". $part->{type}. ": $pt\n"; if ($part->{type} =~ m/^$pt$/i) { if ($HTML_ENABLE) { print BROWSER "
"; } else { #print BROWSER "\033[1m;--------\033[0m;"; print BROWSER "--------------------------------------------------------------------------------\n"; } print BROWSER "[ Part " . $part->{'part'} . " - " . $part->{'desc'} . ", type=" . $part->{'type'} . " ]\n"; print BROWSER "

\n" if ($HTML_ENABLE); browser_print("< $file", $part->{type}, $spl); $yep = 1; last; } } push(@{$defer}, [ $part, $file ]) unless ($yep); #print STDERR "\n"; } #}}} sub mime_for_you { #{{{ my ($parts,@fileparts) = @_; my @justlink; foreach (keys(%{$parts})) { next unless (keys(%{$parts->{$_}}) > 0); handle_mime_attachment($parts->{$_},$fileparts[$_ - 1],\@justlink); } # These next files weren't plaintext-printed, so link them. if (scalar(@justlink) > 0) { print BROWSER "
"; print BROWSER "Download Attachments:
\n"; foreach (@justlink) { my ($part,$file) = @{$_}; print BROWSER "   "; print BROWSER $part->{'desc'} . " - "; $file =~ s,^.*/,,; print BROWSER "$file (".$part->{'type'}.") [" . $part->{'size'} . "]
\n"; } } } #}}} sub mktemp { #{{{ my $str; do { $str ="mail.out."; for (my $x = 0; $x < 5; $x++) { $str .= int(rand(10)); } } while (-e "/tmp/$str"); return $str; } #}}} sub check_open_browser { #{{{ my $files = shift; if ($VBROWSER !~ m/^[\|>]/) { print STERR "Now running browser!\n"; $BROWSER =~ s/>\s+//; if ($VBROWSER =~ /^links/) { system("mv $BROWSER $BROWSER.html"); $BROWSER .=".html"; } if ( ($SCREEN_POLICY == 2) || ( ($SCREEN_STY && $SCREEN_POLICY) ) ) { my $screen = "screen "; $screen .= " -X screen" if ($SCREEN_STY); $screen .= " sh -c \"" if ($SCREEN_STY);; $screen .= " $VBROWSER $BROWSER"; $screen .= " && rm " . join(" ", @${files}) . "\"" if ($SCREEN_STY && ref($files) eq 'ARRAY'); #print STDERR "Invoking screen as: $screen\n"; system("$screen"); system("rm $BROWSER") unless ($SCREEN_STY); } else { system("$VBROWSER $BROWSER"); system("rm $BROWSER"); } } } #}}}