root/10kz/shell/perl.jm3

#!/usr/bin/perl

use CGI qw/:standard/;

# for gpg stderr mangling:
use IPC::Open3;
use Symbol qw(gensym);
use IO::File;

$debug = 1;
if( $debug ) {
        open LOG, ">/tmp/10kz.log" or print "\n\nCouldn't open logfile for writing: $!\n";
        print LOG "*** starting new crypto session: ***\n";
        my $pwd = `pwd`;
        print LOG "pwd: $pwd\n";
}

# FIXME: ugh, unless we perl-ify the other shell scripts, we need a way to share the configure.sh info between perl + shell
my $bin = "/usr/local/bin"; 
my $KEY_HOME = "/Users/jmanoogi/.gnupg";

print header('text/plain');
        
if (param()) {
        my $mode  = param('mode');

        my $key_id     = param('key_id');
        my $passphrase = param('passphrase');
        my $recipients = param('recipients');
        # FIXME: refactor: this is mis-named; since decrypt() expects the ciphertext to come in here, should be renamed as input text
        my $plaintext  = param('plaintext');

        $key_id =~      s/([\&;\`'\\\|"*?~<>^\(\)\[\]\{\}\$\n\r])/\\$1/g;
        $passphrase =~  s/([\&;\`'\\\|"*?~<>^\(\)\[\]\{\}\$\n\r])/\\$1/g;

        # don't shell-encode the plaintext (it will be stored in a file)
        $recipients = parse_recips( $recipients );
        $recipients =~  s/([\&;\`'\\\|"*?~<>^\(\)\[\]\{\}\$\n\r])/\\$1/g;
        $plaintext  =~ s/__PLUS__/+/g;
        my $pt = "/tmp/plaintext";

        my $default_ops = "--no-tty "
                . " --no-permission-warning --load-extension idea --homedir $KEY_HOME";
        my $recips = "$recipients" . ($key_id ? " -r $key_id --default-key $key_id " : "");

        my $sign_cmd    = "echo '$passphrase' | $bin/gpg $default_ops --command-fd 0 --passphrase-fd 0 --armor --clearsign $pt";
        my $verify_cmd    = "$bin/gpg $default_ops --verify $pt";
        my $decrypt_cmd = "echo '$passphrase' | $bin/gpg $default_ops --command-fd 0 --passphrase-fd 0 --ignore-crc-error --output $pt.asc --decrypt $pt";
        my $cmd =                              "$bin/gpg $default_ops $recips --armor --encrypt $pt";

        if( $mode eq "verify" ) { 
                $cmd = $verify_cmd; 
                # replace gmail-rewritten links
                print LOG "rewriting gmail-munged links\n";
                $plaintext =~ s/<a onclick="return top\.js\.[^>]*>(http[^<]*)<\/a>/$1/g;

        }
        if( $mode eq "sign" ) { $cmd = $sign_cmd; }
        if( $mode eq "decrypt" ) { $cmd = $decrypt_cmd; }
        if( $debug == 1 ) { print LOG "\$cmd: $cmd\n"; }
        if( $debug == 1 ) { print LOG "\$plaintext: $plaintext\n"; }

        open PLAINTEXT, ">$pt" or print "\n\nCouldn't open '$pt' to write: $!\n";
        print PLAINTEXT $plaintext;
        close PLAINTEXT; 

        # FIXME: need to tee off stderr here so we can capture and optionally grovel through GPG's egregiously bad error messages
        # for now, we're just suppressing them
        my $out; # = `$cmd &> /dev/null`;
        my $err;

        local *CATCHOUT = IO::File->new_tmpfile;
        local *CATCHERR = IO::File->new_tmpfile;
        my $pid = open3(gensym, ">&CATCHOUT", ">&CATCHERR", "$cmd");
        waitpid($pid, 0);
        seek $_, 0, 0 for \*CATCHOUT, \*CATCHERR;
        $out = $err = "";
        while( <CATCHOUT> ) {
                $out .= $_;
        }
        while( <CATCHERR> ) {
                $err .= $_;
        }

        if( $debug == 1 ) { 
                print LOG "err: $err\n"; 
                print LOG "out: $out\n"; 
        }
        
        if( -f "$pt.asc" && $mode ne "verify" ) {
                $data = `cat $pt.asc`;
                print "<?xml version='1.0'?>\n<data>$data</data>";
        } elsif( $mode eq "verify" ) {
                print "<?xml version='1.0'?>\n<data>$err\n\n$plaintext</data>";
        } else {
                print "<?xml version='1.0'?>\n<data><error>mode: $mode\n Source: $plaintext\n$err\nCommand:\n$cmd</error></data>";
        }

        # cache these for post-hoc analysis
        if( $debug == 1 ) {
                if( -f $pt ) {
                        `cp $pt /tmp/plaintext.bak`;
                }
                if( -f "$pt.asc" ) {
                        `cp $pt.asc /tmp/plaintext.asc.bak`;
                }
        }
        unlink $pt;
        unlink "$pt.asc";

        if( $debug ) {
                #print LOG "Your passphrase is: $passphrase, key_id is: $key_id, the recipients are: $recipients, The plaintext is: $plaintext\n";
        }

} else {

        print "<error>No Input: Make sure you are passing a minimum of: key_id, recipients, plaintext (and passphrase, if you're signing)</error>";

}

sub parse_recips {
        my $r = $_[-1];
        $r =~ s:^.*?<:-r :g;
        $r =~ s:>,.+?<: -r :g;
        $r =~ s:[<>]::g;
        $r =~ s:,::g;
        return "$r";
}