[Rt-commit] r6726 - in rt/branches/3.7-EXPERIMENTAL: .

ruz at bestpractical.com ruz at bestpractical.com
Tue Jan 9 15:55:57 EST 2007


Author: ruz
Date: Tue Jan  9 15:55:57 2007
New Revision: 6726

Added:
   rt/branches/3.7-EXPERIMENTAL/lib/t/regression/06-crypt-gnupg.t
Modified:
   rt/branches/3.7-EXPERIMENTAL/   (props changed)

Log:
 r4331 at cubic-pc:  cubic | 2007-01-09 22:03:44 +0300
 * gnupg tests


Added: rt/branches/3.7-EXPERIMENTAL/lib/t/regression/06-crypt-gnupg.t
==============================================================================
--- (empty file)
+++ rt/branches/3.7-EXPERIMENTAL/lib/t/regression/06-crypt-gnupg.t	Tue Jan  9 15:55:57 2007
@@ -0,0 +1,311 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More tests => 84;
+
+use_ok("RT");
+
+RT::LoadConfig();
+RT->Config->Set( LogToScreen => 'debug' );
+use Data::Dumper;
+
+RT::Init();
+
+use GnuPG::Interface;
+
+use File::Spec ();
+use Cwd;
+my $homedir = File::Spec->catdir( cwd(), qw(lib t data crypt-gnupg) );
+mkdir $homedir;
+
+use_ok('RT::Crypt::GnuPG');
+use_ok('MIME::Entity');
+
+RT->Config->Set( 'GnuPG', homedir => $homedir );
+
+diag 'only signing. correct passphrase' if $ENV{'TEST_VERBOSE'};
+{
+    open my $fh, "$homedir/signed_old_style_with_attachment.eml";
+    my $parser = new MIME::Parser;
+    my $entity = $parser->parse( $fh );
+
+    my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
+    is( scalar @parts, 2, 'two protected parts' );
+    is( $parts[1]->{'Type'}, 'signed', "have signed part" );
+    is( $parts[1]->{'Format'}, 'Inline', "inline format" );
+    is( $parts[1]->{'Data'}, $entity->parts(0), "it's first part" );
+
+    is( $parts[0]->{'Type'}, 'signed', "have signed part" );
+    is( $parts[0]->{'Format'}, 'Attachment', "attachment format" );
+    is( $parts[0]->{'Data'}, $entity->parts(1), "data in second part" );
+    is( $parts[0]->{'Signature'}, $entity->parts(2), "file's signature in third part" );
+
+    my @res = RT::Crypt::GnuPG::VerifyDecrypt( Entity => $entity );
+    my @status = RT::Crypt::GnuPG::ParseStatus( $res[0]->{'status'} );
+    is( scalar @status, 1, 'one record');
+    is( $status[0]->{'Operation'}, 'Verify', 'operation is correct');
+    is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
+    is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value');
+}
+
+diag 'only signing. correct passphrase' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
+    ok( $entity, 'signed entity');
+    ok( !$res->{'logger'}, "log is here as well" );
+    my @status = RT::Crypt::GnuPG::ParseStatus( $res->{'status'} );
+    is( scalar @status, 2, 'two records: passphrase, signing');
+    is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
+    is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
+    is( $status[1]->{'Operation'}, 'Sign', 'operation is correct');
+    is( $status[1]->{'Status'}, 'DONE', 'done');
+    is( $status[1]->{'User'}->{'EmailAddress'}, 'rt at example.com', 'correct email');
+
+    ok( $entity->is_multipart, 'signed message is multipart' );
+    is( $entity->parts, 2, 'two parts' );
+
+    my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
+    is( scalar @parts, 1, 'one protected part' );
+    is( $parts[0]->{'Type'}, 'signed', "have signed part" );
+    is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
+    is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
+
+    ($entity, $res) = RT::Crypt::GnuPG::Verify( Entity => $entity );
+    @status = RT::Crypt::GnuPG::ParseStatus( $res->{'status'} );
+    is( scalar @status, 1, 'one record');
+    is( $status[0]->{'Operation'}, 'Verify', 'operation is correct');
+    is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
+    is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value');
+}
+
+diag 'only signing. missing passphrase' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0 );
+    ok(!$entity, "couldn't sign without passphrase");
+    ok( $res->{'error'}, "error is here" );
+    ok( $res->{'logger'}, "log is here as well" );
+    my @status = RT::Crypt::GnuPG::ParseStatus( $res->{'status'} );
+    is( scalar @status, 1, 'one record');
+    is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
+    is( $status[0]->{'Status'}, 'MISSING', 'missing passphrase');
+}
+
+diag 'only signing. wrong passphrase' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'wrong' );
+    ok(!$entity, "couldn't sign with bad passphrase");
+    ok( $res->{'error'}, "error is here" );
+    ok( $res->{'logger'}, "log is here as well" );
+    my @status = RT::Crypt::GnuPG::ParseStatus( $res->{'status'} );
+    is( scalar @status, 1, 'one record');
+    is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
+    is( $status[0]->{'Status'}, 'BAD', 'wrong passphrase');
+}
+
+diag 'encryption only' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        To      => 'rt at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
+    ok( !$res->{'logger'}, "no records in logger" );
+    my @status = RT::Crypt::GnuPG::ParseStatus( $res->{'status'} );
+    is( scalar @status, 1, 'one record');
+    is( $status[0]->{'Operation'}, 'Encrypt', 'operation is correct');
+    is( $status[0]->{'Status'}, 'DONE', 'done');
+
+    ok($entity, 'get an encrypted part');
+
+    my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
+    is( scalar @parts, 1, 'one protected part' );
+    is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
+    is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
+    is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
+}
+
+diag 'encryption only, bad recipient' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        To      => 'keyless at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
+    ok( !$entity, 'no way to encrypt without all keys of recipients');
+    ok( $res->{'logger'}, "errors are in logger" );
+    my @status = RT::Crypt::GnuPG::ParseStatus( $res->{'status'} );
+    is( scalar @status, 1, 'one record');
+    is( $status[0]->{'Keyword'}, 'INV_RECP', 'invalid recipient');
+}
+
+diag 'encryption and signing with combined method' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        To      => 'rt at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Passphrase => 'test' );
+    ok( !$res->{'logger'}, "no records in logger" );
+    my @status = RT::Crypt::GnuPG::ParseStatus( $res->{'status'} );
+    is( scalar @status, 3, 'three records: passphrase, sign and encrypt');
+    is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
+    is( $status[0]->{'Status'}, 'DONE', 'done');
+    is( $status[1]->{'Operation'}, 'Sign', 'operation is correct');
+    is( $status[1]->{'Status'}, 'DONE', 'done');
+    is( $status[2]->{'Operation'}, 'Encrypt', 'operation is correct');
+    is( $status[2]->{'Status'}, 'DONE', 'done');
+
+    ok($entity, 'get an encrypted and signed part');
+
+    my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
+    is( scalar @parts, 1, 'one protected part' );
+    is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
+    is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
+    is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
+}
+
+diag 'encryption and signing with cascading, sign on encrypted' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        To      => 'rt at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
+    ok( $entity, 'get an encrypted entity' );
+    ok( !$res->{'logger'}, "no records in logger" );
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
+    ok( $entity, 'get an signed entity' );
+    ok( !$res->{'logger'}, "no records in logger" );
+
+    my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
+    is( scalar @parts, 2, 'two protected parts' );
+    is( $parts[0]->{'Type'}, 'signed', "have signed part" );
+    is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
+    is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
+    is( $parts[1]->{'Type'}, 'encrypted', "have encrypted part" );
+    is( $parts[1]->{'Format'}, 'RFC3156', "RFC3156 format" );
+    is( $parts[1]->{'Top'}, $entity->parts(0), "it's the same entity" );
+}
+
+diag 'find signed/encrypted part deep inside' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        To      => 'rt at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
+    ok( $entity, 'get an encrypted entity' );
+    ok( !$res->{'logger'}, "no records in logger" );
+    $entity->make_multipart( 'mixed', Force => 1 );
+    $entity->attach(
+        Type => 'text/plain',
+        Data => ['-'x76, 'this is fucking mailing list'],
+    );
+
+    my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
+    is( scalar @parts, 1, 'two protected parts' );
+    is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
+    is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
+    is( $parts[0]->{'Top'}, $entity->parts(0), "it's the same entity" );
+}
+
+diag 'wrong signed/encrypted parts: no protocol' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        To      => 'rt at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
+    ok( $entity, 'get an encrypted entity' );
+    $entity->head->mime_attr( 'Content-Type.protocol' => undef );
+
+    my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
+    is( scalar @parts, 0, 'no protected parts' );
+}
+
+diag 'wrong signed/encrypted parts: not enought parts' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        To      => 'rt at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
+    ok( $entity, 'get an encrypted entity' );
+    $entity->parts([ $entity->parts(0) ]);
+
+    my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
+    is( scalar @parts, 0, 'no protected parts' );
+}
+
+diag 'wrong signed/encrypted parts: wrong proto' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        To      => 'rt at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
+    ok( $entity, 'get an encrypted entity' );
+    $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' );
+
+    my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
+    is( scalar @parts, 0, 'no protected parts' );
+}
+
+diag 'wrong signed/encrypted parts: wrong proto' if $ENV{'TEST_VERBOSE'};
+{
+    my $entity = MIME::Entity->build(
+        From    => 'rt at example.com',
+        To      => 'rt at example.com',
+        Subject => 'test',
+        Data    => ['test'],
+    );
+    my $res;
+    ($entity, $res) = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
+    ok( $entity, 'get an encrypted entity' );
+    $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' );
+
+    my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
+    is( scalar @parts, 0, 'no protected parts' );
+}


More information about the Rt-commit mailing list