#!perl -w use strict; use WildcardArgs; use IO::File; my $sourcedir= "$ENV{HOME}/Library/Mail"; my $targetdir= "/Volumes/secure/local/pgp"; mkpath("$targetdir/tmp"); handlearg($sourcedir, \&processmail, dirfilter=>sub { $_[0]=~/\/IMAP-/ || $_[0] =~ '\/Mailboxes' }, recurse=>1 ); sub createoutputfilename { my $fn= shift; my $ofn= $targetdir.substr($fn, length($sourcedir)); my $ofd= $ofn; $ofd =~ s{/[^/]+$}{}; mkpath($ofd); return $ofn; } sub processmail { my $fn= shift; my $ofn= createoutputfilename($fn); return if -e $ofn; printf("%s\n", substr($fn, length($sourcedir)+1)); if ($fn =~ m{/Attachments/} || $fn =~ m{/Messages/.*\.emlxpart}) { handle_attachment($fn, $ofn); } elsif ($fn =~ m{/Messages/}) { handle_message($fn, $ofn); } else { printf("ignoring $fn\n"); } } sub handle_attachment { my ($fn, $ofn)= @_; my $fh= IO::File->new($fn, "r"); if (!$fh) { warn "$fn: $!\n"; return; } binmode $fh; local $/; my $body= <$fh>; $fh->close(); if ($body =~ /---BEGIN PGP MESSAGE---/) { my $ofh= IO::File->new($ofn, "w") or die "$ofn: $!\n"; binmode $ofh; decrypt_asc_body($ofh, $body); $ofh->close(); } elsif (isbinary_pgp($body)) { my $ofh= IO::File->new($ofn, "w") or die "$ofn: $!\n"; binmode $ofh; decrypt_bin($ofh, $body); $ofh->close(); } else { symlink($fn, $ofn); } } sub handle_message { my ($fn, $ofn)= @_; my $fh= IO::File->new($fn, "r"); if (!$fh) { warn "$fn: $!\n"; return; } binmode $fh; # format: \n{\n\n} my $size= <$fh>; if ($size !~ /^\d+\s+$/) { warn "invalid message format $fn: invalid size $size\n"; return; } my $message; $fh->read($message, $size); my $plistxml; $fh->read($plistxml, (-s $fh)-$fh->tell()); $fh->close(); my $plist= decodeplist($plistxml); if ($message !~ /^(.*?)\n\n(.*)$/s) { warn "invalid message format $fn: no body\n"; return; } my ($headers, $body)= ($1, $2); $headers =~ s/\n\s+/ /gs; # remove linecontinuations my @headers= split /\n/, $headers; if ($body =~ /---BEGIN PGP MESSAGE---/) { my $ofh= IO::File->new($ofn, "w") or die "$ofn: $!\n"; binmode $ofh; $ofh->print($headers); $ofh->print("\n\n"); decrypt_asc_body($ofh, $body); $ofh->close(); } else { symlink($fn, $ofn); } } sub decrypt_bin { my $ofh= $_[0]; my $level = $_[2]; my ($decrypted, $keys)= gpgstring($_[1]); $ofh->printf("-----BEGIN PGP DECRYPTED MESSAGE(%d)-----\n", $level); $ofh->print($keys); $ofh->print("-----\n"); if (!defined $decrypted) { $ofh->print("-----COULD NOT DECODE PGP MESSAGE-----\n"); $ofh->print($_[1]); $ofh->print("\n"); print "$keys\n"; } elsif ($decrypted =~ /---BEGIN PGP MESSAGE---/) { decrypt_asc_body($ofh, $decrypted, $level+1); } else { $ofh->print($decrypted); } $ofh->printf("-----END PGP DECRYPTED MESSAGE(%d)-----\n", $level); } sub decrypt_asc_body { my ($ofh, $body, $level)= @_; $level ||= 0; my $ofs=0; while ($body =~ /-----BEGIN PGP MESSAGE-----.*?-----END PGP MESSAGE-----/gs) { my $pos= pos($body); my $l= length($&); # print text preceeding pgp block $ofh->print(substr($body, $ofs, $pos-$l-$ofs)); my $pgpdata= substr($body, $pos-$l, $l); # fix mime encoded msgs if ($pgpdata =~ /=3D..../) { $pgpdata =~ s/=([0-9A-F][0-9A-F])/chr(hex($1))/gem; } $pgpdata =~ s/^\s+$//gm; # fix html encoded msgs $pgpdata =~ s/ *
$//gm; $pgpdata =~ s/ //gm; # fix quoted messages $pgpdata =~ s/^>+ //gm; $pgpdata =~ s/^>+$//gm; # fix empty lines $pgpdata =~ s/\n\n+/\n/gs; # fix incorrect (line wrapped) pgp headers $pgpdata =~ s/:\s*\nwww/: www/s; # reinsert header separator $pgpdata =~ s/^([a-zA-Z0-9_-]+: [^\n]+)\n([^:\n]*)\n/$1\n\n$2\n/sm; decrypt_bin($ofh, $pgpdata, $level); $ofs= $pos; } $ofh->print(substr($body, $ofs)); } sub isbinary_pgp { my $c= ord(substr($_[0], 0, 1)); return ($c==0x84 || $c==0x85 || $c==0xa8 || $c==0xc1); } sub gpgstring { my $srcfn= "$targetdir/tmp/gpg.src"; my $dstfn= "$targetdir/tmp/gpg.dst"; my $logfn= "$targetdir/tmp/gpg.log"; my $errfn= "$targetdir/tmp/gpg.err"; savetofile($srcfn, $_[0]); # first clean up old files if (-f $dstfn) { unlink($dstfn) || die "unlink:$dstfn: $!\n"; } if (-f $logfn) { unlink($logfn) || die "unlink:$logfn: $!\n"; } if (-f $errfn) { unlink($errfn) || die "unlink:$errfn: $!\n"; } my $res= gpg($srcfn, $dstfn, $errfn, $logfn); my $decrypted= loadfromfile($dstfn); my $keys= loadfromfile($errfn); return ($decrypted, $keys); } sub savetofile { my $h= IO::File->new($_[0], "w") || die "save: $_[0]: $!\n"; binmode $h; $h->print($_[1]); $h->close(); } sub loadfromfile { my ($fn)= @_; my $h= IO::File->new($fn, "r") || return; binmode $h; local $/; my $data= <$h>; $h->close(); return $data; } sub gpg { my ($srcfn, $dstfn, $errfn, $logfn)= @_; my $cmdline= sprintf("gpg2 -o \"%s\" \"%s\" 2>> \"%s\" 1>> \"%s\"", $dstfn, $srcfn, $errfn, $logfn); return system($cmdline); } sub decodeplist { my $xml= shift; $xml =~ s/\b\s*\n\s*\b//gs; $xml =~ s/(.*?)<\/key>\s*\n\s*/squote(unescape($1))."=>"/ges; $xml =~ s/(.*?)<\/string>/dquote(unescape($1)).","/ge; $xml =~ s/(.*?)<\/integer>/$1,/g; $xml =~ s/(.*?)<\/date>/date("$1"),/g; $xml =~ s/(.*?)<\/data>/sprintf("hex(\"%s\"),",unpack('H*',decode_base64($1)))/ge; $xml =~ s//{/g; $xml =~ s/<\/dict>/},/g; $xml =~ s//{},/g; $xml =~ s//[/g; $xml =~ s/<\/array>/],/g; $xml =~ s//[],/g; my $dict= eval { $xml }; if ($@) { die $@; } } sub squote { my $txt=shift; $txt =~ s/['\\]/\\$&/g; $txt =~ s/\n/\\n/g; $txt =~ s/\r/\\r/g; $txt =~ s/\t/\\t/g; $txt =~ s/\0/\\0/g; return ($txt =~ /^\w+$/) ? $txt : "'$txt'"; } sub dquote { my $txt=shift; $txt =~ s/["\\]/\\$&/g; $txt =~ s/\n/\\n/g; $txt =~ s/\r/\\r/g; $txt =~ s/\t/\\t/g; $txt =~ s/\0/\\0/g; return "\"$txt\""; } sub unescape { my $txt=shift; $txt=~s/<//g; $txt=~s/"/"/g; $txt=~s/&#(\d\w+);/chr(eval($1))/g; $txt=~s/&/&/g; return $txt; } sub mkpath { my $dir= shift; return if -d $dir; $dir =~ s{/$}{}; my @path= split /\//, $dir; $dir= ""; for my $d (@path) { $dir .= "/$d"; if (!-d $dir) { mkdir $dir || die "$dir: $!\n"; } } }