The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -T
use strict;
use warnings;
use ExtUtils::PkgConfig ();
use File::Spec;
use File::Temp qw(tempfile);
use Test::More;
use Test::Exception;
use Config;

BEGIN {
    eval 'use Test::Taint 1.06';
    plan skip_all => 'Test::Taint 1.06 required for testing behaviors on tainted inputs' if $@;
};

BEGIN {
    eval 'use Taint::Util 0.08 qw(untaint)';
    plan skip_all => 'Taint::Util 0.08 required for testing behaviors on tainted inputs' if $@;
};

my ($key, $crt);
do {
    # What can we do other than this...?
    untaint $ENV{PATH};

    my $OPENSSL = do {
        if (defined(my $prefix = ExtUtils::PkgConfig->variable('openssl', 'prefix'))) {
            my $OPENSSL = $prefix . '/bin/openssl' . $Config{exe_ext};
            if (-x $OPENSSL) {
                untaint $OPENSSL;
                diag "Using `$OPENSSL' to generate a keypair";
                $OPENSSL;
            }
            else {
                plan skip_all => q{Executable `openssl' was not found};
            }
        }
        else {
            plan skip_all => q{No package `openssl' found};
        }
    };

    my ($conf_fh, $conf_file) = tempfile(UNLINK => 1);
    print {$conf_fh} <<'EOF';
[ req ]
distinguished_name     = req_distinguished_name
attributes             = req_attributes
prompt                 = no
[ req_distinguished_name ]
C                      = AU
ST                     = Some-State
L                      = Test Locality
O                      = Organization Name
OU                     = Organizational Unit Name
CN                     = Common Name
emailAddress           = test@email.address
[ req_attributes ]
EOF
    close $conf_fh;

    my $DEVNULL = File::Spec->devnull();
    my (undef, $key_file) = tempfile(UNLINK => 1);
    my (undef, $csr_file) = tempfile(UNLINK => 1);
    my (undef, $crt_file) = tempfile(UNLINK => 1);

    system(qq{$OPENSSL genrsa -out $key_file >$DEVNULL 2>&1}) and die $!;
    system(qq{$OPENSSL req -new -key $key_file -out $csr_file -config $conf_file >$DEVNULL 2>&1}) and die $!;
    system(qq{$OPENSSL x509 -in $csr_file -out $crt_file -req -signkey $key_file -set_serial 1 >$DEVNULL 2>&1}) and die $!;

    $key = do {
        local $/;
        open my $fh, '<', $key_file or die $!;
        scalar <$fh>;
    };
    $crt = do {
        local $/;
        open my $fh, '<', $crt_file or die $!;
        scalar <$fh>;
    };
};

my $plain = q{From: alice@example.org
To: bob@example.org
Subject: Crypt::SMIME test

This is a test mail. Please ignore...
};
$plain =~ s/\r?\n|\r/\r\n/g;
my $verify = q{Subject: Crypt::SMIME test

This is a test mail. Please ignore...
};
$verify =~ s/\r?\n|\r/\r\n/g;

# -----------------------------------------------------------------------------
plan tests => 7;
use_ok('Crypt::SMIME');

taint_checking_ok();

subtest 'Untainted' => sub {
    plan tests => 20;

    my $smime = Crypt::SMIME->new();
    untaint $key;
    untaint $crt;
    lives_ok {$smime->setPrivateKey($key, $crt)} 'Set an untainted keypair';
    lives_ok {$smime->setPublicKey($crt)} 'Set un untainted public key';
    lives_ok {$smime->setPublicKey([$crt])} 'Set un untainted public key';

    my $signed;
    untaint $plain;
    lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message';
    untainted_ok $signed, 'The signed message shall be untainted';
    lives_and {
        ok $smime->isSigned($signed)
    } 'isSigned() on an untainted signed message shall succeed';

    my $verified;
    lives_ok {$verified = $smime->check($signed)} 'Verify an untainted message';
    untainted_ok $verified, 'The verified message shall be untainted';

    lives_ok {
        $smime->setAtTime(time);
        $verified = $smime->check($signed);
    } 'Verify an untainted message with untainted parameters';
    untainted_ok $verified, 'The verified message shall still be untainted';

    my $encrypted;
    lives_ok {$encrypted = $smime->encrypt($plain)} 'Encrypt an untainted message';
    untainted_ok $encrypted, 'The encrypted message shall be untainted';
    lives_and {
        ok $smime->isEncrypted($encrypted);
    } 'isEncrypted() on an untainted encrypted message shall succeed';

    my $decrypted;
    lives_ok {$decrypted = $smime->decrypt($encrypted)} 'Decrypt an untainted message';
    untainted_ok $decrypted, 'The decrypted message shall be untainted';
    is $decrypted, $verify, 'The decrypted message matches to the original';

    my $certs_ref;
    lives_ok {$certs_ref = Crypt::SMIME::extractCertificates($signed)} 'Extract certificates from an untainted message';
    untainted_ok_deeply $certs_ref, 'The extracted certificates shall be untainted';

    lives_ok {$certs_ref = Crypt::SMIME::getSigners($signed)} 'Extract signer certificates from an untainted message';
    untainted_ok_deeply $certs_ref, 'The extracted certificates shall be untainted';
};

subtest 'Tainted keypair' => sub {
    plan tests => 18;

    my $smime = Crypt::SMIME->new();
    taint $key;
    taint $crt;
    lives_ok {$smime->setPrivateKey($key, $crt)} 'Set a tainted keypair';
    untaint $crt;
    lives_ok {$smime->setPublicKey($crt)} 'Set un untainted public key';
    lives_ok {$smime->setPublicKey([$crt])} 'Set un untainted public key';
    untainted_ok $smime, 'The context itself is not tainted';

    my $signed;
    untaint $plain;
    lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message';
    tainted_ok $signed, 'The signed message shall be tainted';

    my $verified;
    untaint $signed;
    lives_ok {$verified = $smime->check($signed)} 'Verify an untainted message';
    untainted_ok $verified, 'The verified message shall be untainted';

    my $encrypted;
    lives_ok {$encrypted = $smime->encrypt($plain)} 'Encrypt an untainted message';
    untainted_ok $encrypted, 'The encrypted message shall be untainted';
    lives_and {
        ok $smime->isEncrypted($encrypted);
    } 'isEncrypted() on an untainted encrypted message shall succeed';

    my $decrypted;
    lives_ok {$decrypted = $smime->decrypt($encrypted)} 'Decrypt an untainted message';
    tainted_ok $decrypted, 'The decrypted message shall be tainted';
    is $decrypted, $verify, 'The decrypted message matches to the original';

    my $certs_ref;
    taint $signed;
    lives_ok {$certs_ref = Crypt::SMIME::extractCertificates($signed)} 'Extract certificates from a tainted message';
    tainted_ok_deeply $certs_ref, 'The extracted certificates shall be tainted';

    lives_ok {$certs_ref = Crypt::SMIME::getSigners($signed)} 'Extract signer certificates from an tainted message';
    tainted_ok_deeply $certs_ref, 'The extracted certificates shall be tainted';
};

subtest 'Tainted plain text' => sub {
    plan tests => 13;

    my $smime = Crypt::SMIME->new();
    untaint $key;
    untaint $crt;
    lives_ok {$smime->setPrivateKey($key, $crt)} 'Set an untainted keypair';
    lives_ok {$smime->setPublicKey($crt)} 'Set an untainted public key';
    lives_ok {$smime->setPublicKey([$crt])} 'Set an untainted public key';

    my $signed;
    taint $plain;
    lives_ok {$signed = $smime->sign($plain)} 'Sign a tainted message';
    tainted_ok $signed, 'The signed message shall be tainted';

    my $verified;
    lives_ok {$verified = $smime->check($signed)} 'Verify a tainted message';
    tainted_ok $verified, 'The verified message shall be tainted (because we haven\'t verified the cleanliness of message itself)';

    my $encrypted;
    lives_ok {$encrypted = $smime->encrypt($plain)} 'Encrypt a tainted message';
    tainted_ok $encrypted, 'The encrypted message shall be tainted';
    lives_and {
        ok $smime->isEncrypted($encrypted);
    } 'isEncrypted() on a tainted encrypted message shall succeed';

    my $decrypted;
    lives_ok {$decrypted = $smime->decrypt($encrypted)} 'Decrypt a tainted message';
    tainted_ok $decrypted, 'The decrypted message shall be tainted';
    is $decrypted, $verify, 'The decrypted message matches to the original';
};

subtest 'Tainted public keys' => sub {
    plan tests => 20;

    my $smime = Crypt::SMIME->new();
    untaint $key;
    untaint $crt;
    lives_ok {$smime->setPrivateKey($key, $crt)} 'Set an untainted keypair';
    taint $crt;
    lives_ok {$smime->setPublicKey($crt)} 'Set a tainted public key';
    lives_ok {$smime->setPublicKey([$crt])} 'Set a tainted public key';

    my $signed;
    untaint $plain;
    lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message';
    tainted_ok $signed, 'The signed message shall be tainted (because we signed it with a tainted key)';

    my $verified;
    untaint $signed;
    lives_ok {$verified = $smime->check($signed)} 'Verify an untainted message';
    tainted_ok $verified, 'The verified message shall be tainted (because we verified it with a tainted key)';

    my $encrypted;
    lives_ok {$encrypted = $smime->encrypt($plain)} 'Encrypt an untainted message';
    tainted_ok $encrypted, 'The encrypted message shall be tainted (because we encrypted it with a tainted key)';
    lives_and {
        ok $smime->isEncrypted($encrypted);
    } 'isEncrypted() on a tainted encrypted message shall succeed';

    my $decrypted;
    lives_ok {$decrypted = $smime->decrypt($encrypted)} 'Decrypt a tainted message';
    tainted_ok $decrypted, 'The decrypted message shall be tainted';
    is $decrypted, $verify, 'The decrypted message matches to the original';

    lives_ok {$smime->setPublicKeyStore()} 'Load the default public key store';
    lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message';
    tainted_ok $signed, 'The signed message shall be tainted (because we haven\'t removed our tainted key)';

    lives_ok {$smime->setPublicKey([])} 'Clear the public key store';
    lives_ok {$smime->setPublicKeyStore()} 'Load the default public key store';
    lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message';
    untainted_ok $signed, 'The signed message shall be untainted now';
};

subtest 'Tainted verification parameters' => sub {
    plan tests => 9;

    my $smime = Crypt::SMIME->new();
    untaint $key;
    untaint $crt;
    lives_ok {$smime->setPrivateKey($key, $crt)} 'Set an untainted keypair';
    lives_ok {$smime->setPublicKey($crt)} 'Set an untainted public key';
    lives_ok {$smime->setPublicKey([$crt])} 'Set an untainted public key';

    my $signed;
    untaint $plain;
    lives_ok {$signed = $smime->sign($plain)} 'Sign an untainted message';
    untainted_ok $signed, 'The signed message shall be untainted';

    my $verified;
    lives_ok {$verified = $smime->check($signed)} 'Verify an untainted message';
    untainted_ok $verified, 'The verified message shall be untainted';

    lives_ok {
        my $time = time;
        taint $time;
        $smime->setAtTime($time);
        $verified = $smime->check($signed);
    } 'Verify an untainted message with tainted parameters';
    tainted_ok $verified, 'The verified message shall be tainted';
};