[Rt-commit] rt branch, smime, updated. rt-3.8.7-156-g6e96da8

Ruslan Zakirov ruz at bestpractical.com
Sat Feb 6 08:29:52 EST 2010


The branch, smime has been updated
       via  6e96da8ecab0b2e45a225b7b8a5e4059d4258b92 (commit)
       via  6b1030090b867bd52e1230531f72b6418586a75a (commit)
       via  84a00c479a30066d9ace7396ed600a92a7bf8080 (commit)
       via  1af7179d067ab9d62dd5ff0cc57356b273ce51d0 (commit)
       via  44d698cd478e78bc28aafc87f538d06180677230 (commit)
       via  3250e4bf721eaa1ad6a7eae372d0e74aa0e765df (commit)
       via  cd712d910d7c365a768558fea92f461a0ec77b4e (commit)
       via  fd950b68c66d879d2cffd914add5cca9b6b7270e (commit)
       via  51879dee1c101db61f307e52c4ecae85c94cd549 (commit)
       via  2012463104e0a2c02af4ed1d1113407fe7caeed6 (commit)
       via  2c9ac572fd4387237804cbcecf9a40fad1206310 (commit)
      from  7a86519d0c0039b80dc1c57468987136e037dac3 (commit)

Summary of changes:
 lib/RT/Crypt.pm                             |   81 ++++++++-
 lib/RT/Crypt/Base.pm                        |   28 +++
 lib/RT/Crypt/GnuPG.pm                       |   91 +----------
 lib/RT/Crypt/SMIME.pm                       |  245 ++++++++++++++++++++-------
 lib/RT/Interface/Email.pm                   |    2 +-
 lib/RT/Test.pm                              |    5 +-
 share/html/Admin/Elements/ShowKeyInfo       |    8 +-
 share/html/Elements/GnuPG/SignEncryptWidget |    2 +-
 share/html/Ticket/Elements/ShowGnuPGStatus  |    2 +-
 t/mail/gnupg-incoming.t                     |    2 +-
 t/mail/gnupg-realmail.t                     |    2 +-
 t/mail/smime/smime-incoming.t               |   22 +--
 t/mail/smime/smime-outgoing.t               |  166 +++++++++++++------
 t/web/crypt-gnupg.t                         |    8 +-
 t/web/gnupg-outgoing.t                      |    6 +-
 15 files changed, 431 insertions(+), 239 deletions(-)

- Log -----------------------------------------------------------------
commit 2c9ac572fd4387237804cbcecf9a40fad1206310
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Wed Feb 3 22:03:14 2010 +0300

    fix getting keys per protocol

diff --git a/lib/RT/Crypt.pm b/lib/RT/Crypt.pm
index 610aab1..dbce26e 100644
--- a/lib/RT/Crypt.pm
+++ b/lib/RT/Crypt.pm
@@ -217,7 +217,7 @@ sub GetKeysForEncryption {
     my $self = shift;
     my %args = @_%2? (Recipient => @_) : (Protocol => undef, For => undef, @_ );
     my $protocol = delete $args{'Protocol'} || $self->UseForOutgoing;
-    my %res = $self->LoadImplementation( $protocol )->GetKeysForEncryption( @_ );
+    my %res = $self->LoadImplementation( $protocol )->GetKeysForEncryption( %args );
     $res{'Protocol'} = $protocol;
     return %res;
 }
@@ -226,7 +226,7 @@ sub GetKeysForSigning {
     my $self = shift;
     my %args = @_%2? (Signer => @_) : (Protocol => undef, Signer => undef, @_);
     my $protocol = delete $args{'Protocol'} || $self->UseForOutgoing;
-    my %res = $self->LoadImplementation( $protocol )->GetKeysForSigning( @_ );
+    my %res = $self->LoadImplementation( $protocol )->GetKeysForSigning( %args );
     $res{'Protocol'} = $protocol;
     return %res;
 }
@@ -250,7 +250,7 @@ sub GetKeysInfo {
     my $self = shift;
     my %args = @_%2 ? (Key => @_) : ( Protocol => undef, Key => undef, @_ );
     my $protocol = delete $args{'Protocol'} || $self->UseForOutgoing;
-    my %res = $self->LoadImplementation( $protocol )->GetKeysInfo( @_ );
+    my %res = $self->LoadImplementation( $protocol )->GetKeysInfo( %args );
     $res{'Protocol'} = $protocol;
     return %res;
 }

commit 2012463104e0a2c02af4ed1d1113407fe7caeed6
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Sat Feb 6 16:03:41 2010 +0300

    debug log in tmp dir may help debug things

diff --git a/lib/RT/Test.pm b/lib/RT/Test.pm
index a2ae2d8..6d9c0ac 100644
--- a/lib/RT/Test.pm
+++ b/lib/RT/Test.pm
@@ -258,9 +258,6 @@ sub bootstrap_config {
     my $self = shift;
     my %args = @_;
 
-    $tmp{'config'}{'RT'} = File::Spec->catfile(
-        "$tmp{'directory'}", 'RT_SiteConfig.pm'
-    );
     my $config = $self->new_temp_file( config => RT => 'RT_SiteConfig.pm' );
     open my $config_fh, '>', $config
         or die "Couldn't open $config: $!";
@@ -269,6 +266,8 @@ sub bootstrap_config {
 Set( \$WebPort , $port);
 Set( \$WebBaseURL , "http://localhost:\$WebPort");
 Set( \$LogToSyslog , undef);
+Set( \$LogDir,     '$tmp{directory}');
+Set( \$LogToFile , "debug");
 Set( \$LogToScreen , "warning");
 Set( \$MailCommand, 'testfile');
 };

commit 51879dee1c101db61f307e52c4ecae85c94cd549
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Sat Feb 6 16:08:16 2010 +0300

    SignEncrypt should use enabled outgoing protocol

diff --git a/lib/RT/Crypt.pm b/lib/RT/Crypt.pm
index dbce26e..46a0887 100644
--- a/lib/RT/Crypt.pm
+++ b/lib/RT/Crypt.pm
@@ -129,10 +129,8 @@ sub SignEncrypt {
         ];
     }
 
