The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# -*- perl -*-
use Test::More tests => 8;
use Test::Exception;
use File::Spec;

# Create the following certificate tree:
#
# + The root CA (self-signed)
# |
# `-+ An intermediate CA #1
#   |
#   `-+ An intermediate CA #2
#     |
#     `-- An user
#
# Then do the following:
#
#  1. Make a mail signed by an user private key and let it contain
#     certificates of two intermediate CAs.
#
#  2. Verify the mail with only the root CA certificate and its
#     key. Can we prove the mail is actually trustable?

my $DEVNULL = File::Spec->devnull();
my $OPENSSL = do {
    my $tmp = `which openssl 2>$DEVNULL`;
    if ($? == 0) {
        chomp $tmp;
        $tmp;
    }
    else {
        BAIL_OUT("No openssl(1) were found in the PATH.");
    }
};
diag "Using `$OPENSSL'...\n";

# Create the root CA.
do {
    do {
        open my $fh, '>', "root.$$.cfg" or die $!;
        print {$fh} <<'EOF';
[ req ]
distinguished_name     = req_distinguished_name
attributes             = req_attributes
req_extensions         = v3_ca
prompt                 = no
[ req_distinguished_name ]
C                      = JP
ST                     = Some-State
L                      = Some-Locality
O                      = Crypt::SMIME
OU                     = The Root CA
CN                     = ROOT
[ req_attributes ]
[ v3_ca ]
basicConstraints       = CA:true
EOF
        close $fh;
    };
    system(qq{$OPENSSL genrsa > root.$$.key 2>$DEVNULL}) and die $!;
    system(qq{$OPENSSL req -new -key root.$$.key -out root.$$.csr -config root.$$.cfg 2>&1 >$DEVNULL}) and die $!;
    system(qq{$OPENSSL x509 -in root.$$.csr -out root.$$.crt -req -signkey root.$$.key -set_serial 1 -extfile root.$$.cfg -extensions v3_ca 2>&1 >$DEVNULL}) and die;
};

# Create an intermediate CA #1.
do {
    do {
        open my $fh, '>', "intermed-1.$$.cfg" or die $!;
        print {$fh} <<'EOF';
[ req ]
distinguished_name     = req_distinguished_name
attributes             = req_attributes
req_extensions         = v3_ca
prompt                 = no
[ req_distinguished_name ]
C                      = JP
ST                     = Some-State
L                      = Some-Locality
O                      = Crypt::SMIME
OU                     = An intermediate CA No.1
CN                     = INTERMED-1
[ req_attributes ]
[ v3_ca ]
basicConstraints       = CA:true
EOF
        close $fh;
    };
    system(qq{$OPENSSL genrsa > intermed-1.$$.key 2>$DEVNULL}) and die $!;
    system(qq{$OPENSSL req -new -key intermed-1.$$.key -out intermed-1.$$.csr -config intermed-1.$$.cfg 2>&1 >$DEVNULL}) and die $!;
    system(qq{$OPENSSL x509 -in intermed-1.$$.csr -out intermed-1.$$.crt -req -CA root.$$.crt -CAkey root.$$.key -set_serial 1 -extfile root.$$.cfg -extensions v3_ca 2>&1 >$DEVNULL}) and die;
};

# Create an intermediate CA #2.
do {
    do {
        open my $fh, '>', "intermed-2.$$.cfg" or die $!;
        print {$fh} <<'EOF';
[ req ]
distinguished_name     = req_distinguished_name
attributes             = req_attributes
req_extensions         = v3_ca
prompt                 = no
[ req_distinguished_name ]
C                      = JP
ST                     = Some-State
L                      = Some-Locality
O                      = Crypt::SMIME
OU                     = An intermediate CA No.2
CN                     = INTERMED-2
[ req_attributes ]
[ v3_ca ]
basicConstraints       = CA:true
EOF
        close $fh;
    };
    system(qq{$OPENSSL genrsa > intermed-2.$$.key 2>$DEVNULL}) and die $!;
    system(qq{$OPENSSL req -new -key intermed-2.$$.key -out intermed-2.$$.csr -config intermed-2.$$.cfg 2>&1 >$DEVNULL}) and die $!;
    system(qq{$OPENSSL x509 -in intermed-2.$$.csr -out intermed-2.$$.crt -req -CA intermed-1.$$.crt -CAkey intermed-1.$$.key -set_serial 1 -extfile root.$$.cfg -extensions v3_ca 2>&1 >$DEVNULL}) and die;
};

# Create an user.
do {
    do {
        open my $fh, '>', "user.$$.cfg" or die $!;
        print {$fh} <<'EOF';
[ req ]
distinguished_name     = req_distinguished_name
attributes             = req_attributes
prompt                 = no
[ req_distinguished_name ]
C                      = JP
ST                     = Some-State
L                      = Some-Locality
O                      = Crypt::SMIME
OU                     = An user
CN                     = USER
[ req_attributes ]
EOF
        close $fh;
    };
    system(qq{$OPENSSL genrsa > user.$$.key 2>$DEVNULL}) and die $!;
    system(qq{$OPENSSL req -new -key user.$$.key -out user.$$.csr -config user.$$.cfg 2>&1 >$DEVNULL}) and die $!;
    system(qq{$OPENSSL x509 -in user.$$.csr -out user.$$.crt -req -CA intermed-2.$$.crt -CAkey intermed-2.$$.key -set_serial 1 2>&1 >$DEVNULL}) and die;
};

# Delete temporary files later.
END {
    foreach my $who (qw(root intermed-1 intermed-2 user)) {
        unlink "$who.$$.key", "$who.$$.cfg", "$who.$$.csr", "$who.$$.crt";
    }
}

sub key {
    my $who = shift;
    local $/;
    open my $fh, '<', "$who.$$.key" or die $!;
    return scalar <$fh>;
};

sub crt {
    my $who = shift;
    local $/;
    open my $fh, '<', "$who.$$.crt" or die $!;
    return 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 $verified = q{Subject: Crypt::SMIME test

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

# -----------------------------------------------------------------------------

BEGIN {
    use_ok('Crypt::SMIME');
}

my $signed = do {
    my $SMIME;
    lives_ok { $SMIME = Crypt::SMIME->new } 'new';
    lives_ok { $SMIME->setPrivateKey(key('user'), crt('user')) } 'setPrivateKey(USER)';
    lives_ok { $SMIME->setPublicKey(crt('intermed-1')."\n".crt('intermed-2')) } 'setPublicKey(INTERMED-1 & INTERMED-2)';
    my $tmp;
    lives_ok { $tmp = $SMIME->sign($plain) } 'sign($plain)';
    $tmp;
};

do {
    my $SMIME = Crypt::SMIME->new;
    lives_ok { $SMIME->setPublicKey(crt('root')) } 'setPublicKey(ROOT)';
    my $checked;
    lives_ok { $checked = $SMIME->check($signed) } 'check';
    is($checked, $verified, '$verified eq check(sign($plain))');
};