diff options
Diffstat (limited to 'rt/lib/RT/Crypt')
| -rw-r--r-- | rt/lib/RT/Crypt/GnuPG.pm | 1932 | ||||
| -rw-r--r-- | rt/lib/RT/Crypt/GnuPG/CRLFHandle.pm | 70 | ||||
| -rw-r--r-- | rt/lib/RT/Crypt/Role.pm | 254 | ||||
| -rw-r--r-- | rt/lib/RT/Crypt/SMIME.pm | 956 |
4 files changed, 1947 insertions, 1265 deletions
diff --git a/rt/lib/RT/Crypt/GnuPG.pm b/rt/lib/RT/Crypt/GnuPG.pm index 9d97445..ddb91e4 100644 --- a/rt/lib/RT/Crypt/GnuPG.pm +++ b/rt/lib/RT/Crypt/GnuPG.pm @@ -48,34 +48,39 @@ use strict; use warnings; +use 5.010; package RT::Crypt::GnuPG; +use Role::Basic 'with'; +with 'RT::Crypt::Role'; + use IO::Handle; +use File::Which qw(); +use RT::Crypt::GnuPG::CRLFHandle; use GnuPG::Interface; use RT::EmailParser (); use RT::Util 'safe_run_child', 'mime_recommended_filename'; =head1 NAME -RT::Crypt::GnuPG - encrypt/decrypt and sign/verify email messages with the GNU Privacy Guard (GPG) +RT::Crypt::GnuPG - GNU Privacy Guard encryption/decryption/verification/signing =head1 DESCRIPTION -This module provides support for encryption and signing of outgoing messages, -as well as the decryption and verification of incoming email. +This module provides support for encryption and signing of outgoing +messages using GnuPG, as well as the decryption and verification of +incoming email. =head1 CONFIGURATION -You can control the configuration of this subsystem from RT's configuration file. -Some options are available via the web interface, but to enable this functionality, you -MUST start in the configuration file. - -There are two hashes, GnuPG and GnuPGOptions in the configuration file. The -first one controls RT specific options. It enables you to enable/disable facility -or change the format of messages. The second one is a hash with options for the -'gnupg' utility. You can use it to define a keyserver, enable auto-retrieval keys -and set almost any option 'gnupg' supports on your system. +There are two reveant configuration options, both of which are hashes: +C<GnuPG> and C<GnuPGOptions>. The first one controls RT specific +options; it enables you to enable/disable the GPG protocol or change the +format of messages. The second one is a hash with options which are +passed to the C<gnupg> utility. You can use it to define a keyserver, +enable auto-retrieval of keys, or set almost any option which C<gnupg> +supports on your system. =head2 %GnuPG @@ -88,13 +93,13 @@ Set to true value to enable this subsystem: ... other options ... ); -However, note that you B<must> add the 'Auth::GnuPG' email filter to enable +However, note that you B<must> add the 'Auth::Crypt' email filter to enable the handling of incoming encrypted/signed messages. =head3 Format of outgoing messages -Format of outgoing messages can be controlled using the 'OutgoingMessagesFormat' -option in the RT config: +The format of outgoing messages can be controlled using the +C<OutgoingMessagesFormat> option in the RT config: Set( %GnuPG, ... other options ... @@ -110,50 +115,49 @@ or ... other options ... ); -This framework implements two formats of signing and encrypting of email messages: +The two formats for GPG mail are as follows: =over =item RFC -This format is also known as GPG/MIME and described in RFC3156 and RFC1847. -Technique described in these RFCs is well supported by many mail user -agents (MUA), but some MUAs support only inline signatures and encryption, -so it's possible to use inline format (see below). +This format, the default, is also known as GPG/MIME, and is described in +RFC3156 and RFC1847. The technique described in these RFCs is well +supported by many mail user agents (MUA); however, some older MUAs only +support inline signatures and encryption. =item Inline -This format doesn't take advantage of MIME, but some mail clients do -not support GPG/MIME. - -We sign text parts using clear signatures. For each attachments another -attachment with a signature is added with '.sig' extension. +This format doesn't take advantage of MIME, but some mail clients do not +support GPG/MIME. In general, this format is discouraged because modern +mail clients typically do not support it well. -Encryption of text parts is implemented using inline format, other parts -are replaced with attachments with the filename extension '.pgp'. - -This format is discouraged because modern mail clients typically don't support -it well. +Text parts are signed using clear-text signatures. For each attachment, +the signature is attached separately as a file with a '.sig' extension +added to the filename. Encryption of text parts is implemented using +inline format, while other parts are replaced with attachments with the +filename extension '.pgp'. =back -=head3 Encrypting data in the database +=head3 Passphrases -You can allow users to encrypt data in the database using -option C<AllowEncryptDataInDB>. By default it's disabled. -Users must have rights to see and modify tickets to use -this feature. +Passphrases for keys may be set by passing C<Passphrase>. It may be set +to a scalar (to use for all keys), an anonymous function, or a hash (to +look up by address). If the hash is used, the '' key is used as a +default. =head2 %GnuPGOptions -Use this hash to set options of the 'gnupg' program. You can define almost any -option you want which gnupg supports, but never try to set options which -change output format or gnupg's commands, such as --sign (command), ---list-options (option) and other. +Use this hash to set additional options of the 'gnupg' program. The +only options which are diallowed are options which alter the output +format or attempt to run commands; thiss includes C<--sign>, +C<--list-options>, etc. -Some GnuPG options take arguments while others take none. (Such as --use-agent). -For options without specific value use C<undef> as hash value. -To disable these option just comment them out or delete them from the hash +Some GnuPG options take arguments, while others take none. (Such as +C<--use-agent>). For options without specific value use C<undef> as +hash value. To disable these options, you may comment them out or +delete them from the hash: Set(%GnuPGOptions, 'option-with-value' => 'value', @@ -161,62 +165,69 @@ To disable these option just comment them out or delete them from the hash # 'commented-option' => 'value or undef', ); -B<NOTE> that options may contain '-' character and such options B<MUST> be -quoted, otherwise you can see quite cryptic error 'gpg: Invalid option "--0"'. +B<NOTE> that options may contain the '-' character and such options +B<MUST> be quoted, otherwise you will see the quite cryptic error C<gpg: +Invalid option "--0">. + +Common options include: =over =item --homedir -The GnuPG home directory, by default it is set to F</opt/rt4/var/data/gpg>. +The GnuPG home directory where the keyrings are stored; by default it is +set to F</opt/rt4/var/data/gpg>. -You can manage this data with the 'gpg' commandline utility -using the GNUPGHOME environment variable or --homedir option. -Other utilities may be used as well. +You can manage this data with the 'gpg' commandline utility using the +GNUPGHOME environment variable or C<--homedir> option. Other utilities may +be used as well. -In a standard installation, access to this directory should be granted to -the web server user which is running RT's web interface, but if you're running -cronjobs or other utilities that access RT directly via API and may generate -encrypted/signed notifications then the users you execute these scripts under -must have access too. +In a standard installation, access to this directory should be granted +to the web server user which is running RT's web interface; however, if +you are running cronjobs or other utilities that access RT directly via +API, and may generate encrypted/signed notifications, then the users you +execute these scripts under must have access too. -However, granting access to the dir to many users makes your setup less secure, -some features, such as auto-import of keys, may not be available if you do not. -To enable this features and suppress warnings about permissions on -the dir use --no-permission-warning. +Be aware that granting access to the directory to many users makes the +keys less secure -- and some features, such as auto-import of keys, may +not be available if directory permissions are too permissive. To enable +these features and suppress warnings about permissions on the directory, +add the C<--no-permission-warning> option to C<GnuPGOptions>. =item --digest-algo -This option is required in advance when RFC format for outgoing messages is -used. We can not get default algorithm from gpg program so RT uses 'SHA1' by -default. You may want to override it. You can use MD5, SHA1, RIPEMD160, -SHA256 or other, however use `gpg --version` command to get information about -supported algorithms by your gpg. These algorithms are listed as hash-functions. +This option is required when the C<RFC> format for outgoing messages is +used. RT defaults to 'SHA1' by default, but you may wish to override +it. C<gnupng --version> will list the algorithms supported by your +C<gnupg> installation under 'hash functions'; these generally include +MD5, SHA1, RIPEMD160, and SHA256. =item --use-agent -This option lets you use GPG Agent to cache the passphrase of RT's key. See +This option lets you use GPG Agent to cache the passphrase of secret +keys. See L<http://www.gnupg.org/documentation/manuals/gnupg/Invoking-GPG_002dAGENT.html> for information about GPG Agent. =item --passphrase -This option lets you set the passphrase of RT's key directly. This option is -special in that it isn't passed directly to GPG, but is put into a file that -GPG then reads (which is more secure). The downside is that anyone who has read -access to your RT_SiteConfig.pm file can see the passphrase, thus we recommend -the --use-agent option instead. +This option lets you set the passphrase of RT's key directly. This +option is special in that it is not passed directly to GPG; rather, it +is put into a file that GPG then reads (which is more secure). The +downside is that anyone who has read access to your RT_SiteConfig.pm +file can see the passphrase -- thus we recommend the --use-agent option +whenever possible. =item other -Read `man gpg` to get list of all options this program support. +Read C<man gpg> to get list of all options this program supports. =back =head2 Per-queue options Using the web interface it's possible to enable signing and/or encrypting by -default. As an administrative user of RT, open 'Configuration' then 'Queues', +default. As an administrative user of RT, open 'Admin' then 'Queues', and select a queue. On the page you can see information about the queue's keys at the bottom and two checkboxes to choose default actions. @@ -227,99 +238,35 @@ option is disabled. =head2 Handling incoming messages To enable handling of encrypted and signed message in the RT you should add -'Auth::GnuPG' mail plugin. - - Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...); - -See also `perldoc lib/RT/Interface/Email/Auth/GnuPG.pm`. - -=head2 Errors handling - -There are several global templates created in the database by default. RT -uses these templates to send error messages to users or RT's owner. These -templates have 'Error:' or 'Error to RT owner:' prefix in the name. You can -adjust the text of the messages using the web interface. - -Note that C<$TicketObj>, C<$TransactionObj> and other variable usually available -in RT's templates are not available in these templates, but each template -used for errors reporting has set of available data structures you can use to -build better messages. See default templates and descriptions below. +'Auth::Crypt' mail plugin. -As well, you can disable particular notification by deleting content of -a template. You can delete a template too, but in this case you'll see -error messages in the logs when RT can not load template you've deleted. + Set(@MailPlugins, 'Auth::MailFrom', 'Auth::Crypt', ...other filter...); -=head3 Problems with public keys +See also `perldoc lib/RT/Interface/Email/Auth/Crypt.pm`. -Template 'Error: public key' is used to inform the user that RT has problems with -his public key and won't be able to send him encrypted content. There are several -reasons why RT can't use a key. However, the actual reason is not sent to the user, -but sent to RT owner using 'Error to RT owner: public key'. - -The possible reasons: "Not Found", "Ambiguous specification", "Wrong -key usage", "Key revoked", "Key expired", "No CRL known", "CRL too -old", "Policy mismatch", "Not a secret key", "Key not trusted" or -"No specific reason given". +=head2 Encrypting to untrusted keys Due to limitations of GnuPG, it's impossible to encrypt to an untrusted key, unless 'always trust' mode is enabled. -In the 'Error: public key' template there are a few additional variables available: - -=over 4 - -=item $Message - user friendly error message - -=item $Reason - short reason as listed above - -=item $Recipient - recipient's identification - -=item $AddressObj - L<Email::Address> object containing recipient's email address - -=back - -A message can have several invalid recipients, to avoid sending many emails -to the RT owner the system sends one message to the owner, grouped by -recipient. In the 'Error to RT owner: public key' template a C<@BadRecipients> -array is available where each element is a hash reference that describes one -recipient using the same fields as described above. So it's something like: - - @BadRecipients = ( - { Message => '...', Reason => '...', Recipient => '...', ...}, - { Message => '...', Reason => '...', Recipient => '...', ...}, - ... - ) - -=head3 Private key doesn't exist - -Template 'Error: no private key' is used to inform the user that -he sent an encrypted email, but we have no private key to decrypt -it. - -In this template C<$Message> object of L<MIME::Entity> class -available. It's the message RT received. +=head1 FOR DEVELOPERS -=head3 Invalid data +=head2 Documentation and references -Template 'Error: bad GnuPG data' used to inform the user that a -message he sent has invalid data and can not be handled. +=over -There are several reasons for this error, but most of them are data -corruption or absence of expected information. +=item RFC1847 -In this template C<@Messages> array is available and contains list -of error messages. +Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted. +Describes generic MIME security framework, "mulitpart/signed" and +"multipart/encrypted" MIME types. -=head1 FOR DEVELOPERS -=head2 Documentation and references +=item RFC3156 -* RFC1847 - Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted. -Describes generic MIME security framework, "mulitpart/signed" and "multipart/encrypted" -MIME types. +MIME Security with Pretty Good Privacy (PGP), updates RFC2015. -* RFC3156 - MIME Security with Pretty Good Privacy (PGP), -updates RFC2015. +=back =cut @@ -364,65 +311,133 @@ our $RE_FILE_EXTENSIONS = qr/pgp|asc/i; # ... # ); -=head2 SignEncrypt Entity => MIME::Entity, [ Encrypt => 1, Sign => 1, ... ] - -Signs and/or encrypts an email message with GnuPG utility. - -=over +sub CallGnuPG { + my $self = shift; + my %args = ( + Options => undef, + Signer => undef, + Recipients => [], + Passphrase => undef, + + Command => undef, + CommandArgs => [], + + Content => undef, + Handles => {}, + Direct => undef, + Output => undef, + @_ + ); -=item Signing + my %handle = %{$args{Handles}}; + my ($handles, $handle_list) = _make_gpg_handles( %handle ); + $handles->options( $_ )->{'direct'} = 1 + for @{$args{Direct} || [keys %handle] }; + %handle = %$handle_list; -During signing you can pass C<Signer> argument to set key we sign with this option -overrides gnupg's C<default-key> option. If C<Signer> argument is not provided -then address of a message sender is used. + my $content = $args{Content}; + my $command = $args{Command}; -As well you can pass C<Passphrase>, but if value is undefined then L</GetPassphrase> -called to get it. + my %GnuPGOptions = RT->Config->Get('GnuPGOptions'); + my %opt = ( + 'digest-algo' => 'SHA1', + %GnuPGOptions, + %{ $args{Options} || {} }, + ); + my $gnupg = GnuPG::Interface->new; + $gnupg->call( $self->GnuPGPath ); + $gnupg->options->hash_init( + _PrepareGnuPGOptions( %opt ), + ); + $gnupg->options->armor( 1 ); + $gnupg->options->meta_interactive( 0 ); + $gnupg->options->default_key( $args{Signer} ) + if defined $args{Signer}; -=item Encrypting + my %seen; + $gnupg->options->push_recipients( $_ ) for + map { RT::Crypt->UseKeyForEncryption($_) || $_ } + grep { !$seen{ $_ }++ } + @{ $args{Recipients} || [] }; -During encryption you can pass a C<Recipients> array, otherwise C<To>, C<Cc> and -C<Bcc> fields of the message are used to fetch the list. + $args{Passphrase} = $GnuPGOptions{passphrase} + unless defined $args{'Passphrase'}; + $args{Passphrase} = $self->GetPassphrase( Address => $args{Signer} ) + unless defined $args{'Passphrase'}; + $gnupg->passphrase( $args{'Passphrase'} ) + if defined $args{Passphrase}; -=back + eval { + local $SIG{'CHLD'} = 'DEFAULT'; + my $pid = safe_run_child { + if ($command =~ /^--/) { + $gnupg->wrap_call( + handles => $handles, + commands => [$command], + command_args => $args{CommandArgs}, + ); + } else { + $gnupg->$command( + handles => $handles, + command_args => $args{CommandArgs}, + ); + } + }; + { + local $SIG{'PIPE'} = 'IGNORE'; + if (Scalar::Util::blessed($content) and $content->can("print")) { + $content->print( $handle{'stdin'} ); + } elsif (ref($content) eq "SCALAR") { + $handle{'stdin'}->print( ${ $content } ); + } elsif (defined $content) { + $handle{'stdin'}->print( $content ); + } + close $handle{'stdin'} or die "Can't close gnupg input handle: $!"; + $args{Callback}->(%handle) if $args{Callback}; + } + waitpid $pid, 0; + }; + my $err = $@; + if ($args{Output}) { + push @{$args{Output}}, readline $handle{stdout}; + if (not close $handle{stdout}) { + $err ||= "Can't close gnupg output handle: $!"; + } + } -Returns a hash with the following keys: + my %res; + $res{'exit_code'} = $?; -* exit_code -* error -* logger -* status -* message + foreach ( qw(stderr logger status) ) { + $res{$_} = do { local $/ = undef; readline $handle{$_} }; + delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; + if (not close $handle{$_}) { + $err ||= "Can't close gnupg $_ handle: $!"; + } + } + $RT::Logger->debug( $res{'status'} ) if $res{'status'}; + $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; + $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; + if ( $err || $res{'exit_code'} ) { + $res{'message'} = $err? $err : "gpg exited with error code ". ($res{'exit_code'} >> 8); + } -=cut + return %res; +} sub SignEncrypt { - my %args = (@_); + my $self = shift; - my $entity = $args{'Entity'}; - if ( $args{'Sign'} && !defined $args{'Signer'} ) { - my @addresses = Email::Address->parse( Encode::decode("UTF-8",$entity->head->get( 'From' ))); - $args{'Signer'} = UseKeyForSigning() - || $addresses[0]->address; - } - if ( $args{'Encrypt'} && !$args{'Recipients'} ) { - my %seen; - $args{'Recipients'} = [ - grep $_ && !$seen{ $_ }++, map $_->address, - map Email::Address->parse( Encode::decode("UTF-8",$entity->head->get( $_ ) ) ), - qw(To Cc Bcc) - ]; - } - my $format = lc RT->Config->Get('GnuPG')->{'OutgoingMessagesFormat'} || 'RFC'; if ( $format eq 'inline' ) { - return SignEncryptInline( %args ); + return $self->SignEncryptInline( @_ ); } else { - return SignEncryptRFC3156( %args ); + return $self->SignEncryptRFC3156( @_ ); } } sub SignEncryptRFC3156 { + my $self = shift; my %args = ( Entity => undef, @@ -436,28 +451,7 @@ sub SignEncryptRFC3156 { @_ ); - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - - # handling passphrase in GnuPGOptions - $args{'Passphrase'} = delete $opt{'passphrase'} - if !defined $args{'Passphrase'}; - - $opt{'digest-algo'} ||= 'SHA1'; - $opt{'default_key'} = $args{'Signer'} - if $args{'Sign'} && $args{'Signer'}; - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - armor => 1, - meta_interactive => 0, - ); - my $entity = $args{'Entity'}; - - if ( $args{'Sign'} && !defined $args{'Passphrase'} ) { - $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} ); - } - my %res; if ( $args{'Sign'} && !$args{'Encrypt'} ) { # required by RFC3156(Ch. 5) and RFC1847(Ch. 2.1) @@ -469,46 +463,28 @@ sub SignEncryptRFC3156 { ); } } - - my ($handles, $handle_list) = _make_gpg_handles(stdin =>IO::Handle::CRLF->new ); - my %handle = %$handle_list; - - $gnupg->passphrase( $args{'Passphrase'} ); - - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - my $pid = safe_run_child { $gnupg->detach_sign( handles => $handles ) }; - $entity->make_multipart( 'mixed', Force => 1 ); - { - local $SIG{'PIPE'} = 'IGNORE'; - $entity->parts(0)->print( $handle{'stdin'} ); - close $handle{'stdin'}; - } - waitpid $pid, 0; - }; - my $err = $@; - my @signature = readline $handle{'stdout'}; - close $handle{'stdout'}; - - $res{'exit_code'} = $?; - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; - if ( $err || $res{'exit_code'} ) { - $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8); - return %res; - } + $entity->make_multipart( 'mixed', Force => 1 ); + + my @signature; + # We use RT::Crypt::GnuPG::CRLFHandle to canonicalize the + # MIME::Entity output to use \r\n instead of \n for its newlines + %res = $self->CallGnuPG( + Signer => $args{'Signer'}, + Command => "detach_sign", + Handles => { stdin => RT::Crypt::GnuPG::CRLFHandle->new }, + Direct => [], + Passphrase => $args{'Passphrase'}, + Content => $entity->parts(0), + Output => \@signature, + ); + return %res if $res{message}; # setup RFC1847(Ch.2.1) requirements my $protocol = 'application/pgp-signature'; + my $algo = RT->Config->Get('GnuPGOptions')->{'digest-algo'} || 'SHA1'; $entity->head->mime_attr( 'Content-Type' => 'multipart/signed' ); $entity->head->mime_attr( 'Content-Type.protocol' => $protocol ); - $entity->head->mime_attr( 'Content-Type.micalg' => 'pgp-'. lc $opt{'digest-algo'} ); + $entity->head->mime_attr( 'Content-Type.micalg' => 'pgp-'. lc $algo ); $entity->attach( Type => $protocol, Disposition => 'inline', @@ -517,48 +493,24 @@ sub SignEncryptRFC3156 { ); } if ( $args{'Encrypt'} ) { - my %seen; - $gnupg->options->push_recipients( $_ ) foreach - map UseKeyForEncryption($_) || $_, - grep !$seen{ $_ }++, map $_->address, - map Email::Address->parse( Encode::decode( "UTF-8", $entity->head->get( $_ ) ) ), + my @recipients = map $_->address, + map Email::Address->parse( Encode::decode( "UTF-8", $_ ) ), + map $entity->head->get( $_ ), qw(To Cc Bcc); my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); binmode $tmp_fh, ':raw'; - my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh); - my %handle = %$handle_list; - $handles->options( 'stdout' )->{'direct'} = 1; - $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'}; - - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - my $pid = safe_run_child { $args{'Sign'} - ? $gnupg->sign_and_encrypt( handles => $handles ) - : $gnupg->encrypt( handles => $handles ) }; - $entity->make_multipart( 'mixed', Force => 1 ); - { - local $SIG{'PIPE'} = 'IGNORE'; - $entity->parts(0)->print( $handle{'stdin'} ); - close $handle{'stdin'}; - } - waitpid $pid, 0; - }; - - $res{'exit_code'} = $?; - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; - if ( $@ || $? ) { - $res{'message'} = $@? $@: "gpg exited with error code ". ($? >> 8); - return %res; - } + $entity->make_multipart( 'mixed', Force => 1 ); + %res = $self->CallGnuPG( + Signer => $args{'Signer'}, + Recipients => \@recipients, + Command => ( $args{'Sign'} ? "sign_and_encrypt" : "encrypt" ), + Handles => { stdout => $tmp_fh }, + Passphrase => $args{'Passphrase'}, + Content => $entity->parts(0), + ); + return %res if $res{message}; my $protocol = 'application/pgp-encrypted'; $entity->parts([]); @@ -583,6 +535,7 @@ sub SignEncryptRFC3156 { } sub SignEncryptInline { + my $self = shift; my %args = ( @_ ); my $entity = $args{'Entity'}; @@ -591,19 +544,20 @@ sub SignEncryptInline { $entity->make_singlepart; if ( $entity->is_multipart ) { foreach ( $entity->parts ) { - %res = SignEncryptInline( @_, Entity => $_ ); + %res = $self->SignEncryptInline( @_, Entity => $_ ); return %res if $res{'exit_code'}; } return %res; } - return _SignEncryptTextInline( @_ ) + return $self->_SignEncryptTextInline( @_ ) if $entity->effective_type =~ /^text\//i; - return _SignEncryptAttachmentInline( @_ ); + return $self->_SignEncryptAttachmentInline( @_ ); } sub _SignEncryptTextInline { + my $self = shift; my %args = ( Entity => undef, @@ -618,72 +572,23 @@ sub _SignEncryptTextInline { ); return unless $args{'Sign'} || $args{'Encrypt'}; - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - - # handling passphrase in GnupGOptions - $args{'Passphrase'} = delete $opt{'passphrase'} - if !defined($args{'Passphrase'}); - - $opt{'digest-algo'} ||= 'SHA1'; - $opt{'default_key'} = $args{'Signer'} - if $args{'Sign'} && $args{'Signer'}; - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - armor => 1, - meta_interactive => 0, - ); - - if ( $args{'Sign'} && !defined $args{'Passphrase'} ) { - $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} ); - } - - if ( $args{'Encrypt'} ) { - $gnupg->options->push_recipients( $_ ) foreach - map UseKeyForEncryption($_) || $_, - @{ $args{'Recipients'} || [] }; - } - - my %res; - my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); binmode $tmp_fh, ':raw'; - my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh); - my %handle = %$handle_list; - - $handles->options( 'stdout' )->{'direct'} = 1; - $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'}; - my $entity = $args{'Entity'}; - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - my $method = $args{'Sign'} && $args{'Encrypt'} - ? 'sign_and_encrypt' - : ($args{'Sign'}? 'clearsign': 'encrypt'); - my $pid = safe_run_child { $gnupg->$method( handles => $handles ) }; - { - local $SIG{'PIPE'} = 'IGNORE'; - $entity->bodyhandle->print( $handle{'stdin'} ); - close $handle{'stdin'}; - } - waitpid $pid, 0; - }; - $res{'exit_code'} = $?; - my $err = $@; - - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; - if ( $err || $res{'exit_code'} ) { - $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8); - return %res; - } + my %res = $self->CallGnuPG( + Signer => $args{'Signer'}, + Recipients => $args{'Recipients'}, + Command => ( $args{'Sign'} && $args{'Encrypt'} + ? 'sign_and_encrypt' + : ( $args{'Sign'} + ? 'clearsign' + : 'encrypt' ) ), + Handles => { stdout => $tmp_fh }, + Passphrase => $args{'Passphrase'}, + Content => $entity->bodyhandle, + ); + return %res if $res{message}; $entity->bodyhandle( MIME::Body::File->new( $tmp_fn) ); $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh; @@ -692,6 +597,7 @@ sub _SignEncryptTextInline { } sub _SignEncryptAttachmentInline { + my $self = shift; my %args = ( Entity => undef, @@ -706,71 +612,25 @@ sub _SignEncryptAttachmentInline { ); return unless $args{'Sign'} || $args{'Encrypt'}; - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - - # handling passphrase in GnupGOptions - $args{'Passphrase'} = delete $opt{'passphrase'} - if !defined($args{'Passphrase'}); - - $opt{'digest-algo'} ||= 'SHA1'; - $opt{'default_key'} = $args{'Signer'} - if $args{'Sign'} && $args{'Signer'}; - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - armor => 1, - meta_interactive => 0, - ); - - if ( $args{'Sign'} && !defined $args{'Passphrase'} ) { - $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} ); - } my $entity = $args{'Entity'}; - if ( $args{'Encrypt'} ) { - $gnupg->options->push_recipients( $_ ) foreach - map UseKeyForEncryption($_) || $_, - @{ $args{'Recipients'} || [] }; - } - - my %res; my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); binmode $tmp_fh, ':raw'; - my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh); - my %handle = %$handle_list; - $handles->options( 'stdout' )->{'direct'} = 1; - $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'}; - - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - my $method = $args{'Sign'} && $args{'Encrypt'} - ? 'sign_and_encrypt' - : ($args{'Sign'}? 'detach_sign': 'encrypt'); - my $pid = safe_run_child { $gnupg->$method( handles => $handles ) }; - { - local $SIG{'PIPE'} = 'IGNORE'; - $entity->bodyhandle->print( $handle{'stdin'} ); - close $handle{'stdin'}; - } - waitpid $pid, 0; - }; - $res{'exit_code'} = $?; - my $err = $@; - - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; - if ( $err || $res{'exit_code'} ) { - $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8); - return %res; - } + my %res = $self->CallGnuPG( + Signer => $args{'Signer'}, + Recipients => $args{'Recipients'}, + Command => ( $args{'Sign'} && $args{'Encrypt'} + ? 'sign_and_encrypt' + : ( $args{'Sign'} + ? 'detach_sign' + : 'encrypt' ) ), + Handles => { stdout => $tmp_fh }, + Passphrase => $args{'Passphrase'}, + Content => $entity->bodyhandle, + ); + return %res if $res{message}; my $filename = mime_recommended_filename( $entity ) || 'no_name'; if ( $args{'Sign'} && !$args{'Encrypt'} ) { @@ -794,6 +654,7 @@ sub _SignEncryptAttachmentInline { } sub SignEncryptContent { + my $self = shift; my %args = ( Content => undef, @@ -808,70 +669,22 @@ sub SignEncryptContent { ); return unless $args{'Sign'} || $args{'Encrypt'}; - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - - # handling passphrase in GnupGOptions - $args{'Passphrase'} = delete $opt{'passphrase'} - if !defined($args{'Passphrase'}); - - $opt{'digest-algo'} ||= 'SHA1'; - $opt{'default_key'} = $args{'Signer'} - if $args{'Sign'} && $args{'Signer'}; - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - armor => 1, - meta_interactive => 0, - ); - - if ( $args{'Sign'} && !defined $args{'Passphrase'} ) { - $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} ); - } - - if ( $args{'Encrypt'} ) { - $gnupg->options->push_recipients( $_ ) foreach - map UseKeyForEncryption($_) || $_, - @{ $args{'Recipients'} || [] }; - } - - my %res; - my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); binmode $tmp_fh, ':raw'; - my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh); - my %handle = %$handle_list; - $handles->options( 'stdout' )->{'direct'} = 1; - $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'}; - - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - my $method = $args{'Sign'} && $args{'Encrypt'} - ? 'sign_and_encrypt' - : ($args{'Sign'}? 'clearsign': 'encrypt'); - my $pid = safe_run_child { $gnupg->$method( handles => $handles ) }; - { - local $SIG{'PIPE'} = 'IGNORE'; - $handle{'stdin'}->print( ${ $args{'Content'} } ); - close $handle{'stdin'}; - } - waitpid $pid, 0; - }; - $res{'exit_code'} = $?; - my $err = $@; - - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; - if ( $err || $res{'exit_code'} ) { - $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8); - return %res; - } + my %res = $self->CallGnuPG( + Signer => $args{'Signer'}, + Recipients => $args{'Recipients'}, + Command => ( $args{'Sign'} && $args{'Encrypt'} + ? 'sign_and_encrypt' + : ( $args{'Sign'} + ? 'clearsign' + : 'encrypt' ) ), + Handles => { stdout => $tmp_fh }, + Passphrase => $args{'Passphrase'}, + Content => $args{'Content'}, + ); + return %res if $res{message}; ${ $args{'Content'} } = ''; seek $tmp_fh, 0, 0; @@ -888,257 +701,276 @@ sub SignEncryptContent { return %res; } -sub FindProtectedParts { - my %args = ( Entity => undef, CheckBody => 1, @_ ); - my $entity = $args{'Entity'}; +sub CheckIfProtected { + my $self = shift; + my %args = ( Entity => undef, @_ ); - # inline PGP block, only in singlepart - unless ( $entity->is_multipart ) { - my $file = ($entity->head->recommended_filename||'') =~ /\.${RE_FILE_EXTENSIONS}$/; + my $entity = $args{'Entity'}; - my $io = $entity->open('r'); - unless ( $io ) { - $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" ); - return (); - } + # we check inline PGP block later in another sub + return () unless $entity->is_multipart; - # Deal with "partitioned" PGP mail, which (contrary to common - # sense) unnecessarily applies a base64 transfer encoding to PGP - # mail (whose content is already base64-encoded). - if ( $entity->bodyhandle->is_encoded and $entity->head->mime_encoding ) { - my $decoder = MIME::Decoder->new( $entity->head->mime_encoding ); - if ($decoder) { - local $@; - eval { - my $buf = ''; - open my $fh, '>', \$buf - or die "Couldn't open scalar for writing: $!"; - binmode $fh, ":raw"; - $decoder->decode($io, $fh); - close $fh or die "Couldn't close scalar: $!"; - - open $fh, '<', \$buf - or die "Couldn't re-open scalar for reading: $!"; - binmode $fh, ":raw"; - $io = $fh; - 1; - } or do { - $RT::Logger->error("Couldn't decode body: $@"); - } - } - } + # RFC3156, multipart/{signed,encrypted} + my $type = $entity->effective_type; + return () unless $type =~ /^multipart\/(?:encrypted|signed)$/; - while ( defined($_ = $io->getline) ) { - next unless /^-----BEGIN PGP (SIGNED )?MESSAGE-----/; - my $type = $1? 'signed': 'encrypted'; - $RT::Logger->debug("Found $type inline part"); - return { - Type => $type, - Format => !$file || $type eq 'signed'? 'Inline' : 'Attachment', - Data => $entity, - }; - } - $io->close; + unless ( $entity->parts == 2 ) { + $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" ); return (); } - # RFC3156, multipart/{signed,encrypted} - if ( ( my $type = $entity->effective_type ) =~ /^multipart\/(?:encrypted|signed)$/ ) { - unless ( $entity->parts == 2 ) { - $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" ); - return (); - } - - my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' ); - unless ( $protocol ) { - $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" ); - return (); - } + my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' ); + unless ( $protocol ) { + # if protocol is not set then we can check second part for PGP message + $RT::Logger->error( "Entity is '$type', but has no protocol defined. Checking for PGP part" ); + my $protected = $self->_CheckIfProtectedInline( $entity->parts(1), 1 ); + return () unless $protected; - if ( $type eq 'multipart/encrypted' ) { - unless ( $protocol eq 'application/pgp-encrypted' ) { - $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" ); - return (); - } - $RT::Logger->debug("Found encrypted according to RFC3156 part"); - return { - Type => 'encrypted', - Format => 'RFC3156', - Top => $entity, - Data => $entity->parts(1), - Info => $entity->parts(0), - }; - } else { - unless ( $protocol eq 'application/pgp-signature' ) { - $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" ); - return (); - } - $RT::Logger->debug("Found signed according to RFC3156 part"); - return { + if ( $protected eq 'signature' ) { + $RT::Logger->debug("Found part signed according to RFC3156"); + return ( Type => 'signed', Format => 'RFC3156', - Top => $entity, - Data => $entity->parts(0), + Top => $entity, + Data => $entity->parts(0), Signature => $entity->parts(1), - }; + ); + } else { + $RT::Logger->debug("Found part encrypted according to RFC3156"); + return ( + Type => 'encrypted', + Format => 'RFC3156', + Top => $entity, + Data => $entity->parts(1), + Info => $entity->parts(0), + ); + } + } + elsif ( $type eq 'multipart/encrypted' ) { + unless ( $protocol eq 'application/pgp-encrypted' ) { + $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" ); + return (); + } + $RT::Logger->debug("Found part encrypted according to RFC3156"); + return ( + Type => 'encrypted', + Format => 'RFC3156', + Top => $entity, + Data => $entity->parts(1), + Info => $entity->parts(0), + ); + } else { + unless ( $protocol eq 'application/pgp-signature' ) { + $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" ); + return (); } + $RT::Logger->debug("Found part signed according to RFC3156"); + return ( + Type => 'signed', + Format => 'RFC3156', + Top => $entity, + Data => $entity->parts(0), + Signature => $entity->parts(1), + ); } + return (); +} + + +sub FindScatteredParts { + my $self = shift; + my %args = ( Parts => [], Skip => {}, @_ ); + + my @res; + + my @parts = @{ $args{'Parts'} }; # attachments signed with signature in another part - my @file_indices; - foreach my $i ( 0 .. $entity->parts - 1 ) { - my $part = $entity->parts($i); + { + my @file_indices; + for (my $i = 0; $i < @parts; $i++ ) { + my $part = $parts[ $i ]; - # we can not associate a signature within an attachment - # without file names - my $fname = $part->head->recommended_filename; - next unless $fname; + # we can not associate a signature within an attachment + # without file names + my $fname = $part->head->recommended_filename; + next unless $fname; - if ( $part->effective_type eq 'application/pgp-signature' ) { - push @file_indices, $i; + my $type = $part->effective_type; + + if ( $type eq 'application/pgp-signature' ) { + push @file_indices, $i; + } + elsif ( $type eq 'application/octet-stream' && $fname =~ /\.sig$/i ) { + push @file_indices, $i; + } } - elsif ( $fname =~ /\.sig$/i && $part->effective_type eq 'application/octet-stream' ) { - push @file_indices, $i; + + foreach my $i ( @file_indices ) { + my $sig_part = $parts[ $i ]; + my $sig_name = $sig_part->head->recommended_filename; + my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/; + + my ($data_part_idx) = + grep $file_name eq ($parts[$_]->head->recommended_filename||''), + grep $sig_part ne $parts[$_], + 0 .. @parts - 1; + unless ( defined $data_part_idx ) { + $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name"); + next; + } + + my $data_part_in = $parts[ $data_part_idx ]; + + $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'"); + + $args{'Skip'}{$data_part_in} = 1; + $args{'Skip'}{$sig_part} = 1; + push @res, { + Type => 'signed', + Format => 'Attachment', + Top => $args{'Parents'}{$sig_part}, + Data => $data_part_in, + Signature => $sig_part, + }; } } - my (@res, %skip); - foreach my $i ( @file_indices ) { - my $sig_part = $entity->parts($i); - $skip{"$sig_part"}++; - my $sig_name = $sig_part->head->recommended_filename; - my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/; - - my ($data_part_idx) = - grep $file_name eq ($entity->parts($_)->head->recommended_filename||''), - grep $sig_part ne $entity->parts($_), - 0 .. $entity->parts - 1; - unless ( defined $data_part_idx ) { - $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name"); - next; - } - my $data_part_in = $entity->parts($data_part_idx); + # attachments with inline encryption + foreach my $part ( @parts ) { + next if $args{'Skip'}{$part}; + + my $fname = $part->head->recommended_filename || ''; + next unless $fname =~ /\.${RE_FILE_EXTENSIONS}$/; - $skip{"$data_part_in"}++; - $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'"); + $RT::Logger->debug("Found encrypted attachment '$fname'"); + + $args{'Skip'}{$part} = 1; push @res, { - Type => 'signed', - Format => 'Attachment', - Top => $entity, - Data => $data_part_in, - Signature => $sig_part, + Type => 'encrypted', + Format => 'Attachment', + Data => $part, }; } - # attachments with inline encryption - my @encrypted_indices = - grep {($entity->parts($_)->head->recommended_filename || '') =~ /\.${RE_FILE_EXTENSIONS}$/} - 0 .. $entity->parts - 1; - - foreach my $i ( @encrypted_indices ) { - my $part = $entity->parts($i); - $skip{"$part"}++; - $RT::Logger->debug("Found encrypted attachment '". $part->head->recommended_filename ."'"); + # inline PGP block + foreach my $part ( @parts ) { + next if $args{'Skip'}{$part}; + + my $type = $self->_CheckIfProtectedInline( $part ); + next unless $type; + + my $file = ($part->head->recommended_filename||'') =~ /\.${RE_FILE_EXTENSIONS}$/; + + $args{'Skip'}{$part} = 1; push @res, { - Type => 'encrypted', - Format => 'Attachment', - Top => $entity, - Data => $part, + Type => $type, + Format => !$file || $type eq 'signed'? 'Inline' : 'Attachment', + Data => $part, }; } - push @res, FindProtectedParts( Entity => $_ ) - foreach grep !$skip{"$_"}, $entity->parts; - return @res; } -=head2 VerifyDecrypt Entity => undef, [ Detach => 1, Passphrase => undef, SetStatus => 1 ] +sub _CheckIfProtectedInline { + my $self = shift; + my $entity = shift; + my $check_for_signature = shift || 0; -=cut + my $io = $entity->open('r'); + unless ( $io ) { + $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" ); + return ''; + } + + # Deal with "partitioned" PGP mail, which (contrary to common + # sense) unnecessarily applies a base64 transfer encoding to PGP + # mail (whose content is already base64-encoded). + if ( $entity->bodyhandle->is_encoded and $entity->head->mime_encoding ) { + my $decoder = MIME::Decoder->new( $entity->head->mime_encoding ); + if ($decoder) { + local $@; + eval { + my $buf = ''; + open my $fh, '>', \$buf + or die "Couldn't open scalar for writing: $!"; + binmode $fh, ":raw"; + $decoder->decode($io, $fh); + close $fh or die "Couldn't close scalar: $!"; + + open $fh, '<', \$buf + or die "Couldn't re-open scalar for reading: $!"; + binmode $fh, ":raw"; + $io = $fh; + 1; + } or do { + $RT::Logger->error("Couldn't decode body: $@"); + } + } + } + + while ( defined($_ = $io->getline) ) { + if ( /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) { + return $1? 'signed': 'encrypted'; + } + elsif ( $check_for_signature && !/^-----BEGIN PGP SIGNATURE-----/ ) { + return 'signature'; + } + } + $io->close; + return ''; +} sub VerifyDecrypt { + my $self = shift; my %args = ( - Entity => undef, - Detach => 1, - SetStatus => 1, - AddStatus => 0, + Info => undef, @_ ); - my @protected = FindProtectedParts( Entity => $args{'Entity'} ); - my @res; - # XXX: detaching may brake nested signatures - foreach my $item( grep $_->{'Type'} eq 'signed', @protected ) { - my $status_on; + + my %res; + + my $item = $args{'Info'}; + my $status_on; + if ( $item->{'Type'} eq 'signed' ) { if ( $item->{'Format'} eq 'RFC3156' ) { - push @res, { VerifyRFC3156( %$item, SetStatus => $args{'SetStatus'} ) }; - if ( $args{'Detach'} ) { - $item->{'Top'}->parts( [ $item->{'Data'} ] ); - $item->{'Top'}->make_singlepart; - } + %res = $self->VerifyRFC3156( %$item ); $status_on = $item->{'Top'}; } elsif ( $item->{'Format'} eq 'Inline' ) { - push @res, { VerifyInline( %$item ) }; + %res = $self->VerifyInline( %$item ); $status_on = $item->{'Data'}; } elsif ( $item->{'Format'} eq 'Attachment' ) { - push @res, { VerifyAttachment( %$item ) }; - if ( $args{'Detach'} ) { - $item->{'Top'}->parts( [ - grep "$_" ne $item->{'Signature'}, $item->{'Top'}->parts - ] ); - $item->{'Top'}->make_singlepart; - } + %res = $self->VerifyAttachment( %$item ); $status_on = $item->{'Data'}; + } else { + die "Unknown format '".$item->{'Format'} . "' of GnuPG signed part"; } - if ( $args{'SetStatus'} || $args{'AddStatus'} ) { - my $method = $args{'AddStatus'} ? 'add' : 'set'; - # Let the header be modified so continuations are handled - my $modify = $status_on->head->modify; - $status_on->head->modify(1); - $status_on->head->$method( - 'X-RT-GnuPG-Status' => $res[-1]->{'status'} - ); - $status_on->head->modify($modify); - } - } - foreach my $item( grep $_->{'Type'} eq 'encrypted', @protected ) { - my $status_on; + } elsif ( $item->{'Type'} eq 'encrypted' ) { if ( $item->{'Format'} eq 'RFC3156' ) { - push @res, { DecryptRFC3156( %$item ) }; + %res = $self->DecryptRFC3156( %$item ); $status_on = $item->{'Top'}; } elsif ( $item->{'Format'} eq 'Inline' ) { - push @res, { DecryptInline( %$item ) }; + %res = $self->DecryptInline( %$item ); $status_on = $item->{'Data'}; } elsif ( $item->{'Format'} eq 'Attachment' ) { - push @res, { DecryptAttachment( %$item ) }; + %res = $self->DecryptAttachment( %$item ); $status_on = $item->{'Data'}; + } else { + die "Unknown format '".$item->{'Format'} . "' of GnuPG encrypted part"; } - if ( $args{'SetStatus'} || $args{'AddStatus'} ) { - my $method = $args{'AddStatus'} ? 'add' : 'set'; - # Let the header be modified so continuations are handled - my $modify = $status_on->head->modify; - $status_on->head->modify(1); - $status_on->head->$method( - 'X-RT-GnuPG-Status' => $res[-1]->{'status'} - ); - $status_on->head->modify($modify); - } + } else { + die "Unknown type '".$item->{'Type'} . "' of protected item"; } - return @res; + + return (%res, status_on => $status_on); } -sub VerifyInline { return DecryptInline( @_ ) } +sub VerifyInline { return (shift)->DecryptInline( @_ ) } sub VerifyAttachment { - my %args = ( Data => undef, Signature => undef, Top => undef, @_ ); - - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - $opt{'digest-algo'} ||= 'SHA1'; - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - meta_interactive => 0, - ); + my $self = shift; + my %args = ( Data => undef, Signature => undef, @_ ); foreach ( $args{'Data'}, $args{'Signature'} ) { next unless $_->bodyhandle->is_encoded; @@ -1152,85 +984,45 @@ sub VerifyAttachment { $args{'Data'}->bodyhandle->print( $tmp_fh ); $tmp_fh->flush; - my ($handles, $handle_list) = _make_gpg_handles(); - my %handle = %$handle_list; + my %res = $self->CallGnuPG( + Command => "verify", + CommandArgs => [ '-', $tmp_fn ], + Passphrase => $args{'Passphrase'}, + Content => $args{'Signature'}->bodyhandle, + ); + + $args{'Top'}->parts( [ + grep "$_" ne $args{'Signature'}, $args{'Top'}->parts + ] ); + $args{'Top'}->make_singlepart; - my %res; - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - my $pid = safe_run_child { $gnupg->verify( - handles => $handles, command_args => [ '-', $tmp_fn ] - ) }; - { - local $SIG{'PIPE'} = 'IGNORE'; - $args{'Signature'}->bodyhandle->print( $handle{'stdin'} ); - close $handle{'stdin'}; - } - waitpid $pid, 0; - }; - $res{'exit_code'} = $?; - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; - if ( $@ || $? ) { - $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8); - } return %res; } sub VerifyRFC3156 { - my %args = ( Data => undef, Signature => undef, Top => undef, @_ ); - - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - $opt{'digest-algo'} ||= 'SHA1'; - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - meta_interactive => 0, - ); + my $self = shift; + my %args = ( Data => undef, Signature => undef, @_ ); my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); binmode $tmp_fh, ':raw:eol(CRLF?)'; $args{'Data'}->print( $tmp_fh ); $tmp_fh->flush; - my ($handles, $handle_list) = _make_gpg_handles(); - my %handle = %$handle_list; + my %res = $self->CallGnuPG( + Command => "verify", + CommandArgs => [ '-', $tmp_fn ], + Passphrase => $args{'Passphrase'}, + Content => $args{'Signature'}->bodyhandle, + ); + + $args{'Top'}->parts( [ $args{'Data'} ] ); + $args{'Top'}->make_singlepart; - my %res; - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - my $pid = safe_run_child { $gnupg->verify( - handles => $handles, command_args => [ '-', $tmp_fn ] - ) }; - { - local $SIG{'PIPE'} = 'IGNORE'; - $args{'Signature'}->bodyhandle->print( $handle{'stdin'} ); - close $handle{'stdin'}; - } - waitpid $pid, 0; - }; - $res{'exit_code'} = $?; - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; - if ( $@ || $? ) { - $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8); - } return %res; } sub DecryptRFC3156 { + my $self = shift; my %args = ( Data => undef, Info => undef, @@ -1239,105 +1031,52 @@ sub DecryptRFC3156 { @_ ); - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - - # handling passphrase in GnupGOptions - $args{'Passphrase'} = delete $opt{'passphrase'} - if !defined($args{'Passphrase'}); - - $opt{'digest-algo'} ||= 'SHA1'; - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - meta_interactive => 0, - ); - if ( $args{'Data'}->bodyhandle->is_encoded ) { require RT::EmailParser; RT::EmailParser->_DecodeBody($args{'Data'}); } - $args{'Passphrase'} = GetPassphrase() - unless defined $args{'Passphrase'}; - my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); binmode $tmp_fh, ':raw'; - my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh); - my %handle = %$handle_list; - $handles->options( 'stdout' )->{'direct'} = 1; - - my %res; - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - $gnupg->passphrase( $args{'Passphrase'} ); - my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) }; - { - local $SIG{'PIPE'} = 'IGNORE'; - $args{'Data'}->bodyhandle->print( $handle{'stdin'} ); - close $handle{'stdin'} - } - - waitpid $pid, 0; - }; - $res{'exit_code'} = $?; - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; + my %res = $self->CallGnuPG( + Command => "decrypt", + Handles => { stdout => $tmp_fh }, + Passphrase => $args{'Passphrase'}, + Content => $args{'Data'}->bodyhandle, + ); # if the decryption is fine but the signature is bad, then without this # status check we lose the decrypted text # XXX: add argument to the function to control this check - if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) { - if ( $@ || $? ) { - $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8); - return %res; - } - } + delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/; + + return %res if $res{message}; seek $tmp_fh, 0, 0; my $parser = RT::EmailParser->new(); my $decrypted = $parser->ParseMIMEEntityFromFileHandle( $tmp_fh, 0 ); $decrypted->{'__store_link_to_object_to_avoid_early_cleanup'} = $parser; - $args{'Top'}->parts( [] ); - $args{'Top'}->add_part( $decrypted ); + + $args{'Top'}->parts( [$decrypted] ); $args{'Top'}->make_singlepart; + return %res; } sub DecryptInline { + my $self = shift; my %args = ( Data => undef, Passphrase => undef, @_ ); - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - - # handling passphrase in GnuPGOptions - $args{'Passphrase'} = delete $opt{'passphrase'} - if !defined($args{'Passphrase'}); - - $opt{'digest-algo'} ||= 'SHA1'; - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - meta_interactive => 0, - ); - if ( $args{'Data'}->bodyhandle->is_encoded ) { require RT::EmailParser; RT::EmailParser->_DecodeBody($args{'Data'}); } - $args{'Passphrase'} = GetPassphrase() - unless defined $args{'Passphrase'}; - my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); binmode $tmp_fh, ':raw'; @@ -1361,9 +1100,8 @@ sub DecryptInline { seek $block_fh, 0, 0; my ($res_fh, $res_fn); - ($res_fh, $res_fn, %res) = _DecryptInlineBlock( + ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock( %args, - GnuPG => $gnupg, BlockHandle => $block_fh, ); return %res unless $res_fh; @@ -1398,9 +1136,8 @@ sub DecryptInline { seek $block_fh, 0, 0; my ($res_fh, $res_fn); - ($res_fh, $res_fn, %res) = _DecryptInlineBlock( + ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock( %args, - GnuPG => $gnupg, BlockHandle => $block_fh, ); return %res unless $res_fh; @@ -1419,92 +1156,53 @@ sub DecryptInline { } sub _DecryptInlineBlock { + my $self = shift; my %args = ( - GnuPG => undef, BlockHandle => undef, Passphrase => undef, @_ ); - my $gnupg = $args{'GnuPG'}; my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); binmode $tmp_fh, ':raw'; - my ($handles, $handle_list) = _make_gpg_handles( - stdin => $args{'BlockHandle'}, - stdout => $tmp_fh); - my %handle = %$handle_list; - $handles->options( 'stdout' )->{'direct'} = 1; - $handles->options( 'stdin' )->{'direct'} = 1; - - my %res; - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - $gnupg->passphrase( $args{'Passphrase'} ); - my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) }; - waitpid $pid, 0; - }; - $res{'exit_code'} = $?; - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; + my %res = $self->CallGnuPG( + Command => "decrypt", + Handles => { stdout => $tmp_fh, stdin => $args{'BlockHandle'} }, + Passphrase => $args{'Passphrase'}, + ); # if the decryption is fine but the signature is bad, then without this # status check we lose the decrypted text # XXX: add argument to the function to control this check - if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) { - if ( $@ || $? ) { - $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8); - return (undef, undef, %res); - } - } + delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/; + + return (undef, undef, %res) if $res{message}; seek $tmp_fh, 0, 0; return ($tmp_fh, $tmp_fn, %res); } sub DecryptAttachment { + my $self = shift; my %args = ( - Top => undef, Data => undef, Passphrase => undef, @_ ); - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - - # handling passphrase in GnuPGOptions - $args{'Passphrase'} = delete $opt{'passphrase'} - if !defined($args{'Passphrase'}); - - $opt{'digest-algo'} ||= 'SHA1'; - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - meta_interactive => 0, - ); - if ( $args{'Data'}->bodyhandle->is_encoded ) { require RT::EmailParser; RT::EmailParser->_DecodeBody($args{'Data'}); } - $args{'Passphrase'} = GetPassphrase() - unless defined $args{'Passphrase'}; - my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); binmode $tmp_fh, ':raw'; $args{'Data'}->bodyhandle->print( $tmp_fh ); seek $tmp_fh, 0, 0; - my ($res_fh, $res_fn, %res) = _DecryptInlineBlock( + my ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock( %args, - GnuPG => $gnupg, BlockHandle => $tmp_fh, ); return %res unless $res_fh; @@ -1528,68 +1226,29 @@ sub DecryptAttachment { } sub DecryptContent { + my $self = shift; my %args = ( Content => undef, Passphrase => undef, @_ ); - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - - # handling passphrase in GnupGOptions - $args{'Passphrase'} = delete $opt{'passphrase'} - if !defined($args{'Passphrase'}); - - $opt{'digest-algo'} ||= 'SHA1'; - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - meta_interactive => 0, - ); - - $args{'Passphrase'} = GetPassphrase() - unless defined $args{'Passphrase'}; - my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); binmode $tmp_fh, ':raw'; - my ($handles, $handle_list) = _make_gpg_handles( - stdout => $tmp_fh); - my %handle = %$handle_list; - $handles->options( 'stdout' )->{'direct'} = 1; - - my %res; - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - $gnupg->passphrase( $args{'Passphrase'} ); - my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) }; - { - local $SIG{'PIPE'} = 'IGNORE'; - print { $handle{'stdin'} } ${ $args{'Content'} }; - close $handle{'stdin'}; - } - - waitpid $pid, 0; - }; - $res{'exit_code'} = $?; - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; + my %res = $self->CallGnuPG( + Command => "decrypt", + Handles => { stdout => $tmp_fh }, + Passphrase => $args{'Passphrase'}, + Content => $args{'Content'}, + ); # if the decryption is fine but the signature is bad, then without this # status check we lose the decrypted text # XXX: add argument to the function to control this check - if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) { - if ( $@ || $? ) { - $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8); - return %res; - } - } + delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/; + + return %res if $res{'message'}; ${ $args{'Content'} } = ''; seek $tmp_fh, 0, 0; @@ -1606,48 +1265,6 @@ sub DecryptContent { return %res; } -=head2 GetPassphrase [ Address => undef ] - -Returns passphrase, called whenever it's required with Address as a named argument. - -=cut - -sub GetPassphrase { - my %args = ( Address => undef, @_ ); - return 'test'; -} - -=head2 ParseStatus - -Takes a string containing output of gnupg status stream. Parses it and returns -array of hashes. Each element of array is a hash ref and represents line or -group of lines in the status message. - -All hashes have Operation, Status and Message elements. - -=over - -=item Operation - -Classification of operations gnupg performs. Now we have support -for Sign, Encrypt, Decrypt, Verify, PassphraseCheck, RecipientsCheck and Data -values. - -=item Status - -Informs about success. Value is 'DONE' on success, other values means that -an operation failed, for example 'ERROR', 'BAD', 'MISSING' and may be other. - -=item Message - -User friendly message. - -=back - -This parser is based on information from GnuPG distribution. - -=cut - my %REASON_CODE_TO_TEXT = ( NODATA => { 1 => "No armored data", @@ -1723,6 +1340,7 @@ my %ignore_keyword = map { $_ => 1 } qw( ); sub ParseStatus { + my $self = shift; my $status = shift; return () unless $status; @@ -1966,52 +1584,10 @@ sub _PrepareGnuPGOptions { return %res; } -{ my %key; -# no args -> clear -# one arg -> return preferred key -# many -> set -sub UseKeyForEncryption { - unless ( @_ ) { - %key = (); - } elsif ( @_ > 1 ) { - %key = (%key, @_); - $key{ lc($_) } = delete $key{ $_ } foreach grep lc ne $_, keys %key; - } else { - return $key{ $_[0] }; - } - return (); -} } - -=head2 UseKeyForSigning - -Returns or sets identifier of the key that should be used for signing. - -Returns the current value when called without arguments. - -Sets new value when called with one argument and unsets if it's undef. - -=cut - -{ my $key; -sub UseKeyForSigning { - if ( @_ ) { - $key = $_[0]; - } - return $key; -} } - -=head2 GetKeysForEncryption - -Takes identifier and returns keys suitable for encryption. - -B<Note> that keys for which trust level is not set are -also listed. - -=cut - sub GetKeysForEncryption { - my $key_id = shift; - my %res = GetKeysInfo( $key_id, 'public', @_ ); + my $self = shift; + my %args = (Recipient => undef, @_); + my %res = $self->GetKeysInfo( Key => delete $args{'Recipient'}, %args, Type => 'public' ); return %res if $res{'exit_code'}; return %res unless $res{'info'}; @@ -2020,7 +1596,7 @@ sub GetKeysForEncryption { next if $key->{'Capabilities'} =~ /D/; # skip keys not suitable for encryption next unless $key->{'Capabilities'} =~ /e/i; - # skip disabled, expired, revoke and keys with no trust, + # skip disabled, expired, revoked and keys with no trust, # but leave keys with unknown trust level next if $key->{'TrustLevel'} < 0; @@ -2031,151 +1607,61 @@ sub GetKeysForEncryption { } sub GetKeysForSigning { - my $key_id = shift; - return GetKeysInfo( $key_id, 'private', @_ ); -} - -sub CheckRecipients { - my @recipients = (@_); - - my ($status, @issues) = (1, ()); - - my %seen; - foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) { - my %res = GetKeysForEncryption( $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 = 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 GetPublicKeyInfo { - return GetKeyInfo( shift, 'public', @_ ); -} - -sub GetPrivateKeyInfo { - return GetKeyInfo( shift, 'private', @_ ); -} - -sub GetKeyInfo { - my %res = GetKeysInfo(@_); - $res{'info'} = $res{'info'}->[0]; - return %res; + my $self = shift; + my %args = (Signer => undef, @_); + return $self->GetKeysInfo( Key => delete $args{'Signer'}, %args, Type => 'private' ); } sub GetKeysInfo { - my $email = shift; - my $type = shift || 'public'; - my $force = shift; + my $self = shift; + my %args = ( + Key => undef, + Type => 'public', + Force => 0, + @_ + ); + my $email = $args{'Key'}; + my $type = $args{'Type'}; unless ( $email ) { - return (exit_code => 0) unless $force; - } - - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - $opt{'digest-algo'} ||= 'SHA1'; - $opt{'with-colons'} = undef; # parseable format - $opt{'fingerprint'} = undef; # show fingerprint - $opt{'fixed-list-mode'} = undef; # don't merge uid with keys - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - armor => 1, - meta_interactive => 0, + return (exit_code => 0) unless $args{'Force'}; + } + + my @info; + my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys'; + my %res = $self->CallGnuPG( + Options => { + 'with-colons' => undef, # parseable format + 'fingerprint' => undef, # show fingerprint + 'fixed-list-mode' => undef, # don't merge uid with keys + }, + Command => $method, + ( $email ? (CommandArgs => ['--', $email]) : () ), + Output => \@info, ); - my %res; + # Asking for a non-existent key is not an error + if ($res{message} and $res{logger} =~ /(secret key not available|public key not found)/) { + delete $res{exit_code}; + delete $res{message}; + } - my ($handles, $handle_list) = _make_gpg_handles(); - my %handle = %$handle_list; + return %res if $res{'message'}; - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys'; - my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email - ? (command_args => [ "--", $email]) - : () ) }; - close $handle{'stdin'}; - waitpid $pid, 0; - }; - - my @info = readline $handle{'stdout'}; - close $handle{'stdout'}; + @info = $self->ParseKeysInfo( @info ); + $res{'info'} = \@info; - $res{'exit_code'} = $?; - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - if ( $res{'logger'} && $? ) { - $RT::Logger->error( $res{'logger'} ); - $RT::Logger->error( 'The above error may result from an unconfigured RT/GPG installation. See perldoc etc/RT_Config.pm for information about configuring or disabling GPG support for RT' ); - } - if ( $@ || $? ) { - $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8); - return %res; + for my $key (@{$res{info}}) { + $key->{Formatted} = + join("; ", map {$_->{String}} @{$key->{User}}) + . " (".substr($key->{Fingerprint}, -8) . ")"; } - @info = ParseKeysInfo( @info ); - $res{'info'} = \@info; return %res; } sub ParseKeysInfo { + my $self = shift; my @lines = @_; my %gpg_opt = RT->Config->Get('GnuPGOptions'); @@ -2209,7 +1695,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; } @@ -2222,7 +1708,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; } @@ -2230,7 +1716,7 @@ sub ParseKeysInfo { my %info; @info{ qw(Trust Created Expire String) } = (split /:/, $line)[0,4,5,8]; - $info{ $_ } = _ParseDate( $info{ $_ } ) + $info{ $_ } = $self->ParseDate( $info{ $_ } ) foreach qw(Created Expire); push @{ $res[-1]{'User'} ||= [] }, \%info; } @@ -2308,173 +1794,97 @@ 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; - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - meta_interactive => 0, - ); - - my ($handles, $handle_list) = _make_gpg_handles(); - my %handle = %$handle_list; - - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - my $pid = safe_run_child { $gnupg->wrap_call( - handles => $handles, - commands => ['--delete-secret-and-public-key'], - command_args => ["--", $key], - ) }; - close $handle{'stdin'}; - while ( my $str = readline $handle{'status'} ) { - if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) { - print { $handle{'command'} } "y\n"; + return $self->CallGnuPG( + Command => "--delete-secret-and-public-key", + CommandArgs => ["--", $key], + Callback => sub { + my %handle = @_; + while ( my $str = readline $handle{'status'} ) { + if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) { + print { $handle{'command'} } "y\n"; + } } - } - waitpid $pid, 0; - }; - my $err = $@; - close $handle{'stdout'}; - - my %res; - $res{'exit_code'} = $?; - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; - if ( $err || $res{'exit_code'} ) { - $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8); - } - return %res; + }, + ); } sub ImportKey { + my $self = shift; my $key = shift; - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); - $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - meta_interactive => 0, + return $self->CallGnuPG( + Command => "import_keys", + Content => $key, ); - - my ($handles, $handle_list) = _make_gpg_handles(); - my %handle = %$handle_list; - - eval { - local $SIG{'CHLD'} = 'DEFAULT'; - my $pid = safe_run_child { $gnupg->wrap_call( - handles => $handles, - commands => ['--import'], - ) }; - print { $handle{'stdin'} } $key; - close $handle{'stdin'}; - waitpid $pid, 0; - }; - my $err = $@; - close $handle{'stdout'}; - - my %res; - $res{'exit_code'} = $?; - foreach ( qw(stderr logger status) ) { - $res{$_} = do { local $/; readline $handle{$_} }; - delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s; - close $handle{$_}; - } - $RT::Logger->debug( $res{'status'} ) if $res{'status'}; - $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'}; - $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?; - if ( $err || $res{'exit_code'} ) { - $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8); - } - return %res; } -=head2 KEY - -Signs a small message with the key, to make sure the key exists and -we have a useable passphrase. The first argument MUST be a key identifier -of the signer: either email address, key id or finger print. - -Returns a true value if all went well. - -=cut - -sub DrySign { - my $from = shift; - - my $mime = MIME::Entity->build( - Type => "text/plain", - From => 'nobody@localhost', - To => 'nobody@localhost', - Subject => "dry sign", - Data => ['t'], - ); - - my %res = SignEncrypt( - Sign => 1, - Encrypt => 0, - Entity => $mime, - Signer => $from, - ); - - return $res{exit_code} == 0; +sub GnuPGPath { + state $cache = RT->Config->Get('GnuPG')->{'GnuPG'}; + $cache = $_[1] if @_ > 1; + return $cache; } -1; - -=head2 Probe - -This routine returns true if RT's GnuPG support is configured and working -properly (and false otherwise). - - -=cut +sub Probe { + my $self = shift; + my $gnupg = GnuPG::Interface->new; + + my $bin = $self->GnuPGPath(); + unless ($bin) { + $RT::Logger->warning( + "No gpg path set; GnuPG support has been disabled. ". + "Check the 'GnuPG' configuration in %GnuPG"); + return 0; + } + if ($bin =~ m{^/}) { + unless (-f $bin and -x _) { + $RT::Logger->warning( + "Invalid gpg path $bin; GnuPG support has been disabled. ". + "Check the 'GnuPG' configuration in %GnuPG"); + return 0; + } + } else { + local $ENV{PATH} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin' + unless defined $ENV{PATH}; + my $path = File::Which::which( $bin ); + unless ($path) { + $RT::Logger->warning( + "Can't find gpg binary '$bin' in PATH ($ENV{PATH}); GnuPG support has been disabled. ". + "You may need to specify a full path to gpg via the 'GnuPG' configuration in %GnuPG"); + return 0; + } + $self->GnuPGPath( $bin = $path ); + } -sub Probe { - my $gnupg = GnuPG::Interface->new(); - my %opt = RT->Config->Get('GnuPGOptions'); + $gnupg->call( $bin ); $gnupg->options->hash_init( - _PrepareGnuPGOptions( %opt ), - armor => 1, - meta_interactive => 0, + _PrepareGnuPGOptions( RT->Config->Get('GnuPGOptions') ) ); + $gnupg->options->meta_interactive( 0 ); my ($handles, $handle_list) = _make_gpg_handles(); my %handle = %$handle_list; - local $@; + local $@ = undef; eval { local $SIG{'CHLD'} = 'DEFAULT'; - my $pid = safe_run_child { $gnupg->wrap_call( commands => ['--version' ], handles => $handles ) }; - close $handle{'stdin'}; + my $pid = safe_run_child { + $gnupg->wrap_call( + commands => ['--version' ], + handles => $handles + ) + }; + close $handle{'stdin'} or die "Can't close gnupg input handle: $!"; waitpid $pid, 0; }; if ( $@ ) { + $RT::Logger->warning( + "RT's GnuPG libraries couldn't successfully execute gpg.". + " GnuPG support has been disabled"); $RT::Logger->debug( "Probe for GPG failed." ." Couldn't run `gpg --version`: ". $@ @@ -2487,15 +1897,18 @@ sub Probe { # but there is no way to get actuall error if ( $? && ($? >> 8) != 2 ) { my $msg = "Probe for GPG failed." - ." Process exitted with code ". ($? >> 8) + ." Process exited with code ". ($? >> 8) . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '') . "."; foreach ( qw(stderr logger status) ) { - my $tmp = do { local $/; readline $handle{$_} }; + my $tmp = do { local $/ = undef; readline $handle{$_} }; next unless $tmp && $tmp =~ /\S/s; - close $handle{$_}; + close $handle{$_} or $tmp .= "\nFailed to close: $!"; $msg .= "\n$_:\n$tmp\n"; } + $RT::Logger->warning( + "RT's GnuPG libraries couldn't successfully execute gpg.". + " GnuPG support has been disabled"); $RT::Logger->debug( $msg ); return 0; } @@ -2515,15 +1928,4 @@ sub _make_gpg_handles { RT::Base->_ImportOverlays(); -# helper package to avoid using temp file -package IO::Handle::CRLF; - -use base qw(IO::Handle); - -sub print { - my ($self, @args) = (@_); - s/\r*\n/\x0D\x0A/g foreach @args; - return $self->SUPER::print( @args ); -} - 1; diff --git a/rt/lib/RT/Crypt/GnuPG/CRLFHandle.pm b/rt/lib/RT/Crypt/GnuPG/CRLFHandle.pm new file mode 100644 index 0000000..74a4009 --- /dev/null +++ b/rt/lib/RT/Crypt/GnuPG/CRLFHandle.pm @@ -0,0 +1,70 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} + +package RT::Crypt::GnuPG::CRLFHandle; +use strict; +use warnings; + +use base qw(IO::Handle); + +# https://metacpan.org/module/MIME::Tools#Fuzzing-of-CRLF-and-newline-when-encoding-composing +# means that the output of $entity->print contains lines terminated by +# "\n"; however, signatures are generated off of the "correct" form of +# the MIME entity, which uses "\r\n" as the newline separator. This +# class, used only when generating signatures, transparently munges "\n" +# newlines into "\r\n" newlines such that the generated signature is +# correct for the "\r\n"-newline version of the MIME entity which will +# eventually be sent over the wire. + +sub print { + my ($self, @args) = (@_); + s/\r*\n/\x0D\x0A/g foreach @args; + return $self->SUPER::print( @args ); +} + +1; diff --git a/rt/lib/RT/Crypt/Role.pm b/rt/lib/RT/Crypt/Role.pm new file mode 100644 index 0000000..b1e368d --- /dev/null +++ b/rt/lib/RT/Crypt/Role.pm @@ -0,0 +1,254 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} + +use strict; +use warnings; + +package RT::Crypt::Role; +use Role::Basic; + +=head1 NAME + +RT::Crypt::Role - Common requirements for encryption implementations + +=head1 METHODS + +=head2 Probe + +This routine is called only if the protocol is enabled, and should +return true if all binaries required by the protocol are installed. It +should produce any warnings necessary to describe any issues it +encounters. + +=cut + +requires 'Probe'; + +=head2 GetPassphrase Address => ADDRESS + +Returns the passphrase for the given address. It looks at the relevant +configuration option for the encryption protocol +(e.g. L<RT_Config/GnuPG> for GnuPG), and examines the Passphrase key. +It it does not exist, returns the empty string. If it is a scalar, it +returns that value. If it is an anonymous subroutine, it calls it. If +it is a hash, it looks up the address (using '' as a fallback key). + +=cut + +sub GetPassphrase { + my $self = shift; + my %args = ( Address => undef, @_ ); + + my $class = ref($self) || $self; + $class =~ s/^RT::Crypt:://; + + my $config = RT->Config->Get($class)->{Passphrase}; + + return '' unless defined $config; + + if (not ref $config) { + return $config; + } elsif (ref $config eq "HASH") { + return $config->{$args{Address}} + || $config->{''}; + } elsif (ref $config eq "CODE") { + return $config->( @_ ); + } else { + warn "Unknown Passphrase type for $class: ".ref($config); + } +} + +=head2 SignEncrypt Entity => MIME::Entity, [ Encrypt => 1, Sign => 1, ... ] + +Signs and/or encrypts a MIME entity. All arguments and return values +are identical to L<RT::Crypt/SignEncrypt>, with the omission of +C<Protocol>. + +=cut + +requires 'SignEncrypt'; + +=head2 SignEncryptContent Content => STRINGREF, [ Encrypt => 1, Sign => 1, ... ] + +Signs and/or encrypts a string, which is passed by reference. All +arguments and return values are identical to +L<RT::Crypt/SignEncryptContent>, with the omission of C<Protocol>. + +=cut + +requires 'SignEncryptContent'; + +=head2 VerifyDecrypt Info => HASHREF, [ Passphrase => undef ] + +The C<Info> key is a hashref as returned from L</FindScatteredParts> or +L</CheckIfProtected>. This method should alter the mime objects +in-place as necessary during signing and decryption. + +Returns a hash with at least the following keys: + +=over + +=item exit_code + +True if there was an error encrypting or signing. + +=item message + +An un-localized error message desribing the problem. + +=back + +=cut + +requires 'VerifyDecrypt'; + +=head2 DecryptContent Content => STRINGREF, [ Passphrase => undef ] + +Decrypts the content in the string reference in-place. All arguments +and return values are identical to L<RT::Crypt/DecryptContent>, with the +omission of C<Protocol>. + +=cut + +requires 'DecryptContent'; + +=head2 ParseStatus STRING + +Takes a string describing the status of verification/decryption, usually +as stored in a MIME header. Parses and returns it as described in +L<RT::Crypt/ParseStatus>. + +=cut + +requires 'ParseStatus'; + +=head2 FindScatteredParts Parts => ARRAYREF, Parents => HASHREF, Skip => HASHREF + +Passed the list of unclaimed L<MIME::Entity> objects in C<Parts>, this +method should examine them as a whole to determine if there are any that +could not be claimed by the single-entity-at-a-time L</CheckIfProtected> +method. This is generally only necessary in the case of signatures +manually attached in parallel, and the like. + +If found, the relevant entities should be inserted into C<Skip> with a +true value, to signify to other encryption protols that they have been +claimed. The method should return a list of hash references, each +containing a C<Type> key which is either C<signed> or C<encrypted>. The +remaining keys are protocol-dependent; the hashref will be provided to +L</VerifyDecrypt>. + +=cut + +requires 'FindScatteredParts'; + +=head2 CheckIfProtected Entity => MIME::Entity + +Examines the provided L<MIME::Entity>, and returns an empty list if it +is not signed or encrypted using the protocol. If it is, returns a hash +reference containing a C<Type> which is either C<encrypted> or +C<signed>. The remaining keys are protocol-dependent; the hashref will +be provided to L</VerifyDecrypt>. + +=cut + +requires 'CheckIfProtected'; + +=head2 GetKeysInfo Type => ('public'|'private'), Key => EMAIL + +Returns a list of keys matching the email C<Key>, as described in +L<RT::Crypt/GetKeysInfo>. + +=cut + +requires 'GetKeysInfo'; + +=head2 GetKeysForEncryption Recipient => EMAIL + +Returns a list of keys suitable for encryption, as described in +L<RT::Crypt/GetKeysForEncryption>. + +=cut + +requires 'GetKeysForEncryption'; + +=head2 GetKeysForSigning Signer => EMAIL + +Returns a list of keys suitable for encryption, as described in +L<RT::Crypt/GetKeysForSigning>. + +=cut + +requires 'GetKeysForSigning'; + +=head2 ParseDate STRING + +Takes a string, and parses and returns a L<RT::Date>; if the string is +purely numeric, assumes is a epoch timestamp. + +=cut + +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/rt/lib/RT/Crypt/SMIME.pm b/rt/lib/RT/Crypt/SMIME.pm new file mode 100644 index 0000000..a676d8b --- /dev/null +++ b/rt/lib/RT/Crypt/SMIME.pm @@ -0,0 +1,956 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC +# <sales@bestpractical.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# those contributions and any derivatives thereof. +# +# END BPS TAGGED BLOCK }}} + +use strict; +use warnings; +use 5.010; + +package RT::Crypt::SMIME; + +use Role::Basic 'with'; +with 'RT::Crypt::Role'; + +use RT::Crypt; +use File::Which qw(); +use IPC::Run3 0.036 'run3'; +use RT::Util 'safe_run_child'; +use Crypt::X509; +use String::ShellQuote 'shell_quote'; + +=head1 NAME + +RT::Crypt::SMIME - encrypt/decrypt and sign/verify email messages with the SMIME + +=head1 CONFIGURATION + +You should start from reading L<RT::Crypt>. + +=head2 %SMIME + + Set( %SMIME, + Enable => 1, + OpenSSL => '/usr/bin/openssl', + Keyring => '/opt/rt4/var/data/smime', + CAPath => '/opt/rt4/var/data/smime/signing-ca.pem', + Passphrase => { + 'queue.address@example.com' => 'passphrase', + '' => 'fallback', + }, + ); + +=head3 OpenSSL + +Path to openssl executable. + +=head3 Keyring + +Path to directory with keys and certificates for queues. Key and +certificates should be stored in a PEM file named, e.g., +F<email.address@example.com.pem>. See L</Keyring configuration>. + +=head3 CAPath + +C<CAPath> should be set to either a PEM-formatted certificate of a +single signing certificate authority, or a directory of such (including +hash symlinks as created by the openssl tool C<c_rehash>). Only SMIME +certificates signed by these certificate authorities will be treated as +valid signatures. If left unset (and C<AcceptUntrustedCAs> is unset, as +it is by default), no signatures will be marked as valid! + +=head3 AcceptUntrustedCAs + +Allows arbitrary SMIME certificates, no matter their signing entities. +Such mails will be marked as untrusted, but signed; C<CAPath> will be +used to mark which mails are signed by trusted certificate authorities. +This configuration is generally insecure, as it allows the possibility +of accepting forged mail signed by an untrusted certificate authority. + +Setting this option also allows encryption to users with certificates +created by untrusted CAs. + +=head3 Passphrase + +C<Passphrase> may be set to a scalar (to use for all keys), an anonymous +function, or a hash (to look up by address). If the hash is used, the +'' key is used as a default. + +=head2 Keyring configuration + +RT looks for keys in the directory configured in the L</Keyring> option +of the L<RT_Config/%SMIME>. While public certificates are also stored +on users, private SSL keys are only loaded from disk. Keys and +certificates should be concatenated, in in PEM format, in files named +C<email.address@example.com.pem>, for example. + +These files need be readable by the web server user which is running +RT's web interface; however, if you are running cronjobs or other +utilities that access RT directly via API, and may generate +encrypted/signed notifications, then the users you execute these scripts +under must have access too. + +The keyring on disk will be checked before the user with the email +address is examined. If the file exists, it will be used in preference +to the certificate on the user. + +=cut + +sub OpenSSLPath { + state $cache = RT->Config->Get('SMIME')->{'OpenSSL'}; + $cache = $_[1] if @_ > 1; + return $cache; +} + +sub Probe { + my $self = shift; + my $bin = $self->OpenSSLPath(); + unless ($bin) { + $RT::Logger->warning( + "No openssl path set; SMIME support has been disabled. ". + "Check the 'OpenSSL' configuration in %OpenSSL"); + return 0; + } + + if ($bin =~ m{^/}) { + unless (-f $bin and -x _) { + $RT::Logger->warning( + "Invalid openssl path $bin; SMIME support has been disabled. ". + "Check the 'OpenSSL' configuration in %OpenSSL"); + return 0; + } + } else { + local $ENV{PATH} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin' + unless defined $ENV{PATH}; + my $path = File::Which::which( $bin ); + unless ($path) { + $RT::Logger->warning( + "Can't find openssl binary '$bin' in PATH ($ENV{PATH}); SMIME support has been disabled. ". + "You may need to specify a full path to opensssl via the 'OpenSSL' configuration in %OpenSSL"); + return 0; + } + $self->OpenSSLPath( $bin = $path ); + } + + { + my ($buf, $err) = ('', ''); + + local $SIG{'CHLD'} = 'DEFAULT'; + safe_run_child { run3( [$bin, "list-standard-commands"], + \undef, + \$buf, \$err + ) }; + + if ($? or $err) { + $RT::Logger->warning( + "RT's SMIME libraries couldn't successfully execute openssl.". + " SMIME support has been disabled") ; + return; + } elsif ($buf !~ /\bsmime\b/) { + $RT::Logger->warning( + "openssl does not include smime support.". + " SMIME support has been disabled"); + return; + } else { + return 1; + } + } +} + +sub SignEncrypt { + my $self = shift; + my %args = ( + Entity => undef, + + Sign => 1, + Signer => undef, + Passphrase => undef, + + Encrypt => 1, + Recipients => undef, + + @_ + ); + + my $entity = $args{'Entity'}; + + if ( $args{'Encrypt'} ) { + my %seen; + $args{'Recipients'} = [ + grep !$seen{$_}++, map $_->address, map Email::Address->parse(Encode::decode("UTF-8",$_)), + grep defined && length, map $entity->head->get($_), qw(To Cc Bcc) + ]; + } + + $entity->make_multipart('mixed', Force => 1); + my ($buf, %res) = $self->_SignEncrypt( + %args, + Content => \$entity->parts(0)->stringify, + ); + unless ( $buf ) { + $entity->make_singlepart; + return %res; + } + + my $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 ); + my $parser = MIME::Parser->new(); + $parser->output_dir($tmpdir); + my $newmime = $parser->parse_data($$buf); + + # Work around https://rt.cpan.org/Public/Bug/Display.html?id=87835 + for my $part (grep {$_->is_multipart and $_->preamble and @{$_->preamble}} $newmime->parts_DFS) { + $part->preamble->[-1] .= "\n" + if $part->preamble->[-1] =~ /\r$/; + } + + $entity->parts([$newmime]); + $entity->make_singlepart; + + return %res; +} + +sub SignEncryptContent { + my $self = shift; + my %args = ( + Content => undef, + @_ + ); + + my ($buf, %res) = $self->_SignEncrypt(%args); + ${ $args{'Content'} } = $$buf if $buf; + return %res; +} + +sub _SignEncrypt { + my $self = shift; + my %args = ( + Content => undef, + + Sign => 1, + Signer => undef, + Passphrase => undef, + + Encrypt => 1, + Recipients => [], + + @_ + ); + + my %res = (exit_code => 0, status => ''); + + my @keys; + if ( $args{'Encrypt'} ) { + my @addresses = @{ $args{'Recipients'} }; + + foreach my $address ( @addresses ) { + $RT::Logger->debug( "Considering encrypting message to " . $address ); + + my %key_info = $self->GetKeysInfo( Key => $address ); + unless ( defined $key_info{'info'} ) { + $res{'exit_code'} = 1; + my $reason = 'Key not found'; + $res{'status'} .= $self->FormatStatus({ + Operation => "RecipientsCheck", Status => "ERROR", + Message => "Recipient '$address' is unusable, the reason is '$reason'", + Recipient => $address, + Reason => $reason, + }); + next; + } + + if ( not $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( + "Trying to send an encrypted message to ". $address + .", but we couldn't get expiration date of the key." + ); + } + elsif ( $key_info{'info'}[0]{'Expire'}->Diff( time ) < 0 ) { + $res{'exit_code'} = 1; + my $reason = 'Key expired'; + $res{'status'} .= $self->FormatStatus({ + Operation => "RecipientsCheck", Status => "ERROR", + Message => "Recipient '$address' is unusable, the reason is '$reason'", + Recipient => $address, + Reason => $reason, + }); + next; + } + push @keys, $key_info{'info'}[0]{'Content'}; + } + } + return (undef, %res) if $res{'exit_code'}; + + my $opts = RT->Config->Get('SMIME'); + + my @commands; + if ( $args{'Sign'} ) { + my $file = $self->CheckKeyring( Key => $args{'Signer'} ); + unless ($file) { + $res{'status'} .= $self->FormatStatus({ + Operation => "KeyCheck", Status => "MISSING", + Message => "Secret key for $args{Signer} is not available", + Key => $args{Signer}, + KeyType => "secret", + }); + $res{exit_code} = 1; + return (undef, %res); + } + $args{'Passphrase'} = $self->GetPassphrase( Address => $args{'Signer'} ) + unless defined $args{'Passphrase'}; + + push @commands, [ + $self->OpenSSLPath, qw(smime -sign), + -signer => $file, + -inkey => $file, + (defined $args{'Passphrase'} && length $args{'Passphrase'}) + ? (qw(-passin env:SMIME_PASS)) + : (), + ]; + } + if ( $args{'Encrypt'} ) { + foreach my $key ( @keys ) { + my $key_file = File::Temp->new; + print $key_file $key; + close $key_file; + $key = $key_file; + } + push @commands, [ + $self->OpenSSLPath, qw(smime -encrypt -des3), + map { $_->filename } @keys + ]; + } + + my $buf = ${ $args{'Content'} }; + for my $command (@commands) { + my ($out, $err) = ('', ''); + { + local $ENV{'SMIME_PASS'} = $args{'Passphrase'}; + local $SIG{'CHLD'} = 'DEFAULT'; + safe_run_child { run3( + $command, + \$buf, + \$out, \$err + ) }; + } + + $RT::Logger->debug( "openssl stderr: " . $err ) if length $err; + + # copy output from the first command to the second command + # similar to the pipe we used to use to pipe signing -> encryption + # Using the pipe forced us to invoke the shell, this avoids any use of shell. + $buf = $out; + } + + if ($buf) { + $res{'status'} .= $self->FormatStatus({ + Operation => "Sign", Status => "DONE", + Message => "Signed message", + }) if $args{'Sign'}; + $res{'status'} .= $self->FormatStatus({ + Operation => "Encrypt", Status => "DONE", + Message => "Data has been encrypted", + }) if $args{'Encrypt'}; + } + + return (\$buf, %res); +} + +sub VerifyDecrypt { + my $self = shift; + my %args = ( Info => undef, @_ ); + + my %res; + my $item = $args{'Info'}; + if ( $item->{'Type'} eq 'signed' ) { + %res = $self->Verify( %$item ); + } elsif ( $item->{'Type'} eq 'encrypted' ) { + %res = $self->Decrypt( %args, %$item ); + } else { + die "Unknown type '". $item->{'Type'} ."' of protected item"; + } + + return (%res, status_on => $item->{'Data'}); +} + +sub Verify { + my $self = shift; + my %args = (Data => undef, @_ ); + + my $msg = $args{'Data'}->as_string; + + my %res; + my $buf; + my $keyfh = File::Temp->new; + { + local $SIG{CHLD} = 'DEFAULT'; + my $cmd = [ + $self->OpenSSLPath, qw(smime -verify -noverify), + '-signer', $keyfh->filename, + ]; + safe_run_child { run3( $cmd, \$msg, \$buf, \$res{'stderr'} ) }; + $res{'exit_code'} = $?; + } + if ( $res{'exit_code'} ) { + if ($res{stderr} =~ /(signature|digest) failure/) { + $res{'message'} = "Validation failed"; + $res{'status'} = $self->FormatStatus({ + Operation => "Verify", Status => "BAD", + Message => "The signature did not verify", + }); + } else { + $res{'message'} = "openssl exited with error code ". ($? >> 8) + ." and error: $res{stderr}"; + $res{'status'} = $self->FormatStatus({ + Operation => "Verify", Status => "ERROR", + Message => "There was an error verifying: $res{stderr}", + }); + $RT::Logger->error($res{'message'}); + } + return %res; + } + + my $signer; + if ( my $key = do { $keyfh->seek(0, 0); local $/; readline $keyfh } ) {{ + my %info = $self->GetCertificateInfo( Certificate => $key ); + + $signer = $info{info}[0]; + last unless $signer and $signer->{User}[0]{String}; + + unless ( $info{info}[0]{TrustLevel} > 0 or RT->Config->Get('SMIME')->{AcceptUntrustedCAs}) { + # We don't trust it; give it the finger + $res{exit_code} = 1; + $res{'message'} = "Validation failed"; + $res{'status'} = $self->FormatStatus({ + Operation => "Verify", Status => "BAD", + Message => "The signing CA was not trusted", + UserString => $signer->{User}[0]{String}, + Trust => "NONE", + }); + return %res; + } + + my $user = RT::User->new( $RT::SystemUser ); + $user->LoadOrCreateByEmail( $signer->{User}[0]{String} ); + my $current_key = $user->SMIMECertificate; + last if $current_key && $current_key eq $key; + + # Never over-write existing keys with untrusted ones. + last if $current_key and not $info{info}[0]{TrustLevel} > 0; + + my ($status, $msg) = $user->SetSMIMECertificate( $key ); + $RT::Logger->error("Couldn't set SMIME certificate for user #". $user->id .": $msg") + unless $status; + }} + + my $res_entity = _extract_msg_from_buf( \$buf ); + unless ( $res_entity ) { + $res{'exit_code'} = 1; + $res{'message'} = "verified message, but couldn't parse result"; + $res{'status'} = $self->FormatStatus({ + Operation => "Verify", Status => "DONE", + Message => "The signature is good, unknown signer", + Trust => "UNKNOWN", + }); + return %res; + } + + $res_entity->make_multipart( 'mixed', Force => 1 ); + + $args{'Data'}->make_multipart( 'mixed', Force => 1 ); + $args{'Data'}->parts([ $res_entity->parts ]); + $args{'Data'}->make_singlepart; + + $res{'status'} = $self->FormatStatus({ + Operation => "Verify", Status => "DONE", + Message => "The signature is good, signed by ".$signer->{User}[0]{String}.", trust is ".$signer->{TrustTerse}, + UserString => $signer->{User}[0]{String}, + Trust => uc($signer->{TrustTerse}), + }); + + return %res; +} + +sub Decrypt { + my $self = shift; + my %args = (Data => undef, Queue => undef, @_ ); + + my $msg = $args{'Data'}->as_string; + + push @{ $args{'Recipients'} ||= [] }, + $args{'Queue'}->CorrespondAddress, RT->Config->Get('CorrespondAddress'), + $args{'Queue'}->CommentAddress, RT->Config->Get('CommentAddress') + ; + + my ($buf, %res) = $self->_Decrypt( %args, Content => \$args{'Data'}->as_string ); + return %res unless $buf; + + my $res_entity = _extract_msg_from_buf( $buf ); + $res_entity->make_multipart( 'mixed', Force => 1 ); + + # Work around https://rt.cpan.org/Public/Bug/Display.html?id=87835 + for my $part (grep {$_->is_multipart and $_->preamble and @{$_->preamble}} $res_entity->parts_DFS) { + $part->preamble->[-1] .= "\n" + if $part->preamble->[-1] =~ /\r$/; + } + + $args{'Data'}->make_multipart( 'mixed', Force => 1 ); + $args{'Data'}->parts([ $res_entity->parts ]); + $args{'Data'}->make_singlepart; + + return %res; +} + +sub DecryptContent { + my $self = shift; + my %args = ( + Content => undef, + @_ + ); + + my ($buf, %res) = $self->_Decrypt( %args ); + ${ $args{'Content'} } = $$buf if $buf; + return %res; +} + +sub _Decrypt { + my $self = shift; + my %args = (Content => undef, @_ ); + + my %seen; + my @addresses = + grep !$seen{lc $_}++, map $_->address, map Email::Address->parse($_), + grep length && defined, @{$args{'Recipients'}}; + + my ($buf, $encrypted_to, %res); + + foreach my $address ( @addresses ) { + my $file = $self->CheckKeyring( Key => $address ); + unless ( $file ) { + my $keyring = RT->Config->Get('SMIME')->{'Keyring'}; + $RT::Logger->debug("No key found for $address in $keyring directory"); + next; + } + + local $ENV{SMIME_PASS} = $self->GetPassphrase( Address => $address ); + local $SIG{CHLD} = 'DEFAULT'; + my $cmd = [ + $self->OpenSSLPath, + qw(smime -decrypt), + -recip => $file, + (defined $ENV{'SMIME_PASS'} && length $ENV{'SMIME_PASS'}) + ? (qw(-passin env:SMIME_PASS)) + : (), + ]; + safe_run_child { run3( $cmd, $args{'Content'}, \$buf, \$res{'stderr'} ) }; + unless ( $? ) { + $encrypted_to = $address; + $RT::Logger->debug("Message encrypted for $encrypted_to"); + last; + } + + if ( index($res{'stderr'}, 'no recipient matches key') >= 0 ) { + $RT::Logger->debug("Although we have a key for $address, it is not the one that encrypted this message"); + next; + } + + $res{'exit_code'} = $?; + $res{'message'} = "openssl exited with error code ". ($? >> 8) + ." and error: $res{stderr}"; + $RT::Logger->error( $res{'message'} ); + $res{'status'} = $self->FormatStatus({ + Operation => 'Decrypt', Status => 'ERROR', + Message => 'Decryption failed', + EncryptedTo => $address, + }); + return (undef, %res); + } + unless ( $encrypted_to ) { + $RT::Logger->error("Couldn't find SMIME key for addresses: ". join ', ', @addresses); + $res{'exit_code'} = 1; + $res{'status'} = $self->FormatStatus({ + Operation => 'KeyCheck', + Status => 'MISSING', + Message => "Secret key is not available", + KeyType => 'secret', + }); + return (undef, %res); + } + + $res{'status'} = $self->FormatStatus({ + Operation => 'Decrypt', Status => 'DONE', + Message => 'Decryption process succeeded', + EncryptedTo => $encrypted_to, + }); + + return (\$buf, %res); +} + +sub FormatStatus { + my $self = shift; + my @status = @_; + + my $res = ''; + foreach ( @status ) { + while ( my ($k, $v) = each %$_ ) { + $res .= "[SMIME:]". $k .": ". $v ."\n"; + } + $res .= "[SMIME:]\n"; + } + + return $res; +} + +sub ParseStatus { + my $self = shift; + my $status = shift; + return () unless $status; + + my @status = split /\s*(?:\[SMIME:\]\s*){2}/, $status; + foreach my $block ( grep length, @status ) { + chomp $block; + $block = { map { s/^\s+//; s/\s+$//; $_ } map split(/:/, $_, 2), split /\s*\[SMIME:\]/, $block }; + } + foreach my $block ( grep $_->{'EncryptedTo'}, @status ) { + $block->{'EncryptedTo'} = [{ + EmailAddress => $block->{'EncryptedTo'}, + }]; + } + + return @status; +} + +sub _extract_msg_from_buf { + my $buf = shift; + my $rtparser = RT::EmailParser->new(); + my $parser = MIME::Parser->new(); + $rtparser->_SetupMIMEParser($parser); + $parser->decode_bodies(0); + $parser->output_to_core(1); + unless ( $rtparser->{'entity'} = $parser->parse_data($$buf) ) { + $RT::Logger->crit("Couldn't parse MIME stream and extract the submessages"); + + # Try again, this time without extracting nested messages + $parser->extract_nested_messages(0); + unless ( $rtparser->{'entity'} = $parser->parse_data($$buf) ) { + $RT::Logger->crit("couldn't parse MIME stream"); + return (undef); + } + } + return $rtparser->Entity; +} + +sub FindScatteredParts { return () } + +sub CheckIfProtected { + my $self = shift; + my %args = ( Entity => undef, @_ ); + + my $entity = $args{'Entity'}; + + my $type = $entity->effective_type; + if ( $type =~ m{^application/(?:x-)?pkcs7-mime$} || $type eq 'application/octet-stream' ) { + # RFC3851 ch.3.9 variant 1 and 3 + + my $security_type; + + my $smime_type = $entity->head->mime_attr('Content-Type.smime-type'); + if ( $smime_type ) { # it's optional according to RFC3851 + if ( $smime_type eq 'enveloped-data' ) { + $security_type = 'encrypted'; + } + elsif ( $smime_type eq 'signed-data' ) { + $security_type = 'signed'; + } + elsif ( $smime_type eq 'certs-only' ) { + $security_type = 'certificate management'; + } + elsif ( $smime_type eq 'compressed-data' ) { + $security_type = 'compressed'; + } + else { + $security_type = $smime_type; + } + } + + unless ( $security_type ) { + my $fname = $entity->head->recommended_filename || ''; + if ( $fname =~ /\.p7([czsm])$/ ) { + my $type_char = $1; + if ( $type_char eq 'm' ) { + # RFC3851, ch3.4.2 + # it can be both encrypted and signed + $security_type = 'encrypted'; + } + elsif ( $type_char eq 's' ) { + # RFC3851, ch3.4.3, multipart/signed, XXX we should never be here + # unless message is changed by some gateway + $security_type = 'signed'; + } + elsif ( $type_char eq 'c' ) { + # RFC3851, ch3.7 + $security_type = 'certificate management'; + } + elsif ( $type_char eq 'z' ) { + # RFC3851, ch3.5 + $security_type = 'compressed'; + } + } + } + return () unless $security_type; + + my %res = ( + Type => $security_type, + Format => 'RFC3851', + Data => $entity, + ); + + if ( $security_type eq 'encrypted' ) { + my $top = $args{'TopEntity'}->head; + $res{'Recipients'} = [map {Encode::decode("UTF-8", $_)} + grep defined && length, map $top->get($_), 'To', 'Cc']; + } + + return %res; + } + elsif ( $type eq 'multipart/signed' ) { + # RFC3156, multipart/signed + # RFC3851, ch.3.9 variant 2 + + unless ( $entity->parts == 2 ) { + $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" ); + return (); + } + + my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' ); + unless ( $protocol ) { + $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" ); + return (); + } + + unless ( $protocol =~ m{^application/(x-)?pkcs7-signature$} ) { + $RT::Logger->info( "Skipping protocol '$protocol', only 'application/x-pkcs7-signature' is supported" ); + return (); + } + $RT::Logger->debug("Found part signed according to RFC3156"); + return ( + Type => 'signed', + Format => 'RFC3156', + Data => $entity, + ); + } + return (); +} + +sub GetKeysForEncryption { + my $self = shift; + my %args = (Recipient => undef, @_); + return $self->GetKeysInfo( Key => delete $args{'Recipient'}, %args, Type => 'public' ); +} + +sub GetKeysForSigning { + my $self = shift; + my %args = (Signer => undef, @_); + return $self->GetKeysInfo( Key => delete $args{'Signer'}, %args, Type => 'private' ); +} + +sub GetKeysInfo { + my $self = shift; + my %args = ( + Key => undef, + Type => 'public', + Force => 0, + @_ + ); + + my $email = $args{'Key'}; + unless ( $email ) { + return (exit_code => 0); # unless $args{'Force'}; + } + + 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 { + my $user = RT::User->new( RT->SystemUser ); + $user->LoadByEmail( $args{'Key'} ); + $key = $user->SMIMECertificate if $user->id; + } + return $key; +} + +sub CheckKeyring { + my $self = shift; + my %args = ( + Key => undef, + @_, + ); + my $keyring = RT->Config->Get('SMIME')->{'Keyring'}; + return undef unless $keyring; + + 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, + @_, + ); + + if ($args{Certificate} =~ /^-----BEGIN \s+ CERTIFICATE----- \s* $ + (.*?) + ^-----END \s+ CERTIFICATE----- \s* $/smx) { + $args{Certificate} = MIME::Base64::decode_base64($1); + } + + my $cert = Crypt::X509->new( cert => $args{Certificate} ); + return ( exit_code => 1, stderr => $cert->error ) if $cert->error; + + my %USER_MAP = ( + Country => 'country', + StateOrProvince => 'state', + Organization => 'org', + OrganizationUnit => 'ou', + Name => 'cn', + EmailAddress => 'email', + ); + my $canonicalize = sub { + my $type = shift; + my %data; + for (keys %USER_MAP) { + my $method = $type . "_" . $USER_MAP{$_}; + $data{$_} = $cert->$method if $cert->can($method); + } + $data{String} = Email::Address->new( @data{'Name', 'EmailAddress'} )->format + if $data{EmailAddress}; + return \%data; + }; + + my $PEM = "-----BEGIN CERTIFICATE-----\n" + . MIME::Base64::encode_base64( $args{Certificate} ) + . "-----END CERTIFICATE-----\n"; + + my %res = ( + exit_code => 0, + info => [ { + Content => $PEM, + Fingerprint => Digest::SHA::sha1_hex($args{Certificate}), + 'Serial Number' => $cert->serial, + Created => $self->ParseDate( $cert->not_before ), + Expire => $self->ParseDate( $cert->not_after ), + Version => sprintf("%d (0x%x)",hex($cert->version || 0)+1, hex($cert->version || 0)), + Issuer => [ $canonicalize->( 'issuer' ) ], + User => [ $canonicalize->( 'subject' ) ], + } ], + stderr => '' + ); + + # Check the validity + my $ca = RT->Config->Get('SMIME')->{'CAPath'}; + if ($ca) { + my @ca_verify; + if (-d $ca) { + @ca_verify = ('-CApath', $ca); + } elsif (-f $ca) { + @ca_verify = ('-CAfile', $ca); + } + + local $SIG{CHLD} = 'DEFAULT'; + my $cmd = [ + $self->OpenSSLPath, + 'verify', @ca_verify, + ]; + my $buf = ''; + safe_run_child { run3( $cmd, \$PEM, \$buf, \$res{stderr} ) }; + + if ($buf =~ /^stdin: OK$/) { + $res{info}[0]{Trust} = "Signed by trusted CA $res{info}[0]{Issuer}[0]{String}"; + $res{info}[0]{TrustTerse} = "full"; + $res{info}[0]{TrustLevel} = 2; + } elsif ($? == 0 or ($? >> 8) == 2) { + $res{info}[0]{Trust} = "UNTRUSTED signing CA $res{info}[0]{Issuer}[0]{String}"; + $res{info}[0]{TrustTerse} = "none"; + $res{info}[0]{TrustLevel} = -1; + } else { + $res{exit_code} = $?; + $res{message} = "openssl exited with error code ". ($? >> 8) + ." and stout: $buf"; + $res{info}[0]{Trust} = "unknown (openssl failed)"; + $res{info}[0]{TrustTerse} = "unknown"; + $res{info}[0]{TrustLevel} = 0; + } + } else { + $res{info}[0]{Trust} = "unknown (no CAPath set)"; + $res{info}[0]{TrustTerse} = "unknown"; + $res{info}[0]{TrustLevel} = 0; + } + + $res{info}[0]{Formatted} = $res{info}[0]{User}[0]{String} + . " (issued by $res{info}[0]{Issuer}[0]{String})"; + + return %res; +} + +1; |