-    my $protocol = delete $args{'Protocol'} || 'GnuPG';
-    my $class = $self->LoadImplementation( $protocol );
-
-    my %res = $class->SignEncrypt( %args );
+    my $protocol = delete $args{'Protocol'} || $self->UseForOutgoing;
+    my %res = $self->LoadImplementation( $protocol )->SignEncrypt( %args );
     $res{'Protocol'} = $protocol;
     return %res;
 }

commit fd950b68c66d879d2cffd914add5cca9b6b7270e
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Sat Feb 6 16:10:57 2010 +0300

    move CheckRecipients into RT::Crypt

diff --git a/lib/RT/Crypt.pm b/lib/RT/Crypt.pm
index 46a0887..62e5352 100644
--- a/lib/RT/Crypt.pm
+++ b/lib/RT/Crypt.pm
@@ -211,6 +211,72 @@ sub UseKeyForEncryption {
     return ();
 } }
 
+sub CheckRecipients {
+    my $self = shift;
+    my @recipients = (@_);
+
+    my ($status, @issues) = (1, ());
+
+    my %seen;
+    foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) {
+        my %res = $self->GetKeysForEncryption( Recipient => $address );
+        if ( $res{'info'} && @{ $res{'info'} } == 1 && $res{'info'}[0]{'TrustLevel'} > 0 ) {
+            # good, one suitable and trusted key 
+            next;
+        }
+        my $user = RT::User->new( $RT::SystemUser );
+        $user->LoadByEmail( $address );
+        # it's possible that we have no User record with the email
+        $user = undef unless $user->id;
+
+        if ( my $fpr = RT::Crypt->UseKeyForEncryption( $address ) ) {
+            if ( $res{'info'} && @{ $res{'info'} } ) {
+                next if
+                    grep lc $_->{'Fingerprint'} eq lc $fpr,
+                    grep $_->{'TrustLevel'} > 0,
+                    @{ $res{'info'} };
+            }
+
+            $status = 0;
+            my %issue = (
+                EmailAddress => $address,
+                $user? (User => $user) : (),
+                Keys => undef,
+            );
+            $issue{'Message'} = "Selected key either is not trusted or doesn't exist anymore."; #loc
+            push @issues, \%issue;
+            next;
+        }
+
+        my $prefered_key;
+        $prefered_key = $user->PreferredKey if $user;
+        #XXX: prefered key is not yet implemented...
+
+        # classify errors
+        $status = 0;
+        my %issue = (
+            EmailAddress => $address,
+            $user? (User => $user) : (),
+            Keys => undef,
+        );
+
+        unless ( $res{'info'} && @{ $res{'info'} } ) {
+            # no key
+            $issue{'Message'} = "There is no key suitable for encryption."; #loc
+        }
+        elsif ( @{ $res{'info'} } == 1 && !$res{'info'}[0]{'TrustLevel'} ) {
+            # trust is not set
+            $issue{'Message'} = "There is one suitable key, but trust level is not set."; #loc
+        }
+        else {
+            # multiple keys
+            $issue{'Message'} = "There are several keys suitable for encryption."; #loc
+        }
+        push @issues, \%issue;
+    }
+    return ($status, @issues);
+}
+
 sub GetKeysForEncryption {
     my $self = shift;
     my %args = @_%2? (Recipient => @_) : (Protocol => undef, For => undef, @_ );
diff --git a/lib/RT/Crypt/GnuPG.pm b/lib/RT/Crypt/GnuPG.pm
index 1cb9907..3c9b1a3 100644
--- a/lib/RT/Crypt/GnuPG.pm
+++ b/lib/RT/Crypt/GnuPG.pm
@@ -1999,72 +1999,6 @@ sub GetKeysForSigning {
     return $self->GetKeysInfo( Key => delete $args{'Signer'}, %args, Type => 'private' );
 }
 
-sub CheckRecipients {
-    my $self = shift;
-    my @recipients = (@_);
-
-    my ($status, @issues) = (1, ());
-
-    my %seen;
-    foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) {
-        my %res = $self->GetKeysForEncryption( Recipient => $address );
-        if ( $res{'info'} && @{ $res{'info'} } == 1 && $res{'info'}[0]{'TrustLevel'} > 0 ) {
-            # good, one suitable and trusted key 
-            next;
-        }
-        my $user = RT::User->new( $RT::SystemUser );
-        $user->LoadByEmail( $address );
-        # it's possible that we have no User record with the email
-        $user = undef unless $user->id;
-
-        if ( my $fpr = RT::Crypt->UseKeyForEncryption( $address ) ) {
-            if ( $res{'info'} && @{ $res{'info'} } ) {
-                next if
-                    grep lc $_->{'Fingerprint'} eq lc $fpr,
-                    grep $_->{'TrustLevel'} > 0,
-                    @{ $res{'info'} };
-            }
-
-            $status = 0;
-            my %issue = (
-                EmailAddress => $address,
-                $user? (User => $user) : (),
-                Keys => undef,
-            );
-            $issue{'Message'} = "Selected key either is not trusted or doesn't exist anymore."; #loc
-            push @issues, \%issue;
-            next;
-        }
-
-        my $prefered_key;
-        $prefered_key = $user->PreferredKey if $user;
-        #XXX: prefered key is not yet implemented...
-
-        # classify errors
-        $status = 0;
-        my %issue = (
-            EmailAddress => $address,
-            $user? (User => $user) : (),
-            Keys => undef,
-        );
-
-        unless ( $res{'info'} && @{ $res{'info'} } ) {
-            # no key
-            $issue{'Message'} = "There is no key suitable for encryption."; #loc
-        }
-        elsif ( @{ $res{'info'} } == 1 && !$res{'info'}[0]{'TrustLevel'} ) {
-            # trust is not set
-            $issue{'Message'} = "There is one suitable key, but trust level is not set."; #loc
-        }
-        else {
-            # multiple keys
-            $issue{'Message'} = "There are several keys suitable for encryption."; #loc
-        }
-        push @issues, \%issue;
-    }
-    return ($status, @issues);
-}
-
 sub GetKeysInfo {
     my $self = shift;
     my %args = (

commit cd712d910d7c365a768558fea92f461a0ec77b4e
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Sat Feb 6 16:13:24 2010 +0300

    represent basic GetKeysForEncryption in RT::Crypt::Base

diff --git a/lib/RT/Crypt/Base.pm b/lib/RT/Crypt/Base.pm
index 940d907..31f4f30 100644
--- a/lib/RT/Crypt/Base.pm
+++ b/lib/RT/Crypt/Base.pm
@@ -15,6 +15,16 @@ sub CheckIfProtected { return () }
 
 sub FindScatteredParts { return () }
 
+sub GetKeysForEncryption {
+    my $self = shift;
+    my %args = (Recipient => undef, @_);
+    return $self->GetKeysInfo(
+        Key => delete $args{'Recipient'},
+        %args,
+        Type => 'public'
+    );
+}
+
 sub GetKeysInfo {
     return (
         exit_code => 1,
diff --git a/lib/RT/Crypt/GnuPG.pm b/lib/RT/Crypt/GnuPG.pm
index 3c9b1a3..3814b3f 100644
--- a/lib/RT/Crypt/GnuPG.pm
+++ b/lib/RT/Crypt/GnuPG.pm
@@ -1973,8 +1973,7 @@ also listed.
 
 sub GetKeysForEncryption {
     my $self = shift;
-    my %args = (Recipient => undef, @_);
-    my %res = $self->GetKeysInfo( Key => delete $args{'Recipient'}, %args, Type => 'public' );
+    my %res = $self->SUPER::GetKeysForEncryption( @_ );
     return %res if $res{'exit_code'};
     return %res unless $res{'info'};
 

commit 3250e4bf721eaa1ad6a7eae372d0e74aa0e765df
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Sat Feb 6 16:15:09 2010 +0300

    move ParseDate method upper so SMIME can re-use it

diff --git a/lib/RT/Crypt/Base.pm b/lib/RT/Crypt/Base.pm
index 31f4f30..7a26aa0 100644
--- a/lib/RT/Crypt/Base.pm
+++ b/lib/RT/Crypt/Base.pm
@@ -32,4 +32,22 @@ sub GetKeysInfo {
     );
 }
 
+sub ParseDate {
+    my $self = shift;
+    my $value = shift;
+
+    # never
+    return $value unless $value;
+
+    require RT::Date;
+    my $obj = RT::Date->new( $RT::SystemUser );
+    # unix time
+    if ( $value =~ /^\d+$/ ) {
+        $obj->Set( Value => $value );
+    } else {
+        $obj->Set( Format => 'unknown', Value => $value, Timezone => 'utc' );
+    }
+    return $obj;
+}
+
 1;
diff --git a/lib/RT/Crypt/GnuPG.pm b/lib/RT/Crypt/GnuPG.pm
index 3814b3f..03c95e0 100644
--- a/lib/RT/Crypt/GnuPG.pm
+++ b/lib/RT/Crypt/GnuPG.pm
@@ -2095,7 +2095,7 @@ sub ParseKeysInfo {
 
             @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} = 
                 _ConvertTrustChar( $info{'OwnerTrustChar'} );
-            $info{ $_ } = _ParseDate( $info{ $_ } )
+            $info{ $_ } = $self->ParseDate( $info{ $_ } )
                 foreach qw(Created Expire);
             push @res, \%info;
         }
@@ -2108,7 +2108,7 @@ sub ParseKeysInfo {
             ) } = split /:/, $line, 12;
             @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} = 
                 _ConvertTrustChar( $info{'OwnerTrustChar'} );
-            $info{ $_ } = _ParseDate( $info{ $_ } )
+            $info{ $_ } = $self->ParseDate( $info{ $_ } )
                 foreach qw(Created Expire);
             push @res, \%info;
         }
