X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;ds=sidebyside;f=rt%2Flib%2FRT%2FCrypt%2FGnuPG.pm;fp=rt%2Flib%2FRT%2FCrypt%2FGnuPG.pm;h=5581df15339402a6372149893b1eb42015b47eff;hb=b4b0c7e72d7eaee2fbfc7022022c9698323203dd;hp=0000000000000000000000000000000000000000;hpb=2dfda73eeb3eae2d4f894099754794ef07d060dd;p=freeside.git diff --git a/rt/lib/RT/Crypt/GnuPG.pm b/rt/lib/RT/Crypt/GnuPG.pm new file mode 100644 index 000000000..5581df153 --- /dev/null +++ b/rt/lib/RT/Crypt/GnuPG.pm @@ -0,0 +1,2450 @@ +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# +# (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::GnuPG; + +use IO::Handle; +use GnuPG::Interface; +use RT::EmailParser (); +use RT::Util 'safe_run_child'; + +=head1 NAME + +RT::Crypt::GnuPG - encrypt/decrypt and sign/verify email messages with the GNU Privacy Guard (GPG) + +=head1 DESCRIPTION + +This module provides support for encryption and signing of outgoing messages, +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. + +=head2 %GnuPG + +=head3 Enabling GnuPG + +Set to true value to enable this subsystem: + + Set( %GnuPG, + Enable => 1, + ... other options ... + ); + +However, note that you B add the 'Auth::GnuPG' 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: + + Set( %GnuPG, + ... other options ... + OutgoingMessagesFormat => 'RFC', + ... other options ... + ); + +or + + Set( %GnuPG, + ... other options ... + OutgoingMessagesFormat => 'Inline', + ... other options ... + ); + +This framework implements two formats of signing and encrypting of email messages: + +=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). + +=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. + +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. + +=back + +=head3 Encrypting data in the database + +You can allow users to encrypt data in the database using +option C. By default it's disabled. +Users must have rights to see and modify tickets to use +this feature. + +=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. + +Some GnuPG options take arguments while others take none. (Such as --use-agent). +For options without specific value use C as hash value. +To disable these option just comment them out or delete them from the hash + + Set(%GnuPGOptions, + 'option-with-value' => 'value', + 'enabled-option-without-value' => undef, + # 'commented-option' => 'value or undef', + ); + +B that options may contain '-' character and such options B be +quoted, otherwise you can see quite cryptic error 'gpg: Invalid option "--0"'. + +=over + +=item --homedir + +The GnuPG home directory, by default it is set to F. + +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. + +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. + +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. + +=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. + +=item --use-agent + +This option lets you use GPG Agent to cache the passphrase of RT's key. See +L +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. + +=item other + +Read `man gpg` to get list of all options this program support. + +=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', +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. + +As well, encryption is enabled for autoreplies and other notifications when +an encypted message enters system via mailgate interface even if queue's +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. + +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. + +=head3 Problems with public keys + +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". + +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 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 class +available. It's the message RT received. + +=head3 Invalid data + +Template 'Error: bad GnuPG data' used to inform the user that a +message he sent has invalid data and can not be handled. + +There are several reasons for this error, but most of them are data +corruption or absence of expected information. + +In this template C<@Messages> array is available and contains list +of error messages. + +=head1 FOR DEVELOPERS + +=head2 Documentation and references + +* RFC1847 - Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted. +Describes generic MIME security framework, "mulitpart/signed" and "multipart/encrypted" +MIME types. + +* RFC3156 - MIME Security with Pretty Good Privacy (PGP), +updates RFC2015. + +=cut + +# gnupg options supported by GnuPG::Interface +# other otions should be handled via extra_args argument +my %supported_opt = map { $_ => 1 } qw( + always_trust + armor + batch + comment + compress_algo + default_key + encrypt_to + extra_args + force_v3_sigs + homedir + logger_fd + no_greeting + no_options + no_verbose + openpgp + options + passphrase_fd + quiet + recipients + rfc1991 + status_fd + textmode + verbose +); + +# DEV WARNING: always pass all STD* handles to GnuPG interface even if we don't +# need them, just pass 'new IO::Handle' and then close it after safe_run_child. +# we don't want to leak anything into FCGI/Apache/MP handles, this break things. +# So code should look like: +# my $handles = GnuPG::Handles->new( +# stdin => ($handle{'stdin'} = new IO::Handle), +# stdout => ($handle{'stdout'} = new IO::Handle), +# stderr => ($handle{'stderr'} = new IO::Handle), +# ... +# ); + +=head2 SignEncrypt Entity => MIME::Entity, [ Encrypt => 1, Sign => 1, ... ] + +Signs and/or encrypts an email message with GnuPG utility. + +=over + +=item Signing + +During signing you can pass C argument to set key we sign with this option +overrides gnupg's C option. If C argument is not provided +then address of a message sender is used. + +As well you can pass C, but if value is undefined then L +called to get it. + +=item Encrypting + +During encryption you can pass a C array, otherwise C, C and +C fields of the message are used to fetch the list. + +=back + +Returns a hash with the following keys: + +* exit_code +* error +* logger +* status +* message + +=cut + +sub SignEncrypt { + my %args = (@_); + + my $entity = $args{'Entity'}; + if ( $args{'Sign'} && !defined $args{'Signer'} ) { + $args{'Signer'} = UseKeyForSigning() + || (Email::Address->parse( $entity->head->get( 'From' ) ))[0]->address; + } + if ( $args{'Encrypt'} && !$args{'Recipients'} ) { + my %seen; + $args{'Recipients'} = [ + grep $_ && !$seen{ $_ }++, map $_->address, + map Email::Address->parse( $entity->head->get( $_ ) ), + qw(To Cc Bcc) + ]; + } + + my $format = lc RT->Config->Get('GnuPG')->{'OutgoingMessagesFormat'} || 'RFC'; + if ( $format eq 'inline' ) { + return SignEncryptInline( %args ); + } else { + return SignEncryptRFC3156( %args ); + } +} + +sub SignEncryptRFC3156 { + my %args = ( + Entity => undef, + + Sign => 1, + Signer => undef, + Passphrase => undef, + + Encrypt => 1, + Recipients => undef, + + @_ + ); + + my $gnupg = new GnuPG::Interface; + 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) + foreach ( grep !$_->is_multipart, $entity->parts_DFS ) { + my $tenc = $_->head->mime_encoding; + unless ( $tenc =~ m/^(?:7bit|quoted-printable|base64)$/i ) { + $_->head->mime_attr( 'Content-Transfer-Encoding' + => $_->effective_type =~ m{^text/}? 'quoted-printable': 'base64' + ); + } + } + + 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; + } + + # setup RFC1847(Ch.2.1) requirements + my $protocol = 'application/pgp-signature'; + $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->attach( + Type => $protocol, + Disposition => 'inline', + Data => \@signature, + Encoding => '7bit', + ); + } + if ( $args{'Encrypt'} ) { + my %seen; + $gnupg->options->push_recipients( $_ ) foreach + map UseKeyForEncryption($_) || $_, + grep !$seen{ $_ }++, map $_->address, + map Email::Address->parse( $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; + } + + my $protocol = 'application/pgp-encrypted'; + $entity->parts([]); + $entity->head->mime_attr( 'Content-Type' => 'multipart/encrypted' ); + $entity->head->mime_attr( 'Content-Type.protocol' => $protocol ); + $entity->attach( + Type => $protocol, + Disposition => 'inline', + Data => ['Version: 1',''], + Encoding => '7bit', + ); + $entity->attach( + Type => 'application/octet-stream', + Disposition => 'inline', + Path => $tmp_fn, + Filename => '', + Encoding => '7bit', + ); + $entity->parts(-1)->bodyhandle->{'_dirty_hack_to_save_a_ref_tmp_fh'} = $tmp_fh; + } + return %res; +} + +sub SignEncryptInline { + my %args = ( @_ ); + + my $entity = $args{'Entity'}; + + my %res; + $entity->make_singlepart; + if ( $entity->is_multipart ) { + foreach ( $entity->parts ) { + %res = SignEncryptInline( @_, Entity => $_ ); + return %res if $res{'exit_code'}; + } + return %res; + } + + return _SignEncryptTextInline( @_ ) + if $entity->effective_type =~ /^text\//i; + + return _SignEncryptAttachmentInline( @_ ); +} + +sub _SignEncryptTextInline { + my %args = ( + Entity => undef, + + Sign => 1, + Signer => undef, + Passphrase => undef, + + Encrypt => 1, + Recipients => undef, + + @_ + ); + return unless $args{'Sign'} || $args{'Encrypt'}; + + my $gnupg = new GnuPG::Interface; + 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; + } + + $entity->bodyhandle( new MIME::Body::File $tmp_fn ); + $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh; + + return %res; +} + +sub _SignEncryptAttachmentInline { + my %args = ( + Entity => undef, + + Sign => 1, + Signer => undef, + Passphrase => undef, + + Encrypt => 1, + Recipients => undef, + + @_ + ); + return unless $args{'Sign'} || $args{'Encrypt'}; + + my $gnupg = new GnuPG::Interface; + 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 $filename = $entity->head->recommended_filename || 'no_name'; + if ( $args{'Sign'} && !$args{'Encrypt'} ) { + $entity->make_multipart; + $entity->attach( + Type => 'application/octet-stream', + Path => $tmp_fn, + Filename => "$filename.sig", + Disposition => 'attachment', + ); + } else { + $entity->bodyhandle( new MIME::Body::File $tmp_fn ); + $entity->effective_type('application/octet-stream'); + $entity->head->mime_attr( $_ => "$filename.pgp" ) + foreach (qw(Content-Type.name Content-Disposition.filename)); + + } + $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh; + + return %res; +} + +sub SignEncryptContent { + my %args = ( + Content => undef, + + Sign => 1, + Signer => undef, + Passphrase => undef, + + Encrypt => 1, + Recipients => undef, + + @_ + ); + return unless $args{'Sign'} || $args{'Encrypt'}; + + my $gnupg = new GnuPG::Interface; + 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; + } + + ${ $args{'Content'} } = ''; + seek $tmp_fh, 0, 0; + while (1) { + my $status = read $tmp_fh, my $buf, 4*1024; + unless ( defined $status ) { + $RT::Logger->crit( "couldn't read message: $!" ); + } elsif ( !$status ) { + last; + } + ${ $args{'Content'} } .= $buf; + } + + return %res; +} + +sub FindProtectedParts { + my %args = ( Entity => undef, CheckBody => 1, @_ ); + my $entity = $args{'Entity'}; + + # inline PGP block, only in singlepart + unless ( $entity->is_multipart ) { + my $io = $entity->open('r'); + unless ( $io ) { + $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" ); + return (); + } + 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 => 'Inline', + Data => $entity, + }; + } + $io->close; + 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 (); + } + + 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 { + Type => 'signed', + Format => 'RFC3156', + Top => $entity, + Data => $entity->parts(0), + Signature => $entity->parts(1), + }; + } + } + + # attachments signed with signature in another part + my @file_indices; + foreach my $i ( 0 .. $entity->parts - 1 ) { + my $part = $entity->parts($i); + + # 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; + } + elsif ( $fname =~ /\.sig$/i && $part->effective_type eq 'application/octet-stream' ) { + push @file_indices, $i; + } + } + + 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); + + $skip{"$data_part_in"}++; + $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'"); + push @res, { + Type => 'signed', + Format => 'Attachment', + Top => $entity, + Data => $data_part_in, + Signature => $sig_part, + }; + } + + # attachments with inline encryption + my @encrypted_indices = + grep {($entity->parts($_)->head->recommended_filename || '') =~ /\.pgp$/} + 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 ."'"); + push @res, { + Type => 'encrypted', + Format => 'Attachment', + Top => $entity, + Data => $part, + }; + } + + push @res, FindProtectedParts( Entity => $_ ) + foreach grep !$skip{"$_"}, $entity->parts; + + return @res; +} + +=head2 VerifyDecrypt Entity => undef, [ Detach => 1, Passphrase => undef, SetStatus => 1 ] + +=cut + +sub VerifyDecrypt { + my %args = ( Entity => undef, Detach => 1, SetStatus => 1, @_ ); + my @protected = FindProtectedParts( Entity => $args{'Entity'} ); + my @res; + # XXX: detaching may brake nested signatures + foreach my $item( grep $_->{'Type'} eq 'signed', @protected ) { + if ( $item->{'Format'} eq 'RFC3156' ) { + push @res, { VerifyRFC3156( %$item, SetStatus => $args{'SetStatus'} ) }; + if ( $args{'Detach'} ) { + $item->{'Top'}->parts( [ $item->{'Data'} ] ); + $item->{'Top'}->make_singlepart; + } + $item->{'Top'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} ) + if $args{'SetStatus'}; + } elsif ( $item->{'Format'} eq 'Inline' ) { + push @res, { VerifyInline( %$item ) }; + $item->{'Data'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} ) + if $args{'SetStatus'}; + } 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; + } + $item->{'Data'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} ) + if $args{'SetStatus'}; + } + } + foreach my $item( grep $_->{'Type'} eq 'encrypted', @protected ) { + if ( $item->{'Format'} eq 'RFC3156' ) { + push @res, { DecryptRFC3156( %$item ) }; + $item->{'Top'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} ) + if $args{'SetStatus'}; + } elsif ( $item->{'Format'} eq 'Inline' ) { + push @res, { DecryptInline( %$item ) }; + $item->{'Data'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} ) + if $args{'SetStatus'}; + } elsif ( $item->{'Format'} eq 'Attachment' ) { + push @res, { DecryptAttachment( %$item ) }; + $item->{'Data'}->head->set( 'X-RT-GnuPG-Status' => $res[-1]->{'status'} ) + if $args{'SetStatus'}; + } + } + return @res; +} + +sub VerifyInline { return DecryptInline( @_ ) } + +sub VerifyAttachment { + my %args = ( Data => undef, Signature => undef, Top => undef, @_ ); + + my $gnupg = new GnuPG::Interface; + my %opt = RT->Config->Get('GnuPGOptions'); + $opt{'digest-algo'} ||= 'SHA1'; + $gnupg->options->hash_init( + _PrepareGnuPGOptions( %opt ), + meta_interactive => 0, + ); + + foreach ( $args{'Data'}, $args{'Signature'} ) { + next unless $_->bodyhandle->is_encoded; + + require RT::EmailParser; + RT::EmailParser->_DecodeBody($_); + } + + my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 ); + binmode $tmp_fh, ':raw'; + $args{'Data'}->bodyhandle->print( $tmp_fh ); + $tmp_fh->flush; + + my ($handles, $handle_list) = _make_gpg_handles(); + my %handle = %$handle_list; + + 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 = new GnuPG::Interface; + my %opt = RT->Config->Get('GnuPGOptions'); + $opt{'digest-algo'} ||= 'SHA1'; + $gnupg->options->hash_init( + _PrepareGnuPGOptions( %opt ), + meta_interactive => 0, + ); + + 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; + 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 %args = ( + Data => undef, + Info => undef, + Top => undef, + Passphrase => undef, + @_ + ); + + my $gnupg = new GnuPG::Interface; + 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'} && $?; + + # 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; + } + } + + seek $tmp_fh, 0, 0; + my $parser = new RT::EmailParser; + 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'}->make_singlepart; + return %res; +} + +sub DecryptInline { + my %args = ( + Data => undef, + Passphrase => undef, + @_ + ); + + my $gnupg = new GnuPG::Interface; + 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 $io = $args{'Data'}->open('r'); + unless ( $io ) { + die "Entity has no body, never should happen"; + } + + my ($had_literal, $in_block) = ('', 0); + my ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 ); + binmode $block_fh, ':raw'; + + my %res; + while ( defined(my $str = $io->getline) ) { + if ( $in_block && $str =~ /^-----END PGP (?:MESSAGE|SIGNATURE)-----/ ) { + print $block_fh $str; + $in_block--; + next if $in_block > 0; + + seek $block_fh, 0, 0; + + my ($res_fh, $res_fn); + ($res_fh, $res_fn, %res) = _DecryptInlineBlock( + %args, + GnuPG => $gnupg, + BlockHandle => $block_fh, + ); + return %res unless $res_fh; + + print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal; + while (my $buf = <$res_fh> ) { + print $tmp_fh $buf; + } + print $tmp_fh "-----END OF PART-----\n" if $had_literal; + + ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 ); + binmode $block_fh, ':raw'; + $in_block = 0; + } + elsif ( $str =~ /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) { + $in_block++; + print $block_fh $str; + } + elsif ( $in_block ) { + print $block_fh $str; + } + else { + print $tmp_fh $str; + $had_literal = 1 if /\S/s; + } + } + $io->close; + + seek $tmp_fh, 0, 0; + $args{'Data'}->bodyhandle( new MIME::Body::File $tmp_fn ); + $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh; + return %res; +} + +sub _DecryptInlineBlock { + 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'} && $?; + + # 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); + } + } + + seek $tmp_fh, 0, 0; + return ($tmp_fh, $tmp_fn, %res); +} + +sub DecryptAttachment { + my %args = ( + Top => undef, + Data => undef, + Passphrase => undef, + @_ + ); + + my $gnupg = new GnuPG::Interface; + 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( + %args, + GnuPG => $gnupg, + BlockHandle => $tmp_fh, + ); + return %res unless $res_fh; + + $args{'Data'}->bodyhandle( new MIME::Body::File $res_fn ); + $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $res_fh; + + my $filename = $args{'Data'}->head->recommended_filename; + $filename =~ s/\.pgp$//i; + $args{'Data'}->head->mime_attr( $_ => $filename ) + foreach (qw(Content-Type.name Content-Disposition.filename)); + + return %res; +} + +sub DecryptContent { + my %args = ( + Content => undef, + Passphrase => undef, + @_ + ); + + my $gnupg = new GnuPG::Interface; + 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'} && $?; + + # 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; + } + } + + ${ $args{'Content'} } = ''; + seek $tmp_fh, 0, 0; + while (1) { + my $status = read $tmp_fh, my $buf, 4*1024; + unless ( defined $status ) { + $RT::Logger->crit( "couldn't read message: $!" ); + } elsif ( !$status ) { + last; + } + ${ $args{'Content'} } .= $buf; + } + + 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, see also +F in the RT distribution. + +=cut + +my %REASON_CODE_TO_TEXT = ( + NODATA => { + 1 => "No armored data", + 2 => "Expected a packet, but did not found one", + 3 => "Invalid packet found", + 4 => "Signature expected, but not found", + }, + INV_RECP => { + 0 => "No specific reason given", + 1 => "Not Found", + 2 => "Ambigious specification", + 3 => "Wrong key usage", + 4 => "Key revoked", + 5 => "Key expired", + 6 => "No CRL known", + 7 => "CRL too old", + 8 => "Policy mismatch", + 9 => "Not a secret key", + 10 => "Key not trusted", + }, + ERRSIG => { + 0 => 'not specified', + 4 => 'unknown algorithm', + 9 => 'missing public key', + }, +); + +sub ReasonCodeToText { + my $keyword = shift; + my $code = shift; + return $REASON_CODE_TO_TEXT{ $keyword }{ $code } + if exists $REASON_CODE_TO_TEXT{ $keyword }{ $code }; + return 'unknown'; +} + +my %simple_keyword = ( + NO_RECP => { + Operation => 'RecipientsCheck', + Status => 'ERROR', + Message => 'No recipients', + }, + UNEXPECTED => { + Operation => 'Data', + Status => 'ERROR', + Message => 'Unexpected data has been encountered', + }, + BADARMOR => { + Operation => 'Data', + Status => 'ERROR', + Message => 'The ASCII armor is corrupted', + }, +); + +# keywords we parse +my %parse_keyword = map { $_ => 1 } qw( + USERID_HINT + SIG_CREATED GOODSIG BADSIG ERRSIG + END_ENCRYPTION + DECRYPTION_FAILED DECRYPTION_OKAY + BAD_PASSPHRASE GOOD_PASSPHRASE + NO_SECKEY NO_PUBKEY + NO_RECP INV_RECP NODATA UNEXPECTED +); + +# keywords we ignore without any messages as we parse them using other +# keywords as starting point or just ignore as they are useless for us +my %ignore_keyword = map { $_ => 1 } qw( + NEED_PASSPHRASE MISSING_PASSPHRASE BEGIN_SIGNING PLAINTEXT PLAINTEXT_LENGTH + BEGIN_ENCRYPTION SIG_ID VALIDSIG + ENC_TO BEGIN_DECRYPTION END_DECRYPTION GOODMDC + TRUST_UNDEFINED TRUST_NEVER TRUST_MARGINAL TRUST_FULLY TRUST_ULTIMATE +); + +sub ParseStatus { + my $status = shift; + return () unless $status; + + my @status; + while ( $status =~ /\[GNUPG:\]\s*(.*?)(?=\[GNUPG:\]|\z)/igms ) { + push @status, $1; $status[-1] =~ s/\s+/ /g; $status[-1] =~ s/\s+$//; + } + $status = join "\n", @status; + study $status; + + my @res; + my (%user_hint, $latest_user_main_key); + for ( my $i = 0; $i < @status; $i++ ) { + my $line = $status[$i]; + my ($keyword, $args) = ($line =~ /^(\S+)\s*(.*)$/s); + if ( $simple_keyword{ $keyword } ) { + push @res, $simple_keyword{ $keyword }; + $res[-1]->{'Keyword'} = $keyword; + next; + } + unless ( $parse_keyword{ $keyword } ) { + $RT::Logger->warning("Skipped $keyword") unless $ignore_keyword{ $keyword }; + next; + } + + if ( $keyword eq 'USERID_HINT' ) { + my %tmp = _ParseUserHint($status, $line); + $latest_user_main_key = $tmp{'MainKey'}; + if ( $user_hint{ $tmp{'MainKey'} } ) { + while ( my ($k, $v) = each %tmp ) { + $user_hint{ $tmp{'MainKey'} }->{$k} = $v; + } + } else { + $user_hint{ $tmp{'MainKey'} } = \%tmp; + } + next; + } + elsif ( $keyword eq 'BAD_PASSPHRASE' || $keyword eq 'GOOD_PASSPHRASE' ) { + my $key_id = $args; + my %res = ( + Operation => 'PassphraseCheck', + Status => $keyword eq 'BAD_PASSPHRASE'? 'BAD' : 'DONE', + Key => $key_id, + ); + $res{'Status'} = 'MISSING' if $status[ $i - 1 ] =~ /^MISSING_PASSPHRASE/; + foreach my $line ( reverse @status[ 0 .. $i-1 ] ) { + next unless $line =~ /^NEED_PASSPHRASE\s+(\S+)\s+(\S+)\s+(\S+)/; + next if $key_id && $2 ne $key_id; + @res{'MainKey', 'Key', 'KeyType'} = ($1, $2, $3); + last; + } + $res{'Message'} = ucfirst( lc( $res{'Status'} eq 'DONE'? 'GOOD': $res{'Status'} ) ) .' passphrase'; + $res{'User'} = ( $user_hint{ $res{'MainKey'} } ||= {} ) if $res{'MainKey'}; + if ( exists $res{'User'}->{'EmailAddress'} ) { + $res{'Message'} .= ' for '. $res{'User'}->{'EmailAddress'}; + } else { + $res{'Message'} .= " for '0x$key_id'"; + } + push @res, \%res; + } + elsif ( $keyword eq 'END_ENCRYPTION' ) { + my %res = ( + Operation => 'Encrypt', + Status => 'DONE', + Message => 'Data has been encrypted', + ); + foreach my $line ( reverse @status[ 0 .. $i-1 ] ) { + next unless $line =~ /^BEGIN_ENCRYPTION\s+(\S+)\s+(\S+)/; + @res{'MdcMethod', 'SymAlgo'} = ($1, $2); + last; + } + push @res, \%res; + } + elsif ( $keyword eq 'DECRYPTION_FAILED' || $keyword eq 'DECRYPTION_OKAY' ) { + my %res = ( Operation => 'Decrypt' ); + @res{'Status', 'Message'} = + $keyword eq 'DECRYPTION_FAILED' + ? ('ERROR', 'Decryption failed') + : ('DONE', 'Decryption process succeeded'); + + foreach my $line ( reverse @status[ 0 .. $i-1 ] ) { + next unless $line =~ /^ENC_TO\s+(\S+)\s+(\S+)\s+(\S+)/; + my ($key, $alg, $key_length) = ($1, $2, $3); + + my %encrypted_to = ( + Message => "The message is encrypted to '0x$key'", + User => ( $user_hint{ $key } ||= {} ), + Key => $key, + KeyLength => $key_length, + Algorithm => $alg, + ); + + push @{ $res{'EncryptedTo'} ||= [] }, \%encrypted_to; + } + + push @res, \%res; + } + elsif ( $keyword eq 'NO_SECKEY' || $keyword eq 'NO_PUBKEY' ) { + my ($key) = split /\s+/, $args; + my $type = $keyword eq 'NO_SECKEY'? 'secret': 'public'; + my %res = ( + Operation => 'KeyCheck', + Status => 'MISSING', + Message => ucfirst( $type ) ." key '0x$key' is not available", + Key => $key, + KeyType => $type, + ); + $res{'User'} = ( $user_hint{ $key } ||= {} ); + $res{'User'}{ ucfirst( $type ). 'KeyMissing' } = 1; + push @res, \%res; + } + # GOODSIG, BADSIG, VALIDSIG, TRUST_* + elsif ( $keyword eq 'GOODSIG' ) { + my %res = ( + Operation => 'Verify', + Status => 'DONE', + Message => 'The signature is good', + ); + @res{qw(Key UserString)} = split /\s+/, $args, 2; + $res{'Message'} .= ', signed by '. $res{'UserString'}; + + foreach my $line ( @status[ $i .. $#status ] ) { + next unless $line =~ /^TRUST_(\S+)/; + $res{'Trust'} = $1; + last; + } + $res{'Message'} .= ', trust level is '. lc( $res{'Trust'} || 'unknown'); + + foreach my $line ( @status[ $i .. $#status ] ) { + next unless $line =~ /^VALIDSIG\s+(.*)/; + @res{ qw( + Fingerprint + CreationDate + Timestamp + ExpireTimestamp + Version + Reserved + PubkeyAlgo + HashAlgo + Class + PKFingerprint + Other + ) } = split /\s+/, $1, 10; + last; + } + push @res, \%res; + } + elsif ( $keyword eq 'BADSIG' ) { + my %res = ( + Operation => 'Verify', + Status => 'BAD', + Message => 'The signature has not been verified okay', + ); + @res{qw(Key UserString)} = split /\s+/, $args, 2; + push @res, \%res; + } + elsif ( $keyword eq 'ERRSIG' ) { + my %res = ( + Operation => 'Verify', + Status => 'ERROR', + Message => 'Not possible to check the signature', + ); + @res{qw(Key PubkeyAlgo HashAlgo Class Timestamp ReasonCode Other)} + = split /\s+/, $args, 7; + + $res{'Reason'} = ReasonCodeToText( $keyword, $res{'ReasonCode'} ); + $res{'Message'} .= ", the reason is ". $res{'Reason'}; + + push @res, \%res; + } + elsif ( $keyword eq 'SIG_CREATED' ) { + # SIG_CREATED + my @props = split /\s+/, $args; + push @res, { + Operation => 'Sign', + Status => 'DONE', + Message => "Signed message", + Type => $props[0], + PubKeyAlgo => $props[1], + HashKeyAlgo => $props[2], + Class => $props[3], + Timestamp => $props[4], + KeyFingerprint => $props[5], + User => $user_hint{ $latest_user_main_key }, + }; + $res[-1]->{Message} .= ' by '. $user_hint{ $latest_user_main_key }->{'EmailAddress'} + if $user_hint{ $latest_user_main_key }; + } + elsif ( $keyword eq 'INV_RECP' ) { + my ($rcode, $recipient) = split /\s+/, $args, 2; + my $reason = ReasonCodeToText( $keyword, $rcode ); + push @res, { + Operation => 'RecipientsCheck', + Status => 'ERROR', + Message => "Recipient '$recipient' is unusable, the reason is '$reason'", + Recipient => $recipient, + ReasonCode => $rcode, + Reason => $reason, + }; + } + elsif ( $keyword eq 'NODATA' ) { + my $rcode = (split /\s+/, $args)[0]; + my $reason = ReasonCodeToText( $keyword, $rcode ); + push @res, { + Operation => 'Data', + Status => 'ERROR', + Message => "No data has been found. The reason is '$reason'", + ReasonCode => $rcode, + Reason => $reason, + }; + } + else { + $RT::Logger->warning("Keyword $keyword is unknown"); + next; + } + $res[-1]{'Keyword'} = $keyword if @res && !$res[-1]{'Keyword'}; + } + return @res; +} + +sub _ParseUserHint { + my ($status, $hint) = (@_); + my ($main_key_id, $user_str) = ($hint =~ /^USERID_HINT\s+(\S+)\s+(.*)$/); + return () unless $main_key_id; + return ( + MainKey => $main_key_id, + String => $user_str, + EmailAddress => (map $_->address, Email::Address->parse( $user_str ))[0], + ); +} + +sub _PrepareGnuPGOptions { + my %opt = @_; + my %res = map { lc $_ => $opt{ $_ } } grep $supported_opt{ lc $_ }, keys %opt; + $res{'extra_args'} ||= []; + foreach my $o ( grep !$supported_opt{ lc $_ }, keys %opt ) { + push @{ $res{'extra_args'} }, '--'. lc $o; + push @{ $res{'extra_args'} }, $opt{ $o } + if defined $opt{ $o }; + } + 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 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', @_ ); + return %res if $res{'exit_code'}; + return %res unless $res{'info'}; + + foreach my $key ( splice @{ $res{'info'} } ) { + # skip disabled keys + 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, + # but leave keys with unknown trust level + next if $key->{'TrustLevel'} < 0; + + push @{ $res{'info'} }, $key; + } + delete $res{'info'} unless @{ $res{'info'} }; + return %res; +} + +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; +} + +sub GetKeysInfo { + my $email = shift; + my $type = shift || 'public'; + my $force = shift; + + unless ( $email ) { + return (exit_code => 0) unless $force; + } + + my $gnupg = new GnuPG::Interface; + 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, + ); + + my %res; + + my ($handles, $handle_list) = _make_gpg_handles(); + my %handle = %$handle_list; + + 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'}; + + $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; + } + + @info = ParseKeysInfo( @info ); + $res{'info'} = \@info; + return %res; +} + +sub ParseKeysInfo { + my @lines = @_; + + my %gpg_opt = RT->Config->Get('GnuPGOptions'); + + my @res = (); + foreach my $line( @lines ) { + chomp $line; + my $tag; + ($tag, $line) = split /:/, $line, 2; + if ( $tag eq 'pub' ) { + my %info; + @info{ qw( + TrustChar KeyLength Algorithm Key + Created Expire Empty OwnerTrustChar + Empty Empty Capabilities Other + ) } = split /:/, $line, 12; + + # workaround gnupg's wierd behaviour, --list-keys command report calculated trust levels + # for any model except 'always', so you can change models and see changes, but not for 'always' + # we try to handle it in a simple way - we set ultimate trust for any key with trust + # level >= 0 if trust model is 'always' + my $always_trust; + $always_trust = 1 if exists $gpg_opt{'always-trust'}; + $always_trust = 1 if exists $gpg_opt{'trust-model'} && $gpg_opt{'trust-model'} eq 'always'; + @info{qw(Trust TrustTerse TrustLevel)} = + _ConvertTrustChar( $info{'TrustChar'} ); + if ( $always_trust && $info{'TrustLevel'} >= 0 ) { + @info{qw(Trust TrustTerse TrustLevel)} = + _ConvertTrustChar( 'u' ); + } + + @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} = + _ConvertTrustChar( $info{'OwnerTrustChar'} ); + $info{ $_ } = _ParseDate( $info{ $_ } ) + foreach qw(Created Expire); + push @res, \%info; + } + elsif ( $tag eq 'sec' ) { + my %info; + @info{ qw( + Empty KeyLength Algorithm Key + Created Expire Empty OwnerTrustChar + Empty Empty Capabilities Other + ) } = split /:/, $line, 12; + @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} = + _ConvertTrustChar( $info{'OwnerTrustChar'} ); + $info{ $_ } = _ParseDate( $info{ $_ } ) + foreach qw(Created Expire); + push @res, \%info; + } + elsif ( $tag eq 'uid' ) { + my %info; + @info{ qw(Trust Created Expire String) } + = (split /:/, $line)[0,4,5,8]; + $info{ $_ } = _ParseDate( $info{ $_ } ) + foreach qw(Created Expire); + push @{ $res[-1]{'User'} ||= [] }, \%info; + } + elsif ( $tag eq 'fpr' ) { + $res[-1]{'Fingerprint'} = (split /:/, $line, 10)[8]; + } + } + return @res; +} + +{ + my %verbose = ( + # deprecated + d => [ + "The key has been disabled", #loc + "key disabled", #loc + "-2" + ], + + r => [ + "The key has been revoked", #loc + "key revoked", #loc + -3, + ], + + e => [ "The key has expired", #loc + "key expired", #loc + '-4', + ], + + n => [ "Don't trust this key at all", #loc + 'none', #loc + -1, + ], + + #gpupg docs says that '-' and 'q' may safely be treated as the same value + '-' => [ + 'Unknown (no trust value assigned)', #loc + 'not set', + 0, + ], + q => [ + 'Unknown (no trust value assigned)', #loc + 'not set', + 0, + ], + o => [ + 'Unknown (this value is new to the system)', #loc + 'unknown', + 0, + ], + + m => [ + "There is marginal trust in this key", #loc + 'marginal', #loc + 1, + ], + f => [ + "The key is fully trusted", #loc + 'full', #loc + 2, + ], + u => [ + "The key is ultimately trusted", #loc + 'ultimate', #loc + 3, + ], + ); + + sub _ConvertTrustChar { + my $value = shift; + return @{ $verbose{'-'} } unless $value; + $value = substr $value, 0, 1; + return @{ $verbose{ $value } || $verbose{'o'} }; + } +} + +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 $key = shift; + + my $gnupg = new GnuPG::Interface; + 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'; + local @ENV{'LANG', 'LC_ALL'} = ('C', 'C'); + 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"; + } + } + 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 $key = shift; + + my $gnupg = new GnuPG::Interface; + 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'; + local @ENV{'LANG', 'LC_ALL'} = ('C', 'C'); + 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; +} + +1; + +=head2 Probe + +This routine returns true if RT's GnuPG support is configured and working +properly (and false otherwise). + + +=cut + + +sub Probe { + my $gnupg = new GnuPG::Interface; + my %opt = RT->Config->Get('GnuPGOptions'); + $gnupg->options->hash_init( + _PrepareGnuPGOptions( %opt ), + armor => 1, + meta_interactive => 0, + ); + + my ($handles, $handle_list) = _make_gpg_handles(); + my %handle = %$handle_list; + + local $@; + eval { + local $SIG{'CHLD'} = 'DEFAULT'; + my $pid = safe_run_child { $gnupg->wrap_call( commands => ['--version' ], handles => $handles ) }; + close $handle{'stdin'}; + waitpid $pid, 0; + }; + if ( $@ ) { + $RT::Logger->debug( + "Probe for GPG failed." + ." Couldn't run `gpg --version`: ". $@ + ); + return 0; + } + +# on some systems gpg exits with code 2, but still 100% functional, +# it's general error system error or incorrect command, command is correct, +# but there is no way to get actuall error + if ( $? && ($? >> 8) != 2 ) { + $RT::Logger->debug( + "Probe for GPG failed." + ." Process exitted with code ". ($? >> 8) + . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '') + ); + return 0; + } + return 1; +} + + +sub _make_gpg_handles { + my %handle_map = ( + stdin => IO::Handle->new(), + stdout => IO::Handle->new(), + stderr => IO::Handle->new(), + logger => IO::Handle->new(), + status => IO::Handle->new(), + command => IO::Handle->new(), + + + @_); + + my $handles = GnuPG::Handles->new(%handle_map); + return ($handles, \%handle_map); +} + +eval "require RT::Crypt::GnuPG_Vendor"; +if ($@ && $@ !~ qr{^Can't locate RT/Crypt/GnuPG_Vendor.pm}) { + die $@; +}; + +eval "require RT::Crypt::GnuPG_Local"; +if ($@ && $@ !~ qr{^Can't locate RT/Crypt/GnuPG_Local.pm}) { + die $@; +}; + +# 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;