@@ -2116,7 +2116,7 @@ sub ParseKeysInfo {
             my %info;
             @info{ qw(Trust Created Expire String) }
                 = (split /:/, $line)[0,4,5,8];
-            $info{ $_ } = _ParseDate( $info{ $_ } )
+            $info{'Validity'}{ $_ } = $self->ParseDate( $info{ $_ } )
                 foreach qw(Created Expire);
             push @{ $res[-1]{'User'} ||= [] }, \%info;
         }
@@ -2194,22 +2194,6 @@ sub ParseKeysInfo {
     }
 }
 
-sub _ParseDate {
-    my $value = shift;
-    # never
-    return $value unless $value;
-
-    require RT::Date;
-    my $obj = RT::Date->new( $RT::SystemUser );
-    # unix time
-    if ( $value =~ /^\d+$/ ) {
-        $obj->Set( Value => $value );
-    } else {
-        $obj->Set( Format => 'unknown', Value => $value, Timezone => 'utc' );
-    }
-    return $obj;
-}
-
 sub DeleteKey {
     my $self = shift;
     my $key = shift;

commit 44d698cd478e78bc28aafc87f538d06180677230
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Sat Feb 6 16:19:19 2010 +0300

    per UID expiration dates make sense only for GnuPG

diff --git a/share/html/Admin/Elements/ShowKeyInfo b/share/html/Admin/Elements/ShowKeyInfo
index 4f99fb5..6ba6d2b 100644
--- a/share/html/Admin/Elements/ShowKeyInfo
+++ b/share/html/Admin/Elements/ShowKeyInfo
@@ -71,10 +71,12 @@
 <td><% $res{'info'}{'Expire'}? $res{'info'}{'Expire'}->AsString( Time => 0 ): loc('never') %></td></tr>
 
 % foreach my $uinfo( @{ $res{'info'}{'User'} } ) {
-<tr><th><% loc('User (created - expire)') %>:</th>
+<tr><th><% loc('User') %>:</th>
 <td><% $uinfo->{'String'} %>\
-(<% $uinfo->{'Created'}? $uinfo->{'Created'}->AsString( Time => 0 ): loc('never') %> - \
-<% $uinfo->{'Expire'}? $uinfo->{'Expire'}->AsString( Time => 0 ): loc('never') %>)
+% if ( my $validity = $uinfo->{'Validity'} ) {
+(<% $validity->{'Created'}? $validity->{'Created'}->AsString( Time => 0 ): loc('never') %> - \
+<% $validity->{'Expire'}? $validity->{'Expire'}->AsString( Time => 0 ): loc('never') %>)
+% }
 </td></tr>
 % }
 

commit 1af7179d067ab9d62dd5ff0cc57356b273ce51d0
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Sat Feb 6 16:22:11 2010 +0300

    mass Crypt::SMIME improvement
    
    * full certificate info to fetch all data
    * simple keyring implementation
    * encryption and signing should start working

diff --git a/lib/RT/Crypt/SMIME.pm b/lib/RT/Crypt/SMIME.pm
index fd472fc..d68f73b 100644
--- a/lib/RT/Crypt/SMIME.pm
+++ b/lib/RT/Crypt/SMIME.pm
@@ -5,6 +5,7 @@ use warnings;
 package RT::Crypt::SMIME;
 use base 'RT::Crypt::Base';
 
+use RT::Crypt;
 use IPC::Run3 0.036 'run3';
 use String::ShellQuote 'shell_quote';
 use RT::Util 'safe_run_child';
@@ -35,11 +36,11 @@ sub SignEncrypt {
         $args{'Passphrase'} = $self->GetPassphrase( Address => $args{'Signer'} );
     }
 
-    my %res = (exit_code => 0, status => []);
+    my %res = (exit_code => 0, status => '');
 
     my @addresses =
         map $_->address,
-        Email::Address->parse($_),
+        map Email::Address->parse($_),
         grep defined && length,
         map $entity->head->get($_),
         qw(To Cc Bcc);
@@ -47,26 +48,21 @@ sub SignEncrypt {
     my @keys;
     foreach my $address ( @addresses ) {
         $RT::Logger->debug( "Considering encrypting message to " . $address );
-        my $user = RT::User->new( $RT::SystemUser );
-        $user->LoadByEmail( $address );
 
-        my $key;
-        $key = $user->FirstCustomFieldValue('PublicKey') if $user->id;
-        unless ( $key ) {
+        my %key_info = $self->GetKeysInfo( Key => $address );
+        unless ( %key_info ) {
             $res{'exit_code'} = 1;
             my $reason = 'Key not found';
-            push @{ $res{'status'} }, {
-                Operation  => 'RecipientsCheck',
-                Status     => 'ERROR',
-                Message    => "Recipient '$address' is unusable, the reason is '$reason'",
-                Recipient  => $address,
-                Reason     => $reason,
-            };
+            $res{'status'} .=
+                "Operation: RecipientsCheck\nStatus: ERROR\n"
+                ."Message: Recipient '$address' is unusable, the reason is '$reason'\n"
+                ."Recipient: $address\n"
+                ."Reason: $reason\n\n",
+            ;
             next;
         }
 
-        my $expire = $self->GetKeyExpiration( $user );
-        unless ( $expire ) {
+        unless ( $key_info{'info'}[0]{'Expire'} ) {
             # we continue here as it's most probably a problem with the key,
             # so later during encryption we'll get verbose errors
             $RT::Logger->error(
@@ -74,19 +70,18 @@ sub SignEncrypt {
                 .", but we couldn't get expiration date of the key."
             );
         }
-        elsif ( $expire->Diff( time ) < 0 ) {
+        elsif ( $key_info{'info'}[0]{'Expire'}->Diff( time ) < 0 ) {
             $res{'exit_code'} = 1;
             my $reason = 'Key expired';
-            push @{ $res{'status'} }, {
-                Operation  => 'RecipientsCheck',
-                Status     => 'ERROR',
-                Message    => "Recipient '$address' is unusable, the reason is '$reason'",
-                Recipient  => $address,
-                Reason     => $reason,
-            };
+            $res{'status'} .=
+                "Operation: RecipientsCheck\nStatus: ERROR\n"
+                ."Message: Recipient '$address' is unusable, the reason is '$reason'\n"
+                ."Recipient: $address\n"
+                ."Reason: $reason\n\n",
+            ;
             next;
         }
-        push @keys, $key;
+        push @keys, $key_info{'info'}[0]{'Content'};
     }
     return %res if $res{'exit_code'};
 
@@ -284,7 +279,7 @@ sub ParseStatus {
     return () unless $status;
 
     my @status = split /\n\n/, $status;
-    foreach my $block ( @status ) {
+    foreach my $block ( grep length, @status ) {
         chomp $block;
         $block = { map { s/^\s+//; s/\s+$//; $_ } map split(/:/, $_, 2), split /\n+/, $block };
     }
@@ -412,59 +407,185 @@ sub CheckIfProtected {
     return ();
 }
 
-sub KeyExpirationDate {
+sub GetPassphrase {
     my $self = shift;
-    my %args = (@_);
+    my %args = (Address => undef, @_);
+    $args{'Address'} = '' unless defined $args{'Address'};
+    return RT->Config->Get('SMIME')->{'Passphrase'}->{ $args{'Address'} };
+}
 
-    my $user = $args{'User'};
+sub GetKeysInfo {
+    my $self = shift;
+    my %args = (
+        Key   => undef,
+        Type  => 'public',
+        Force => 0,
+        @_
+    );
 
-    my $key_obj = $user->CustomFieldValues('PublicKey')->First;
-    unless ( $key_obj ) {
-        $RT::Logger->warn('User #'. $user->id .' has no SMIME key');
-        return;
+    my $email = $args{'Key'};
+    unless ( $email ) {
+        return (exit_code => 0); # unless $args{'Force'};
     }
 
-    my $attr = $user->FirstAttribute('SMIMEKeyNotAfter');
-    if ( $attr and my $date_str = $attr->Content
-         and $key_obj->LastUpdatedObj->Unix < $attr->LastUpdatedObj->Unix )
-    {
-        my $date = RT::Date->new( $RT::SystemUser );
-        $date->Set( Format => 'unknown', Value => $attr->Content );
-        return $date;
+    my $key = $self->GetKeyContent( %args );
+    return (exit_code => 0) unless $key;
+
+    return $self->GetCertificateInfo( Certificate => $key );
+}
+
+sub GetKeyContent {
+    my $self = shift;
+    my %args = ( Key => undef, @_ );
+
+    my $key;
+    if ( my $file = $self->CheckKeyring( %args ) ) {
+        open my $fh, '<:raw', $file
+            or die "Couldn't open file '$file': $!";
+        $key = do { local $/; readline $fh };
+        close $fh;
+    }
+    else {
+        # XXX: should we use different user??
+        my $user = RT::User->new( $RT::SystemUser );
+        $user->LoadByEmail( $args{'Key'} );
+        unless ( $user->id ) {
+            return (exit_code => 0);
+        }
+
+        $key = $user->FirstCustomFieldValue('SMIME Key');
     }
-    $RT::Logger->debug('Expiration date of SMIME key is not up to date');
+    return $key;
+}
 
-    my $key = $key_obj->Content;
+sub CheckKeyring {
+    my $self = shift;
+    my %args = (
+        Key => undef,
+        @_,
+    );
+    my $keyring = RT->Config->Get('SMIME')->{'Keyring'};
+    return undef unless $keyring;
 
-    my ($buf, $err) = ('', '');
+    my $file = File::Spec->catfile( $keyring, $args{'Key'} .'.pem' );
+    return undef unless -f $file;
+
+    return $file;
+}
+
+sub GetCertificateInfo {
+    my $self = shift;
+    my %args = (
+        Certificate => undef,
+        @_,
+    );
+
+    my %res;
+    my $buf;
     {
-        local $ENV{SMIME_PASS} = '123456';
-        safe_run3(
-            join( ' ', shell_quote( $self->OpenSSLPath, qw(x509 -noout -dates) ) ),
-            \$key, \$buf, \$err
+        local $SIG{CHLD} = 'DEFAULT';
+        my $cmd = join ' ', shell_quote(
+            $self->OpenSSLPath, 'x509',
+            # everything
+            '-text',
+            # plus fingerprint
+            '-fingerprint',
+            # don't print cert itself
+            '-noout',
+            # don't dump signature and pubkey info, header is useless too
+            '-certopt', 'no_pubkey,no_sigdump,no_extensions',
+            # subject and issuer are multiline, long prop names, utf8
+            '-nameopt', 'sep_multiline,lname,utf8',
         );
+        safe_run_child { run3( $cmd, \$args{'Certificate'}, \$buf, \$res{'stderr'} ) };
+        $res{'exit_code'} = $?;
+    }
+    if ( $res{'exit_code'} ) {
+        $res{'message'} = "openssl exitted with error code ". ($? >> 8)
+            ." and error: $res{stderr}";
+        return %res;
     }
-    $RT::Logger->debug( "openssl stderr: " . $err ) if length $err;
 
-    my ($date_str) = ($buf =~ /^notAfter=(.*)$/m);
-    return unless $date_str;
+    my %info = $self->CanonicalizeInfo( $self->ParseCertificateInfo( $buf ) );
+    $info{'Content'} = $args{'Certificate'};
+    $res{'info'} = [\%info];
+    return %res;
+}
+
+sub CanonicalizeInfo {
+    my $self = shift;
+    my %info = @_;
 
-    $RT::Logger->debug( "smime key expiration date is $date_str" );
-    $user->SetAttribute(
-        Name => 'SMIMEKeyNotAfter',
-        Description => 'SMIME key expiration date',
-        Content => $date_str,
+    my %res = (
+        # XXX: trust is not implmented for SMIME
+        TrustLevel => 1,
     );
-    my $date = RT::Date->new( $RT::SystemUser );
-    $date->Set( Format => 'unknown', Value => $date_str );
-    return $date;
+    {
+        my $subject = delete $info{'Certificate'}{'Data'}{'Subject'};
+        $res{'User'} = [{
+            Country => $subject->{'countryName'},
+            StateOrProvince  => $subject->{'stateOrProvinceName'},
+            Organization     => $subject->{'organizationName'},
+            OrganizationUnit => $subject->{'organizationalUnitName'},
+        }];
+        my $email = Email::Address->new( @{$subject}{'commonName', 'emailAddress'} );
+        $res{'User'}[-1]{'String'} = $email->format;
+    }
+    {
+        my $validity = delete $info{'Certificate'}{'Data'}{'Validity'};
+        $res{'Created'} = $self->ParseDate( $validity->{'Not Before'} );
+        $res{'Expire'} = $self->ParseDate( $validity->{'Not After'} );
+    }
+    {
+        $res{'Fingerprint'} = delete $info{'SHA1 Fingerprint'};
+    }
+    %res = (%{$info{'Certificate'}{'Data'}}, %res);
+    return %res;
 }
 
-sub GetPassphrase {
+sub ParseCertificateInfo {
     my $self = shift;
-    my %args = (Address => undef, @_);
-    $args{'Address'} = '' unless defined $args{'Address'};
-    return RT->Config->Get('SMIME')->{'Passphrase'}->{ $args{'Address'} };
+    my $info = shift;
+
+    my @lines = split /\n/, $info;
+
+    my %res;
+    my %prefix = ();
+    my $first_line = 1;
+    my $prev_prefix = '';
+    my $prev_key = '';
+
+    foreach my $line ( @lines ) {
+        # some examples:
+        # Validity # no trailing ':'
+        # Not After : XXXXXX # space before ':'
+        # countryName=RU # '=' as separator
+        my ($prefix, $key, $value) = ($line =~ /^(\s*)(.*?)\s*(?:[:=]\s*(.*?)|)\s*$/);
+        if ( $first_line ) {
+            $prefix{$prefix} = \%res;
+            $first_line = 0;
+        }
+
+        my $put_into = ($prefix{$prefix} ||= $prefix{$prev_prefix}{$prev_key});
+        unless ( $put_into ) {
+            die "Couldn't parse key info: $info";
+        }
+
+        if ( defined $value && length $value ) {
+            $put_into->{$key} = $value;
+        }
+        else {
+            $put_into->{$key} = {};
+        }
+        delete $prefix{$_} foreach
+            grep length($_) > length($prefix),
+            keys %prefix;
+
+        ($prev_prefix, $prev_key) = ($prefix, $key);
+    }
+
+    return %res;
 }
 
+
 1;

commit 84a00c479a30066d9ace7396ed600a92a7bf8080
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Sat Feb 6 16:25:13 2010 +0300

    check proper config option

diff --git a/lib/RT/Interface/Email.pm b/lib/RT/Interface/Email.pm
index 8a32074..398affb 100755
--- a/lib/RT/Interface/Email.pm
+++ b/lib/RT/Interface/Email.pm
@@ -349,7 +349,7 @@ sub SendEmail {
         $TicketObj = $TransactionObj->Object;
     }
 
-    if ( RT->Config->Get('GnuPG')->{'Enable'} ) {
+    if ( RT->Config->Get('Crypt')->{'Enable'} ) {
         my %crypt;
 
         my $attachment;

commit 6b1030090b867bd52e1230531f72b6418586a75a
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Sat Feb 6 16:26:50 2010 +0300

    switch to new APIs

diff --git a/lib/RT/Crypt.pm b/lib/RT/Crypt.pm
index 62e5352..347b6cd 100644
--- a/lib/RT/Crypt.pm
+++ b/lib/RT/Crypt.pm
@@ -172,7 +172,8 @@ sub ParseStatus {
         Status   => '',
         @_
     );
-    return $self->LoadImplementation( $args{'Protocol'} )->ParseStatus( $args{'Status'} );
+    return $self->LoadImplementation( $args{'Protocol'} )
+        ->ParseStatus( $args{'Status'} );
 }
 
 =head2 UseKeyForSigning
diff --git a/share/html/Elements/GnuPG/SignEncryptWidget b/share/html/Elements/GnuPG/SignEncryptWidget
index f3c2b1d..e51ec1d 100644
--- a/share/html/Elements/GnuPG/SignEncryptWidget
+++ b/share/html/Elements/GnuPG/SignEncryptWidget
@@ -172,7 +172,7 @@ if ( $self->{'Encrypt'} ) {
         keys %$self
     );
 
-    my ($status, @issues) = RT::Crypt::GnuPG->CheckRecipients( @recipients );
+    my ($status, @issues) = RT::Crypt->CheckRecipients( @recipients );
     push @{ $self->{'GnuPGRecipientsKeyIssues'} ||= [] }, @issues;
     $checks_failure = 1 unless $status;
 }
diff --git a/share/html/Ticket/Elements/ShowGnuPGStatus b/share/html/Ticket/Elements/ShowGnuPGStatus
index 7a81de0..ef74632 100644
--- a/share/html/Ticket/Elements/ShowGnuPGStatus
+++ b/share/html/Ticket/Elements/ShowGnuPGStatus
@@ -116,7 +116,7 @@ my $reverify_cb = sub {
 
         $top->DelHeader('X-RT-GnuPG-Status');
         $top->AddHeader(map { ('X-RT-GnuPG-Status' => $_->{'status'} ) } @res);
-        $top->SetHeader('X-RT-Privacy' => 'PGP' );
+        $top->SetHeader('X-RT-Privacy' => 'GnuPG' );
         $top->DelHeader('X-RT-Incoming-Signature');
 
         my @status = RT::Crypt->ParseStatus(

commit 6e96da8ecab0b2e45a225b7b8a5e4059d4258b92
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date:   Sat Feb 6 16:28:32 2010 +0300

    update tests

diff --git a/t/mail/gnupg-incoming.t b/t/mail/gnupg-incoming.t
index 44f48df..2ed01fd 100644
--- a/t/mail/gnupg-incoming.t
+++ b/t/mail/gnupg-incoming.t
@@ -201,7 +201,7 @@ RT::Test->close_mailgate_ok($mail);
         'recorded incoming mail that is encrypted'
     );
     is( $msg->GetHeader('X-RT-Privacy'),
-        'PGP',
+        'GnuPG',
         'recorded incoming mail that is encrypted'
     );
     like( $attach->Content, qr'orz');
diff --git a/t/mail/gnupg-realmail.t b/t/mail/gnupg-realmail.t
index de1d958..07a256c 100644
--- a/t/mail/gnupg-realmail.t
+++ b/t/mail/gnupg-realmail.t
@@ -96,7 +96,7 @@ sub email_ok {
     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 
     is( $msg->GetHeader('X-RT-Privacy'),
-        'PGP',
+        'GnuPG',
         "$eid: recorded incoming mail that is encrypted"
     );
 
diff --git a/t/mail/smime/smime-incoming.t b/t/mail/smime/smime-incoming.t
index ed59ee9..2b3c404 100644
--- a/t/mail/smime/smime-incoming.t
+++ b/t/mail/smime/smime-incoming.t
@@ -8,12 +8,9 @@ my $openssl = RT::Test->find_executable('openssl');
 plan skip_all => 'openssl executable is required.'
     unless $openssl;
 
-use File::Temp;
 use IPC::Run3 'run3';
 use String::ShellQuote 'shell_quote';
 use RT::Tickets;
-use FindBin;
-use Cwd 'abs_path';
 
 # catch any outgoing emails
 RT::Test->set_mail_catcher;
@@ -31,6 +28,7 @@ RT->Config->Set( Crypt =>
     Incoming => ['SMIME'],
     Outgoing => 'SMIME',
 );
+RT->Config->Set( GnuPG => Enable => 0 );
 RT->Config->Set( SMIME =>
     Enable => 1,
     OutgoingMessagesFormat => 'RFC',
@@ -40,22 +38,22 @@ RT->Config->Set( SMIME =>
     OpenSSL => $openssl,
     Keyring => $keyring,
 );
-RT->Config->Set( GnuPG => Enable => 0 );
 
 RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::Crypt' );
 
-RT::Test->import_smime_key('sender at example.com');
-
 my $mails = RT::Test::find_relocatable_path( 'data', 'smime', 'mails' );
 
 my ($url, $m) = RT::Test->started_ok;
+ok $m->login, "logged in";
+
 # configure key for General queue
-$m->get( $url."?user=root;pass=password" );
-$m->content_like(qr/Logout/, 'we did log in');
-$m->get( $url.'/Admin/Queues/');
-$m->follow_link_ok( {text => 'General'} );
-$m->submit_form( form_number => 3,
-		 fields      => { CorrespondAddress => 'sender at example.com' } );
+RT::Test->import_smime_key('sender at example.com');
+my $queue = RT::Test->load_or_create_queue(
+    Name              => 'General',
+    CorrespondAddress => 'sender at example.com',
+    CommentAddress    => 'sender at example.com',
+);
+ok $queue && $queue->id, 'loaded or created queue';
 
 my $mail = RT::Test->open_mailgate_ok($url);
 print $mail <<EOF;
diff --git a/t/mail/smime/smime-outgoing.t b/t/mail/smime/smime-outgoing.t
index 31e6b5b..96c7a9d 100644
--- a/t/mail/smime/smime-outgoing.t
+++ b/t/mail/smime/smime-outgoing.t
@@ -2,73 +2,135 @@
 use strict;
 use warnings;
 
-use Test::More;
-eval 'use RT::Test; 1'
-    or plan skip_all => 'requires 3.7 to run tests.';
+use RT::Test tests => 14;
+
+my $openssl = RT::Test->find_executable('openssl');
+plan skip_all => 'openssl executable is required.'
+    unless $openssl;
 
-plan tests => 10;
 
 use IPC::Run3 'run3';
-use Cwd 'abs_path';
 use RT::Interface::Email;
 
-use_ok('RT::Crypt::SMIME');
+# catch any outgoing emails
+RT::Test->set_mail_catcher;
+
+my $keys = RT::Test::get_abs_relocatable_dir(
+    (File::Spec->updir()) x 2,
+    qw(data smime keys),
+);
 
-RT::Config->Set( 'MailCommand' => 'sendmail'); # we intercept MIME::Entity::send
+my $keyring = RT::Test->new_temp_dir(
+    crypt => smime => 'smime_keyring'
+);
 
-RT->Config->Set( 'OpenSSLPath', '/usr/bin/openssl' );
-RT->Config->Set( 'SMIMEKeys', abs_path('testkeys') );
-RT->Config->Set( 'SMIMEPasswords', {'sender at example.com' => '123456'} );
-RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::SMIME' );
+RT->Config->Set( Crypt =>
+    Enable   => 1,
+    Incoming => ['SMIME'],
+    Outgoing => 'SMIME',
+);
+RT->Config->Set( GnuPG => Enable => 0 );
+RT->Config->Set( SMIME =>
+    Enable => 1,
+    OutgoingMessagesFormat => 'RFC',
+    Passphrase => {
+        'sender at example.com' => '123456',
+    },
+    OpenSSL => $openssl,
+    Keyring => $keyring,
+);
 
-RT::Handle->InsertData('etc/initialdata');
+RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::Crypt' );
 
 my ($url, $m) = RT::Test->started_ok;
-# configure key for General queue
-$m->get( $url."?user=root;pass=password" );
-$m->content_like(qr/Logout/, 'we did log in');
-$m->get( $url.'/Admin/Queues/');
-$m->follow_link_ok( {text => 'General'} );
-$m->submit_form( form_number => 3,
-		 fields      => { CorrespondAddress => 'sender at example.com' } );
-
-my $user = RT::User->new($RT::SystemUser);
-ok($user->LoadByEmail('root at localhost'), "Loaded user 'root'");
-diag $user->Id;
-ok($user->Load('root'), "Loaded user 'root'");
-is( $user->EmailAddress, 'root at localhost' );
-my $val = $user->FirstCustomFieldValue('PublicKey');
-# XXX: delete if it's already there
-unless (defined $val) {
-    local $/;
-    open my $fh, 'testkeys/recipient.crt' or die $!;
-    $user->AddCustomFieldValue( Field => 'PublicKey', Value => <$fh> );
-    $val = $user->FirstCustomFieldValue('PublicKey');
+ok $m->login, "logged in";
+
+my $queue = RT::Test->load_or_create_queue(
+    Name              => 'General',
+    CorrespondAddress => 'sender at example.com',
+    CommentAddress    => 'sender at example.com',
+);
+ok $queue && $queue->id, 'loaded or created queue';
+
+{
+    my ($status, $msg) = $queue->SetEncrypt(1);
+    ok $status, "turn on encyption by default"
+        or diag "error: $msg";
 }
 
-no warnings 'once';
-local *MIME::Entity::send = sub {
-    my $mime_obj = shift;
-    my ($buf, $err);
-    ok(eval { run3([qw(openssl smime -decrypt -passin pass:123456 -inkey testkeys/recipient.key -recip testkeys/recipient.crt)],
-	 \$mime_obj->as_string, \$buf, \$err) }, 'can decrypt');
-    diag $err if $err;
-    diag "Error code: $?" if $?;
-    like($buf, qr'This message has been automatically generated in response');
-    # XXX: check signature as wel
-};
+{
+    my $cf = RT::CustomField->new( $RT::SystemUser );
+    my ($ret, $msg) = $cf->Create(
+        Name       => 'SMIME Key',
+        LookupType => RT::User->new( $RT::SystemUser )->CustomFieldLookupType,
+        Type       => 'TextSingle',
+    );
+    ok($ret, "Custom Field created");
+
+    my $OCF = RT::ObjectCustomField->new( $RT::SystemUser );
+    $OCF->Create(
+        CustomField => $cf->id,
+        ObjectId    => 0,
+    );
+}
+
+my $user;
+{
+    $user = RT::User->new($RT::SystemUser);
+    ok($user->LoadByEmail('root at localhost'), "Loaded user 'root'");
+    ok($user->Load('root'), "Loaded user 'root'");
+    is($user->EmailAddress, 'root at localhost');
+
+    open my $fh, '<:raw', File::Spec->catfile($keys, 'recipient.crt')
+        or die $!;
+    my ($status, $msg) = $user->AddCustomFieldValue(
+        Field => 'SMIME Key',
+        Value => do { local $/; <$fh> },
+    );
+    ok $status, "added user's key" or diag "error: $msg";
+}
 
+RT::Test->clean_caught_mails;
 
-RT::Interface::Email::Gateway( {queue => 1, action => 'correspond',
-			       message => 'From: root at localhost
-To: rt at example.com
+{
+    my $mail = <<END;
+From: root\@localhost
+To: rt\@example.com
 Subject: This is a test of new ticket creation as an unknown user
 
 Blah!
-Foob!'});
+Foob!
+
+END
+
+    my ($status, $id) = RT::Test->send_via_mailgate(
+        $mail, queue => $queue->Name,
+    );
+    is $status, 0, "successfuly executed mailgate";
+
+    my $ticket = RT::Ticket->new($RT::SystemUser);
+    $ticket->Load( $id );
+    ok ($ticket->id, "found ticket ". $ticket->id);
+}
+
+{
+    my @mails = RT::Test->fetch_caught_mails;
+    is scalar @mails, 1, "autoreply";
+
+    my ($buf, $err);
+    local $@;
+    ok(eval {
+        run3([
+            $openssl, qw(smime -decrypt -passin pass:123456),
+            '-inkey', File::Spec->catfile($keys, 'recipient.key'),
+            '-recip', File::Spec->catfile($keys, 'recipient.crt')
+        ], \$mails[0], \$buf, \$err )
+        }, 'can decrypt'
+    );
+    diag $@ if $@;
+    diag $err if $err;
+    diag "Error code: $?" if $?;
+    like($buf, qr'This message has been automatically generated in response');
+}
+
 
-my $tickets = RT::Tickets->new($RT::SystemUser);
-$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
-$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
-my $tick = $tickets->First();
-ok ($tick->Id, "found ticket ".$tick->Id);
diff --git a/t/web/crypt-gnupg.t b/t/web/crypt-gnupg.t
index fb28c88..0297d4f 100644
--- a/t/web/crypt-gnupg.t
+++ b/t/web/crypt-gnupg.t
@@ -126,7 +126,7 @@ MAIL
     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 
     is( $msg->GetHeader('X-RT-Privacy'),
-        'PGP',
+        'GnuPG',
         "RT's outgoing mail has crypto"
     );
     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
@@ -194,7 +194,7 @@ MAIL
     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 
     is( $msg->GetHeader('X-RT-Privacy'),
-        'PGP',
+        'GnuPG',
         "RT's outgoing mail has crypto"
     );
     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
@@ -266,7 +266,7 @@ MAIL
     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 
     is( $msg->GetHeader('X-RT-Privacy'),
-        'PGP',
+        'GnuPG',
         "RT's outgoing mail has crypto"
     );
     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
@@ -332,7 +332,7 @@ MAIL
     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 
     is( $msg->GetHeader('X-RT-Privacy'),
-        'PGP',
+        'GnuPG',
         "RT's outgoing mail has crypto"
     );
     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
diff --git a/t/web/gnupg-outgoing.t b/t/web/gnupg-outgoing.t
index a46833c..8768ec7 100644
--- a/t/web/gnupg-outgoing.t
+++ b/t/web/gnupg-outgoing.t
@@ -188,7 +188,7 @@ foreach my $mail ( map cleanup_headers($_), @{ $mail{'signed'} } ) {
     my $txn = $tick->Transactions->First;
     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 
-    is $msg->GetHeader('X-RT-Privacy'), 'PGP',
+    is $msg->GetHeader('X-RT-Privacy'), 'GnuPG',
         "RT's outgoing mail has crypto";
     is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Not encrypted',
         "RT's outgoing mail looks not encrypted";
@@ -212,7 +212,7 @@ foreach my $mail ( map cleanup_headers($_), @{ $mail{'encrypted'} } ) {
     my $txn = $tick->Transactions->First;
     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 
-    is $msg->GetHeader('X-RT-Privacy'), 'PGP',
+    is $msg->GetHeader('X-RT-Privacy'), 'GnuPG',
         "RT's outgoing mail has crypto";
     is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Success',
         "RT's outgoing mail looks encrypted";
@@ -235,7 +235,7 @@ foreach my $mail ( map cleanup_headers($_), @{ $mail{'signed_encrypted'} } ) {
     my $txn = $tick->Transactions->First;
     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 
-    is $msg->GetHeader('X-RT-Privacy'), 'PGP',
+    is $msg->GetHeader('X-RT-Privacy'), 'GnuPG',
         "RT's outgoing mail has crypto";
     is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Success',
         "RT's outgoing mail looks encrypted";

-----------------------------------------------------------------------


More information about the Rt-commit mailing list