1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 # General Public License for more details.
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
30 # CONTRIBUTION SUBMISSION POLICY:
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
47 # END BPS TAGGED BLOCK }}}
52 package RT::Crypt::GnuPG;
56 use RT::EmailParser ();
57 use RT::Util 'safe_run_child', 'mime_recommended_filename';
61 RT::Crypt::GnuPG - encrypt/decrypt and sign/verify email messages with the GNU Privacy Guard (GPG)
65 This module provides support for encryption and signing of outgoing messages,
66 as well as the decryption and verification of incoming email.
70 You can control the configuration of this subsystem from RT's configuration file.
71 Some options are available via the web interface, but to enable this functionality, you
72 MUST start in the configuration file.
74 There are two hashes, GnuPG and GnuPGOptions in the configuration file. The
75 first one controls RT specific options. It enables you to enable/disable facility
76 or change the format of messages. The second one is a hash with options for the
77 'gnupg' utility. You can use it to define a keyserver, enable auto-retrieval keys
78 and set almost any option 'gnupg' supports on your system.
84 Set to true value to enable this subsystem:
91 However, note that you B<must> add the 'Auth::GnuPG' email filter to enable
92 the handling of incoming encrypted/signed messages.
94 =head3 Format of outgoing messages
96 Format of outgoing messages can be controlled using the 'OutgoingMessagesFormat'
97 option in the RT config:
100 ... other options ...
101 OutgoingMessagesFormat => 'RFC',
102 ... other options ...
108 ... other options ...
109 OutgoingMessagesFormat => 'Inline',
110 ... other options ...
113 This framework implements two formats of signing and encrypting of email messages:
119 This format is also known as GPG/MIME and described in RFC3156 and RFC1847.
120 Technique described in these RFCs is well supported by many mail user
121 agents (MUA), but some MUAs support only inline signatures and encryption,
122 so it's possible to use inline format (see below).
126 This format doesn't take advantage of MIME, but some mail clients do
127 not support GPG/MIME.
129 We sign text parts using clear signatures. For each attachments another
130 attachment with a signature is added with '.sig' extension.
132 Encryption of text parts is implemented using inline format, other parts
133 are replaced with attachments with the filename extension '.pgp'.
135 This format is discouraged because modern mail clients typically don't support
140 =head3 Encrypting data in the database
142 You can allow users to encrypt data in the database using
143 option C<AllowEncryptDataInDB>. By default it's disabled.
144 Users must have rights to see and modify tickets to use
149 Use this hash to set options of the 'gnupg' program. You can define almost any
150 option you want which gnupg supports, but never try to set options which
151 change output format or gnupg's commands, such as --sign (command),
152 --list-options (option) and other.
154 Some GnuPG options take arguments while others take none. (Such as --use-agent).
155 For options without specific value use C<undef> as hash value.
156 To disable these option just comment them out or delete them from the hash
159 'option-with-value' => 'value',
160 'enabled-option-without-value' => undef,
161 # 'commented-option' => 'value or undef',
164 B<NOTE> that options may contain '-' character and such options B<MUST> be
165 quoted, otherwise you can see quite cryptic error 'gpg: Invalid option "--0"'.
171 The GnuPG home directory, by default it is set to F</opt/rt4/var/data/gpg>.
173 You can manage this data with the 'gpg' commandline utility
174 using the GNUPGHOME environment variable or --homedir option.
175 Other utilities may be used as well.
177 In a standard installation, access to this directory should be granted to
178 the web server user which is running RT's web interface, but if you're running
179 cronjobs or other utilities that access RT directly via API and may generate
180 encrypted/signed notifications then the users you execute these scripts under
181 must have access too.
183 However, granting access to the dir to many users makes your setup less secure,
184 some features, such as auto-import of keys, may not be available if you do not.
185 To enable this features and suppress warnings about permissions on
186 the dir use --no-permission-warning.
190 This option is required in advance when RFC format for outgoing messages is
191 used. We can not get default algorithm from gpg program so RT uses 'SHA1' by
192 default. You may want to override it. You can use MD5, SHA1, RIPEMD160,
193 SHA256 or other, however use `gpg --version` command to get information about
194 supported algorithms by your gpg. These algorithms are listed as hash-functions.
198 This option lets you use GPG Agent to cache the passphrase of RT's key. See
199 L<http://www.gnupg.org/documentation/manuals/gnupg/Invoking-GPG_002dAGENT.html>
200 for information about GPG Agent.
204 This option lets you set the passphrase of RT's key directly. This option is
205 special in that it isn't passed directly to GPG, but is put into a file that
206 GPG then reads (which is more secure). The downside is that anyone who has read
207 access to your RT_SiteConfig.pm file can see the passphrase, thus we recommend
208 the --use-agent option instead.
212 Read `man gpg` to get list of all options this program support.
216 =head2 Per-queue options
218 Using the web interface it's possible to enable signing and/or encrypting by
219 default. As an administrative user of RT, open 'Configuration' then 'Queues',
220 and select a queue. On the page you can see information about the queue's keys
221 at the bottom and two checkboxes to choose default actions.
223 As well, encryption is enabled for autoreplies and other notifications when
224 an encypted message enters system via mailgate interface even if queue's
227 =head2 Handling incoming messages
229 To enable handling of encrypted and signed message in the RT you should add
230 'Auth::GnuPG' mail plugin.
232 Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...);
234 See also `perldoc lib/RT/Interface/Email/Auth/GnuPG.pm`.
236 =head2 Errors handling
238 There are several global templates created in the database by default. RT
239 uses these templates to send error messages to users or RT's owner. These
240 templates have 'Error:' or 'Error to RT owner:' prefix in the name. You can
241 adjust the text of the messages using the web interface.
243 Note that C<$TicketObj>, C<$TransactionObj> and other variable usually available
244 in RT's templates are not available in these templates, but each template
245 used for errors reporting has set of available data structures you can use to
246 build better messages. See default templates and descriptions below.
248 As well, you can disable particular notification by deleting content of
249 a template. You can delete a template too, but in this case you'll see
250 error messages in the logs when RT can not load template you've deleted.
252 =head3 Problems with public keys
254 Template 'Error: public key' is used to inform the user that RT has problems with
255 his public key and won't be able to send him encrypted content. There are several
256 reasons why RT can't use a key. However, the actual reason is not sent to the user,
257 but sent to RT owner using 'Error to RT owner: public key'.
259 The possible reasons: "Not Found", "Ambiguous specification", "Wrong
260 key usage", "Key revoked", "Key expired", "No CRL known", "CRL too
261 old", "Policy mismatch", "Not a secret key", "Key not trusted" or
262 "No specific reason given".
264 Due to limitations of GnuPG, it's impossible to encrypt to an untrusted key,
265 unless 'always trust' mode is enabled.
267 In the 'Error: public key' template there are a few additional variables available:
271 =item $Message - user friendly error message
273 =item $Reason - short reason as listed above
275 =item $Recipient - recipient's identification
277 =item $AddressObj - L<Email::Address> object containing recipient's email address
281 A message can have several invalid recipients, to avoid sending many emails
282 to the RT owner the system sends one message to the owner, grouped by
283 recipient. In the 'Error to RT owner: public key' template a C<@BadRecipients>
284 array is available where each element is a hash reference that describes one
285 recipient using the same fields as described above. So it's something like:
288 { Message => '...', Reason => '...', Recipient => '...', ...},
289 { Message => '...', Reason => '...', Recipient => '...', ...},
293 =head3 Private key doesn't exist
295 Template 'Error: no private key' is used to inform the user that
296 he sent an encrypted email, but we have no private key to decrypt
299 In this template C<$Message> object of L<MIME::Entity> class
300 available. It's the message RT received.
304 Template 'Error: bad GnuPG data' used to inform the user that a
305 message he sent has invalid data and can not be handled.
307 There are several reasons for this error, but most of them are data
308 corruption or absence of expected information.
310 In this template C<@Messages> array is available and contains list
313 =head1 FOR DEVELOPERS
315 =head2 Documentation and references
317 * RFC1847 - Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted.
318 Describes generic MIME security framework, "mulitpart/signed" and "multipart/encrypted"
321 * RFC3156 - MIME Security with Pretty Good Privacy (PGP),
326 # gnupg options supported by GnuPG::Interface
327 # other otions should be handled via extra_args argument
328 my %supported_opt = map { $_ => 1 } qw(
354 our $RE_FILE_EXTENSIONS = qr/pgp|asc/i;
356 # DEV WARNING: always pass all STD* handles to GnuPG interface even if we don't
357 # need them, just pass 'IO::Handle->new()' and then close it after safe_run_child.
358 # we don't want to leak anything into FCGI/Apache/MP handles, this break things.
359 # So code should look like:
360 # my $handles = GnuPG::Handles->new(
361 # stdin => ($handle{'stdin'} = IO::Handle->new()),
362 # stdout => ($handle{'stdout'} = IO::Handle->new()),
363 # stderr => ($handle{'stderr'} = IO::Handle->new()),
367 =head2 SignEncrypt Entity => MIME::Entity, [ Encrypt => 1, Sign => 1, ... ]
369 Signs and/or encrypts an email message with GnuPG utility.
375 During signing you can pass C<Signer> argument to set key we sign with this option
376 overrides gnupg's C<default-key> option. If C<Signer> argument is not provided
377 then address of a message sender is used.
379 As well you can pass C<Passphrase>, but if value is undefined then L</GetPassphrase>
384 During encryption you can pass a C<Recipients> array, otherwise C<To>, C<Cc> and
385 C<Bcc> fields of the message are used to fetch the list.
389 Returns a hash with the following keys:
402 my $entity = $args{'Entity'};
403 if ( $args{'Sign'} && !defined $args{'Signer'} ) {
404 $args{'Signer'} = UseKeyForSigning()
405 || (Email::Address->parse( $entity->head->get( 'From' ) ))[0]->address;
407 if ( $args{'Encrypt'} && !$args{'Recipients'} ) {
409 $args{'Recipients'} = [
410 grep $_ && !$seen{ $_ }++, map $_->address,
411 map Email::Address->parse( $entity->head->get( $_ ) ),
416 my $format = lc RT->Config->Get('GnuPG')->{'OutgoingMessagesFormat'} || 'RFC';
417 if ( $format eq 'inline' ) {
418 return SignEncryptInline( %args );
420 return SignEncryptRFC3156( %args );
424 sub SignEncryptRFC3156 {
438 my $gnupg = GnuPG::Interface->new();
439 my %opt = RT->Config->Get('GnuPGOptions');
441 # handling passphrase in GnuPGOptions
442 $args{'Passphrase'} = delete $opt{'passphrase'}
443 if !defined $args{'Passphrase'};
445 $opt{'digest-algo'} ||= 'SHA1';
446 $opt{'default_key'} = $args{'Signer'}
447 if $args{'Sign'} && $args{'Signer'};
448 $gnupg->options->hash_init(
449 _PrepareGnuPGOptions( %opt ),
451 meta_interactive => 0,
454 my $entity = $args{'Entity'};
456 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
457 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
461 if ( $args{'Sign'} && !$args{'Encrypt'} ) {
462 # required by RFC3156(Ch. 5) and RFC1847(Ch. 2.1)
463 foreach ( grep !$_->is_multipart, $entity->parts_DFS ) {
464 my $tenc = $_->head->mime_encoding;
465 unless ( $tenc =~ m/^(?:7bit|quoted-printable|base64)$/i ) {
466 $_->head->mime_attr( 'Content-Transfer-Encoding'
467 => $_->effective_type =~ m{^text/}? 'quoted-printable': 'base64'
472 my ($handles, $handle_list) = _make_gpg_handles(stdin =>IO::Handle::CRLF->new );
473 my %handle = %$handle_list;
475 $gnupg->passphrase( $args{'Passphrase'} );
478 local $SIG{'CHLD'} = 'DEFAULT';
479 my $pid = safe_run_child { $gnupg->detach_sign( handles => $handles ) };
480 $entity->make_multipart( 'mixed', Force => 1 );
482 local $SIG{'PIPE'} = 'IGNORE';
483 $entity->parts(0)->print( $handle{'stdin'} );
484 close $handle{'stdin'};
489 my @signature = readline $handle{'stdout'};
490 close $handle{'stdout'};
492 $res{'exit_code'} = $?;
493 foreach ( qw(stderr logger status) ) {
494 $res{$_} = do { local $/; readline $handle{$_} };
495 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
498 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
499 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
500 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
501 if ( $err || $res{'exit_code'} ) {
502 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
506 # setup RFC1847(Ch.2.1) requirements
507 my $protocol = 'application/pgp-signature';
508 $entity->head->mime_attr( 'Content-Type' => 'multipart/signed' );
509 $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
510 $entity->head->mime_attr( 'Content-Type.micalg' => 'pgp-'. lc $opt{'digest-algo'} );
513 Disposition => 'inline',
518 if ( $args{'Encrypt'} ) {
520 $gnupg->options->push_recipients( $_ ) foreach
521 map UseKeyForEncryption($_) || $_,
522 grep !$seen{ $_ }++, map $_->address,
523 map Email::Address->parse( $entity->head->get( $_ ) ),
526 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
527 binmode $tmp_fh, ':raw';
529 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
530 my %handle = %$handle_list;
531 $handles->options( 'stdout' )->{'direct'} = 1;
532 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
535 local $SIG{'CHLD'} = 'DEFAULT';
536 my $pid = safe_run_child { $args{'Sign'}
537 ? $gnupg->sign_and_encrypt( handles => $handles )
538 : $gnupg->encrypt( handles => $handles ) };
539 $entity->make_multipart( 'mixed', Force => 1 );
541 local $SIG{'PIPE'} = 'IGNORE';
542 $entity->parts(0)->print( $handle{'stdin'} );
543 close $handle{'stdin'};
548 $res{'exit_code'} = $?;
549 foreach ( qw(stderr logger status) ) {
550 $res{$_} = do { local $/; readline $handle{$_} };
551 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
554 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
555 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
556 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
558 $res{'message'} = $@? $@: "gpg exited with error code ". ($? >> 8);
562 my $protocol = 'application/pgp-encrypted';
564 $entity->head->mime_attr( 'Content-Type' => 'multipart/encrypted' );
565 $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
568 Disposition => 'inline',
569 Data => ['Version: 1',''],
573 Type => 'application/octet-stream',
574 Disposition => 'inline',
579 $entity->parts(-1)->bodyhandle->{'_dirty_hack_to_save_a_ref_tmp_fh'} = $tmp_fh;
584 sub SignEncryptInline {
587 my $entity = $args{'Entity'};
590 $entity->make_singlepart;
591 if ( $entity->is_multipart ) {
592 foreach ( $entity->parts ) {
593 %res = SignEncryptInline( @_, Entity => $_ );
594 return %res if $res{'exit_code'};
599 return _SignEncryptTextInline( @_ )
600 if $entity->effective_type =~ /^text\//i;
602 return _SignEncryptAttachmentInline( @_ );
605 sub _SignEncryptTextInline {
618 return unless $args{'Sign'} || $args{'Encrypt'};
620 my $gnupg = GnuPG::Interface->new();
621 my %opt = RT->Config->Get('GnuPGOptions');
623 # handling passphrase in GnupGOptions
624 $args{'Passphrase'} = delete $opt{'passphrase'}
625 if !defined($args{'Passphrase'});
627 $opt{'digest-algo'} ||= 'SHA1';
628 $opt{'default_key'} = $args{'Signer'}
629 if $args{'Sign'} && $args{'Signer'};
630 $gnupg->options->hash_init(
631 _PrepareGnuPGOptions( %opt ),
633 meta_interactive => 0,
636 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
637 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
640 if ( $args{'Encrypt'} ) {
641 $gnupg->options->push_recipients( $_ ) foreach
642 map UseKeyForEncryption($_) || $_,
643 @{ $args{'Recipients'} || [] };
648 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
649 binmode $tmp_fh, ':raw';
651 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
652 my %handle = %$handle_list;
654 $handles->options( 'stdout' )->{'direct'} = 1;
655 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
657 my $entity = $args{'Entity'};
659 local $SIG{'CHLD'} = 'DEFAULT';
660 my $method = $args{'Sign'} && $args{'Encrypt'}
662 : ($args{'Sign'}? 'clearsign': 'encrypt');
663 my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
665 local $SIG{'PIPE'} = 'IGNORE';
666 $entity->bodyhandle->print( $handle{'stdin'} );
667 close $handle{'stdin'};
671 $res{'exit_code'} = $?;
674 foreach ( qw(stderr logger status) ) {
675 $res{$_} = do { local $/; readline $handle{$_} };
676 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
679 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
680 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
681 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
682 if ( $err || $res{'exit_code'} ) {
683 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
687 $entity->bodyhandle( MIME::Body::File->new( $tmp_fn) );
688 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
693 sub _SignEncryptAttachmentInline {
706 return unless $args{'Sign'} || $args{'Encrypt'};
708 my $gnupg = GnuPG::Interface->new();
709 my %opt = RT->Config->Get('GnuPGOptions');
711 # handling passphrase in GnupGOptions
712 $args{'Passphrase'} = delete $opt{'passphrase'}
713 if !defined($args{'Passphrase'});
715 $opt{'digest-algo'} ||= 'SHA1';
716 $opt{'default_key'} = $args{'Signer'}
717 if $args{'Sign'} && $args{'Signer'};
718 $gnupg->options->hash_init(
719 _PrepareGnuPGOptions( %opt ),
721 meta_interactive => 0,
724 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
725 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
728 my $entity = $args{'Entity'};
729 if ( $args{'Encrypt'} ) {
730 $gnupg->options->push_recipients( $_ ) foreach
731 map UseKeyForEncryption($_) || $_,
732 @{ $args{'Recipients'} || [] };
737 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
738 binmode $tmp_fh, ':raw';
740 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
741 my %handle = %$handle_list;
742 $handles->options( 'stdout' )->{'direct'} = 1;
743 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
746 local $SIG{'CHLD'} = 'DEFAULT';
747 my $method = $args{'Sign'} && $args{'Encrypt'}
749 : ($args{'Sign'}? 'detach_sign': 'encrypt');
750 my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
752 local $SIG{'PIPE'} = 'IGNORE';
753 $entity->bodyhandle->print( $handle{'stdin'} );
754 close $handle{'stdin'};
758 $res{'exit_code'} = $?;
761 foreach ( qw(stderr logger status) ) {
762 $res{$_} = do { local $/; readline $handle{$_} };
763 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
766 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
767 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
768 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
769 if ( $err || $res{'exit_code'} ) {
770 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
774 my $filename = mime_recommended_filename( $entity ) || 'no_name';
775 if ( $args{'Sign'} && !$args{'Encrypt'} ) {
776 $entity->make_multipart;
778 Type => 'application/octet-stream',
780 Filename => "$filename.sig",
781 Disposition => 'attachment',
784 $entity->bodyhandle(MIME::Body::File->new( $tmp_fn) );
785 $entity->effective_type('application/octet-stream');
786 $entity->head->mime_attr( $_ => "$filename.pgp" )
787 foreach (qw(Content-Type.name Content-Disposition.filename));
790 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
795 sub SignEncryptContent {
808 return unless $args{'Sign'} || $args{'Encrypt'};
810 my $gnupg = GnuPG::Interface->new();
811 my %opt = RT->Config->Get('GnuPGOptions');
813 # handling passphrase in GnupGOptions
814 $args{'Passphrase'} = delete $opt{'passphrase'}
815 if !defined($args{'Passphrase'});
817 $opt{'digest-algo'} ||= 'SHA1';
818 $opt{'default_key'} = $args{'Signer'}
819 if $args{'Sign'} && $args{'Signer'};
820 $gnupg->options->hash_init(
821 _PrepareGnuPGOptions( %opt ),
823 meta_interactive => 0,
826 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
827 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
830 if ( $args{'Encrypt'} ) {
831 $gnupg->options->push_recipients( $_ ) foreach
832 map UseKeyForEncryption($_) || $_,
833 @{ $args{'Recipients'} || [] };
838 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
839 binmode $tmp_fh, ':raw';
841 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
842 my %handle = %$handle_list;
843 $handles->options( 'stdout' )->{'direct'} = 1;
844 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
847 local $SIG{'CHLD'} = 'DEFAULT';
848 my $method = $args{'Sign'} && $args{'Encrypt'}
850 : ($args{'Sign'}? 'clearsign': 'encrypt');
851 my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
853 local $SIG{'PIPE'} = 'IGNORE';
854 $handle{'stdin'}->print( ${ $args{'Content'} } );
855 close $handle{'stdin'};
859 $res{'exit_code'} = $?;
862 foreach ( qw(stderr logger status) ) {
863 $res{$_} = do { local $/; readline $handle{$_} };
864 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
867 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
868 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
869 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
870 if ( $err || $res{'exit_code'} ) {
871 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
875 ${ $args{'Content'} } = '';
878 my $status = read $tmp_fh, my $buf, 4*1024;
879 unless ( defined $status ) {
880 $RT::Logger->crit( "couldn't read message: $!" );
881 } elsif ( !$status ) {
884 ${ $args{'Content'} } .= $buf;
890 sub FindProtectedParts {
891 my %args = ( Entity => undef, CheckBody => 1, @_ );
892 my $entity = $args{'Entity'};
894 # inline PGP block, only in singlepart
895 unless ( $entity->is_multipart ) {
896 my $file = ($entity->head->recommended_filename||'') =~ /\.${RE_FILE_EXTENSIONS}$/;
898 my $io = $entity->open('r');
900 $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
904 # Deal with "partitioned" PGP mail, which (contrary to common
905 # sense) unnecessarily applies a base64 transfer encoding to PGP
906 # mail (whose content is already base64-encoded).
907 if ( $entity->bodyhandle->is_encoded and $entity->head->mime_encoding ) {
908 my $decoder = MIME::Decoder->new( $entity->head->mime_encoding );
913 open my $fh, '>', \$buf
914 or die "Couldn't open scalar for writing: $!";
916 $decoder->decode($io, $fh);
917 close $fh or die "Couldn't close scalar: $!";
920 or die "Couldn't re-open scalar for reading: $!";
925 $RT::Logger->error("Couldn't decode body: $@");
930 while ( defined($_ = $io->getline) ) {
931 next unless /^-----BEGIN PGP (SIGNED )?MESSAGE-----/;
932 my $type = $1? 'signed': 'encrypted';
933 $RT::Logger->debug("Found $type inline part");
936 Format => !$file || $type eq 'signed'? 'Inline' : 'Attachment',
944 # RFC3156, multipart/{signed,encrypted}
945 if ( ( my $type = $entity->effective_type ) =~ /^multipart\/(?:encrypted|signed)$/ ) {
946 unless ( $entity->parts == 2 ) {
947 $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
951 my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
952 unless ( $protocol ) {
953 $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" );
957 if ( $type eq 'multipart/encrypted' ) {
958 unless ( $protocol eq 'application/pgp-encrypted' ) {
959 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" );
962 $RT::Logger->debug("Found encrypted according to RFC3156 part");
967 Data => $entity->parts(1),
968 Info => $entity->parts(0),
971 unless ( $protocol eq 'application/pgp-signature' ) {
972 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
975 $RT::Logger->debug("Found signed according to RFC3156 part");
980 Data => $entity->parts(0),
981 Signature => $entity->parts(1),
986 # attachments signed with signature in another part
988 foreach my $i ( 0 .. $entity->parts - 1 ) {
989 my $part = $entity->parts($i);
991 # we can not associate a signature within an attachment
993 my $fname = $part->head->recommended_filename;
996 if ( $part->effective_type eq 'application/pgp-signature' ) {
997 push @file_indices, $i;
999 elsif ( $fname =~ /\.sig$/i && $part->effective_type eq 'application/octet-stream' ) {
1000 push @file_indices, $i;
1005 foreach my $i ( @file_indices ) {
1006 my $sig_part = $entity->parts($i);
1007 $skip{"$sig_part"}++;
1008 my $sig_name = $sig_part->head->recommended_filename;
1009 my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/;
1011 my ($data_part_idx) =
1012 grep $file_name eq ($entity->parts($_)->head->recommended_filename||''),
1013 grep $sig_part ne $entity->parts($_),
1014 0 .. $entity->parts - 1;
1015 unless ( defined $data_part_idx ) {
1016 $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
1019 my $data_part_in = $entity->parts($data_part_idx);
1021 $skip{"$data_part_in"}++;
1022 $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
1025 Format => 'Attachment',
1027 Data => $data_part_in,
1028 Signature => $sig_part,
1032 # attachments with inline encryption
1033 my @encrypted_indices =
1034 grep {($entity->parts($_)->head->recommended_filename || '') =~ /\.${RE_FILE_EXTENSIONS}$/}
1035 0 .. $entity->parts - 1;
1037 foreach my $i ( @encrypted_indices ) {
1038 my $part = $entity->parts($i);
1040 $RT::Logger->debug("Found encrypted attachment '". $part->head->recommended_filename ."'");
1042 Type => 'encrypted',
1043 Format => 'Attachment',
1049 push @res, FindProtectedParts( Entity => $_ )
1050 foreach grep !$skip{"$_"}, $entity->parts;
1055 =head2 VerifyDecrypt Entity => undef, [ Detach => 1, Passphrase => undef, SetStatus => 1 ]
1067 my @protected = FindProtectedParts( Entity => $args{'Entity'} );
1069 # XXX: detaching may brake nested signatures
1070 foreach my $item( grep $_->{'Type'} eq 'signed', @protected ) {
1072 if ( $item->{'Format'} eq 'RFC3156' ) {
1073 push @res, { VerifyRFC3156( %$item, SetStatus => $args{'SetStatus'} ) };
1074 if ( $args{'Detach'} ) {
1075 $item->{'Top'}->parts( [ $item->{'Data'} ] );
1076 $item->{'Top'}->make_singlepart;
1078 $status_on = $item->{'Top'};
1079 } elsif ( $item->{'Format'} eq 'Inline' ) {
1080 push @res, { VerifyInline( %$item ) };
1081 $status_on = $item->{'Data'};
1082 } elsif ( $item->{'Format'} eq 'Attachment' ) {
1083 push @res, { VerifyAttachment( %$item ) };
1084 if ( $args{'Detach'} ) {
1085 $item->{'Top'}->parts( [
1086 grep "$_" ne $item->{'Signature'}, $item->{'Top'}->parts
1088 $item->{'Top'}->make_singlepart;
1090 $status_on = $item->{'Data'};
1092 if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
1093 my $method = $args{'AddStatus'} ? 'add' : 'set';
1094 # Let the header be modified so continuations are handled
1095 my $modify = $status_on->head->modify;
1096 $status_on->head->modify(1);
1097 $status_on->head->$method(
1098 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
1100 $status_on->head->modify($modify);
1103 foreach my $item( grep $_->{'Type'} eq 'encrypted', @protected ) {
1105 if ( $item->{'Format'} eq 'RFC3156' ) {
1106 push @res, { DecryptRFC3156( %$item ) };
1107 $status_on = $item->{'Top'};
1108 } elsif ( $item->{'Format'} eq 'Inline' ) {
1109 push @res, { DecryptInline( %$item ) };
1110 $status_on = $item->{'Data'};
1111 } elsif ( $item->{'Format'} eq 'Attachment' ) {
1112 push @res, { DecryptAttachment( %$item ) };
1113 $status_on = $item->{'Data'};
1115 if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
1116 my $method = $args{'AddStatus'} ? 'add' : 'set';
1117 # Let the header be modified so continuations are handled
1118 my $modify = $status_on->head->modify;
1119 $status_on->head->modify(1);
1120 $status_on->head->$method(
1121 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
1123 $status_on->head->modify($modify);
1129 sub VerifyInline { return DecryptInline( @_ ) }
1131 sub VerifyAttachment {
1132 my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
1134 my $gnupg = GnuPG::Interface->new();
1135 my %opt = RT->Config->Get('GnuPGOptions');
1136 $opt{'digest-algo'} ||= 'SHA1';
1137 $gnupg->options->hash_init(
1138 _PrepareGnuPGOptions( %opt ),
1139 meta_interactive => 0,
1142 foreach ( $args{'Data'}, $args{'Signature'} ) {
1143 next unless $_->bodyhandle->is_encoded;
1145 require RT::EmailParser;
1146 RT::EmailParser->_DecodeBody($_);
1149 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1150 binmode $tmp_fh, ':raw';
1151 $args{'Data'}->bodyhandle->print( $tmp_fh );
1154 my ($handles, $handle_list) = _make_gpg_handles();
1155 my %handle = %$handle_list;
1159 local $SIG{'CHLD'} = 'DEFAULT';
1160 my $pid = safe_run_child { $gnupg->verify(
1161 handles => $handles, command_args => [ '-', $tmp_fn ]
1164 local $SIG{'PIPE'} = 'IGNORE';
1165 $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
1166 close $handle{'stdin'};
1170 $res{'exit_code'} = $?;
1171 foreach ( qw(stderr logger status) ) {
1172 $res{$_} = do { local $/; readline $handle{$_} };
1173 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1176 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1177 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1178 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1180 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1186 my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
1188 my $gnupg = GnuPG::Interface->new();
1189 my %opt = RT->Config->Get('GnuPGOptions');
1190 $opt{'digest-algo'} ||= 'SHA1';
1191 $gnupg->options->hash_init(
1192 _PrepareGnuPGOptions( %opt ),
1193 meta_interactive => 0,
1196 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1197 binmode $tmp_fh, ':raw:eol(CRLF?)';
1198 $args{'Data'}->print( $tmp_fh );
1201 my ($handles, $handle_list) = _make_gpg_handles();
1202 my %handle = %$handle_list;
1206 local $SIG{'CHLD'} = 'DEFAULT';
1207 my $pid = safe_run_child { $gnupg->verify(
1208 handles => $handles, command_args => [ '-', $tmp_fn ]
1211 local $SIG{'PIPE'} = 'IGNORE';
1212 $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
1213 close $handle{'stdin'};
1217 $res{'exit_code'} = $?;
1218 foreach ( qw(stderr logger status) ) {
1219 $res{$_} = do { local $/; readline $handle{$_} };
1220 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1223 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1224 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1225 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1227 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1232 sub DecryptRFC3156 {
1237 Passphrase => undef,
1241 my $gnupg = GnuPG::Interface->new();
1242 my %opt = RT->Config->Get('GnuPGOptions');
1244 # handling passphrase in GnupGOptions
1245 $args{'Passphrase'} = delete $opt{'passphrase'}
1246 if !defined($args{'Passphrase'});
1248 $opt{'digest-algo'} ||= 'SHA1';
1249 $gnupg->options->hash_init(
1250 _PrepareGnuPGOptions( %opt ),
1251 meta_interactive => 0,
1254 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1255 require RT::EmailParser;
1256 RT::EmailParser->_DecodeBody($args{'Data'});
1259 $args{'Passphrase'} = GetPassphrase()
1260 unless defined $args{'Passphrase'};
1262 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1263 binmode $tmp_fh, ':raw';
1265 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
1266 my %handle = %$handle_list;
1267 $handles->options( 'stdout' )->{'direct'} = 1;
1271 local $SIG{'CHLD'} = 'DEFAULT';
1272 $gnupg->passphrase( $args{'Passphrase'} );
1273 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1275 local $SIG{'PIPE'} = 'IGNORE';
1276 $args{'Data'}->bodyhandle->print( $handle{'stdin'} );
1277 close $handle{'stdin'}
1282 $res{'exit_code'} = $?;
1283 foreach ( qw(stderr logger status) ) {
1284 $res{$_} = do { local $/; readline $handle{$_} };
1285 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1288 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1289 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1290 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1292 # if the decryption is fine but the signature is bad, then without this
1293 # status check we lose the decrypted text
1294 # XXX: add argument to the function to control this check
1295 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1297 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1303 my $parser = RT::EmailParser->new();
1304 my $decrypted = $parser->ParseMIMEEntityFromFileHandle( $tmp_fh, 0 );
1305 $decrypted->{'__store_link_to_object_to_avoid_early_cleanup'} = $parser;
1306 $args{'Top'}->parts( [] );
1307 $args{'Top'}->add_part( $decrypted );
1308 $args{'Top'}->make_singlepart;
1315 Passphrase => undef,
1319 my $gnupg = GnuPG::Interface->new();
1320 my %opt = RT->Config->Get('GnuPGOptions');
1322 # handling passphrase in GnuPGOptions
1323 $args{'Passphrase'} = delete $opt{'passphrase'}
1324 if !defined($args{'Passphrase'});
1326 $opt{'digest-algo'} ||= 'SHA1';
1327 $gnupg->options->hash_init(
1328 _PrepareGnuPGOptions( %opt ),
1329 meta_interactive => 0,
1332 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1333 require RT::EmailParser;
1334 RT::EmailParser->_DecodeBody($args{'Data'});
1337 $args{'Passphrase'} = GetPassphrase()
1338 unless defined $args{'Passphrase'};
1340 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1341 binmode $tmp_fh, ':raw';
1343 my $io = $args{'Data'}->open('r');
1345 die "Entity has no body, never should happen";
1350 my ($had_literal, $in_block) = ('', 0);
1351 my ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1352 binmode $block_fh, ':raw';
1354 while ( defined(my $str = $io->getline) ) {
1355 if ( $in_block && $str =~ /^-----END PGP (?:MESSAGE|SIGNATURE)-----/ ) {
1356 print $block_fh $str;
1358 next if $in_block > 0;
1360 seek $block_fh, 0, 0;
1362 my ($res_fh, $res_fn);
1363 ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1366 BlockHandle => $block_fh,
1368 return %res unless $res_fh;
1370 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1371 while (my $buf = <$res_fh> ) {
1374 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1376 ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1377 binmode $block_fh, ':raw';
1380 elsif ( $str =~ /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) {
1382 print $block_fh $str;
1384 elsif ( $in_block ) {
1385 print $block_fh $str;
1389 $had_literal = 1 if /\S/s;
1395 # we're still in a block, this not bad not good. let's try to
1396 # decrypt what we have, it can be just missing -----END PGP...
1397 seek $block_fh, 0, 0;
1399 my ($res_fh, $res_fn);
1400 ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1403 BlockHandle => $block_fh,
1405 return %res unless $res_fh;
1407 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1408 while (my $buf = <$res_fh> ) {
1411 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1415 $args{'Data'}->bodyhandle(MIME::Body::File->new( $tmp_fn ));
1416 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
1420 sub _DecryptInlineBlock {
1423 BlockHandle => undef,
1424 Passphrase => undef,
1427 my $gnupg = $args{'GnuPG'};
1429 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1430 binmode $tmp_fh, ':raw';
1432 my ($handles, $handle_list) = _make_gpg_handles(
1433 stdin => $args{'BlockHandle'},
1435 my %handle = %$handle_list;
1436 $handles->options( 'stdout' )->{'direct'} = 1;
1437 $handles->options( 'stdin' )->{'direct'} = 1;
1441 local $SIG{'CHLD'} = 'DEFAULT';
1442 $gnupg->passphrase( $args{'Passphrase'} );
1443 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1446 $res{'exit_code'} = $?;
1447 foreach ( qw(stderr logger status) ) {
1448 $res{$_} = do { local $/; readline $handle{$_} };
1449 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1452 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1453 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1454 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1456 # if the decryption is fine but the signature is bad, then without this
1457 # status check we lose the decrypted text
1458 # XXX: add argument to the function to control this check
1459 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1461 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1462 return (undef, undef, %res);
1467 return ($tmp_fh, $tmp_fn, %res);
1470 sub DecryptAttachment {
1474 Passphrase => undef,
1478 my $gnupg = GnuPG::Interface->new();
1479 my %opt = RT->Config->Get('GnuPGOptions');
1481 # handling passphrase in GnuPGOptions
1482 $args{'Passphrase'} = delete $opt{'passphrase'}
1483 if !defined($args{'Passphrase'});
1485 $opt{'digest-algo'} ||= 'SHA1';
1486 $gnupg->options->hash_init(
1487 _PrepareGnuPGOptions( %opt ),
1488 meta_interactive => 0,
1491 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1492 require RT::EmailParser;
1493 RT::EmailParser->_DecodeBody($args{'Data'});
1496 $args{'Passphrase'} = GetPassphrase()
1497 unless defined $args{'Passphrase'};
1499 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1500 binmode $tmp_fh, ':raw';
1501 $args{'Data'}->bodyhandle->print( $tmp_fh );
1504 my ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1507 BlockHandle => $tmp_fh,
1509 return %res unless $res_fh;
1511 $args{'Data'}->bodyhandle(MIME::Body::File->new($res_fn) );
1512 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $res_fh;
1514 my $head = $args{'Data'}->head;
1516 # we can not trust original content type
1517 # TODO: and don't have way to detect, so we just use octet-stream
1518 # some clients may send .asc files (encryped) as text/plain
1519 $head->mime_attr( "Content-Type" => 'application/octet-stream' );
1521 my $filename = $head->recommended_filename;
1522 $filename =~ s/\.${RE_FILE_EXTENSIONS}$//i;
1523 $head->mime_attr( $_ => $filename )
1524 foreach (qw(Content-Type.name Content-Disposition.filename));
1529 sub DecryptContent {
1532 Passphrase => undef,
1536 my $gnupg = GnuPG::Interface->new();
1537 my %opt = RT->Config->Get('GnuPGOptions');
1539 # handling passphrase in GnupGOptions
1540 $args{'Passphrase'} = delete $opt{'passphrase'}
1541 if !defined($args{'Passphrase'});
1543 $opt{'digest-algo'} ||= 'SHA1';
1544 $gnupg->options->hash_init(
1545 _PrepareGnuPGOptions( %opt ),
1546 meta_interactive => 0,
1549 $args{'Passphrase'} = GetPassphrase()
1550 unless defined $args{'Passphrase'};
1552 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1553 binmode $tmp_fh, ':raw';
1555 my ($handles, $handle_list) = _make_gpg_handles(
1557 my %handle = %$handle_list;
1558 $handles->options( 'stdout' )->{'direct'} = 1;
1562 local $SIG{'CHLD'} = 'DEFAULT';
1563 $gnupg->passphrase( $args{'Passphrase'} );
1564 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1566 local $SIG{'PIPE'} = 'IGNORE';
1567 print { $handle{'stdin'} } ${ $args{'Content'} };
1568 close $handle{'stdin'};
1573 $res{'exit_code'} = $?;
1574 foreach ( qw(stderr logger status) ) {
1575 $res{$_} = do { local $/; readline $handle{$_} };
1576 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1579 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1580 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1581 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1583 # if the decryption is fine but the signature is bad, then without this
1584 # status check we lose the decrypted text
1585 # XXX: add argument to the function to control this check
1586 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1588 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1593 ${ $args{'Content'} } = '';
1596 my $status = read $tmp_fh, my $buf, 4*1024;
1597 unless ( defined $status ) {
1598 $RT::Logger->crit( "couldn't read message: $!" );
1599 } elsif ( !$status ) {
1602 ${ $args{'Content'} } .= $buf;
1608 =head2 GetPassphrase [ Address => undef ]
1610 Returns passphrase, called whenever it's required with Address as a named argument.
1615 my %args = ( Address => undef, @_ );
1621 Takes a string containing output of gnupg status stream. Parses it and returns
1622 array of hashes. Each element of array is a hash ref and represents line or
1623 group of lines in the status message.
1625 All hashes have Operation, Status and Message elements.
1631 Classification of operations gnupg performs. Now we have support
1632 for Sign, Encrypt, Decrypt, Verify, PassphraseCheck, RecipientsCheck and Data
1637 Informs about success. Value is 'DONE' on success, other values means that
1638 an operation failed, for example 'ERROR', 'BAD', 'MISSING' and may be other.
1642 User friendly message.
1646 This parser is based on information from GnuPG distribution.
1650 my %REASON_CODE_TO_TEXT = (
1652 1 => "No armored data",
1653 2 => "Expected a packet, but did not found one",
1654 3 => "Invalid packet found",
1655 4 => "Signature expected, but not found",
1658 0 => "No specific reason given",
1660 2 => "Ambigious specification",
1661 3 => "Wrong key usage",
1664 6 => "No CRL known",
1666 8 => "Policy mismatch",
1667 9 => "Not a secret key",
1668 10 => "Key not trusted",
1671 0 => 'not specified',
1672 4 => 'unknown algorithm',
1673 9 => 'missing public key',
1677 sub ReasonCodeToText {
1678 my $keyword = shift;
1680 return $REASON_CODE_TO_TEXT{ $keyword }{ $code }
1681 if exists $REASON_CODE_TO_TEXT{ $keyword }{ $code };
1685 my %simple_keyword = (
1687 Operation => 'RecipientsCheck',
1689 Message => 'No recipients',
1692 Operation => 'Data',
1694 Message => 'Unexpected data has been encountered',
1697 Operation => 'Data',
1699 Message => 'The ASCII armor is corrupted',
1704 my %parse_keyword = map { $_ => 1 } qw(
1706 SIG_CREATED GOODSIG BADSIG ERRSIG
1708 DECRYPTION_FAILED DECRYPTION_OKAY
1709 BAD_PASSPHRASE GOOD_PASSPHRASE
1711 NO_RECP INV_RECP NODATA UNEXPECTED
1714 # keywords we ignore without any messages as we parse them using other
1715 # keywords as starting point or just ignore as they are useless for us
1716 my %ignore_keyword = map { $_ => 1 } qw(
1717 NEED_PASSPHRASE MISSING_PASSPHRASE BEGIN_SIGNING PLAINTEXT PLAINTEXT_LENGTH
1718 BEGIN_ENCRYPTION SIG_ID VALIDSIG
1719 ENC_TO BEGIN_DECRYPTION END_DECRYPTION GOODMDC
1720 TRUST_UNDEFINED TRUST_NEVER TRUST_MARGINAL TRUST_FULLY TRUST_ULTIMATE
1726 return () unless $status;
1729 while ( $status =~ /\[GNUPG:\]\s*(.*?)(?=\[GNUPG:\]|\z)/igms ) {
1730 push @status, $1; $status[-1] =~ s/\s+/ /g; $status[-1] =~ s/\s+$//;
1732 $status = join "\n", @status;
1736 my (%user_hint, $latest_user_main_key);
1737 for ( my $i = 0; $i < @status; $i++ ) {
1738 my $line = $status[$i];
1739 my ($keyword, $args) = ($line =~ /^(\S+)\s*(.*)$/s);
1740 if ( $simple_keyword{ $keyword } ) {
1741 push @res, $simple_keyword{ $keyword };
1742 $res[-1]->{'Keyword'} = $keyword;
1745 unless ( $parse_keyword{ $keyword } ) {
1746 $RT::Logger->warning("Skipped $keyword") unless $ignore_keyword{ $keyword };
1750 if ( $keyword eq 'USERID_HINT' ) {
1751 my %tmp = _ParseUserHint($status, $line);
1752 $latest_user_main_key = $tmp{'MainKey'};
1753 if ( $user_hint{ $tmp{'MainKey'} } ) {
1754 while ( my ($k, $v) = each %tmp ) {
1755 $user_hint{ $tmp{'MainKey'} }->{$k} = $v;
1758 $user_hint{ $tmp{'MainKey'} } = \%tmp;
1762 elsif ( $keyword eq 'BAD_PASSPHRASE' || $keyword eq 'GOOD_PASSPHRASE' ) {
1765 Operation => 'PassphraseCheck',
1766 Status => $keyword eq 'BAD_PASSPHRASE'? 'BAD' : 'DONE',
1769 $res{'Status'} = 'MISSING' if $status[ $i - 1 ] =~ /^MISSING_PASSPHRASE/;
1770 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1771 next unless $line =~ /^NEED_PASSPHRASE\s+(\S+)\s+(\S+)\s+(\S+)/;
1772 next if $key_id && $2 ne $key_id;
1773 @res{'MainKey', 'Key', 'KeyType'} = ($1, $2, $3);
1776 $res{'Message'} = ucfirst( lc( $res{'Status'} eq 'DONE'? 'GOOD': $res{'Status'} ) ) .' passphrase';
1777 $res{'User'} = ( $user_hint{ $res{'MainKey'} } ||= {} ) if $res{'MainKey'};
1778 if ( exists $res{'User'}->{'EmailAddress'} ) {
1779 $res{'Message'} .= ' for '. $res{'User'}->{'EmailAddress'};
1781 $res{'Message'} .= " for '0x$key_id'";
1785 elsif ( $keyword eq 'END_ENCRYPTION' ) {
1787 Operation => 'Encrypt',
1789 Message => 'Data has been encrypted',
1791 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1792 next unless $line =~ /^BEGIN_ENCRYPTION\s+(\S+)\s+(\S+)/;
1793 @res{'MdcMethod', 'SymAlgo'} = ($1, $2);
1798 elsif ( $keyword eq 'DECRYPTION_FAILED' || $keyword eq 'DECRYPTION_OKAY' ) {
1799 my %res = ( Operation => 'Decrypt' );
1800 @res{'Status', 'Message'} =
1801 $keyword eq 'DECRYPTION_FAILED'
1802 ? ('ERROR', 'Decryption failed')
1803 : ('DONE', 'Decryption process succeeded');
1805 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1806 next unless $line =~ /^ENC_TO\s+(\S+)\s+(\S+)\s+(\S+)/;
1807 my ($key, $alg, $key_length) = ($1, $2, $3);
1809 my %encrypted_to = (
1810 Message => "The message is encrypted to '0x$key'",
1811 User => ( $user_hint{ $key } ||= {} ),
1813 KeyLength => $key_length,
1817 push @{ $res{'EncryptedTo'} ||= [] }, \%encrypted_to;
1822 elsif ( $keyword eq 'NO_SECKEY' || $keyword eq 'NO_PUBKEY' ) {
1823 my ($key) = split /\s+/, $args;
1824 my $type = $keyword eq 'NO_SECKEY'? 'secret': 'public';
1826 Operation => 'KeyCheck',
1827 Status => 'MISSING',
1828 Message => ucfirst( $type ) ." key '0x$key' is not available",
1832 $res{'User'} = ( $user_hint{ $key } ||= {} );
1833 $res{'User'}{ ucfirst( $type ). 'KeyMissing' } = 1;
1836 # GOODSIG, BADSIG, VALIDSIG, TRUST_*
1837 elsif ( $keyword eq 'GOODSIG' ) {
1839 Operation => 'Verify',
1841 Message => 'The signature is good',
1843 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1844 $res{'Message'} .= ', signed by '. $res{'UserString'};
1846 foreach my $line ( @status[ $i .. $#status ] ) {
1847 next unless $line =~ /^TRUST_(\S+)/;
1851 $res{'Message'} .= ', trust level is '. lc( $res{'Trust'} || 'unknown');
1853 foreach my $line ( @status[ $i .. $#status ] ) {
1854 next unless $line =~ /^VALIDSIG\s+(.*)/;
1867 ) } = split /\s+/, $1, 10;
1872 elsif ( $keyword eq 'BADSIG' ) {
1874 Operation => 'Verify',
1876 Message => 'The signature has not been verified okay',
1878 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1881 elsif ( $keyword eq 'ERRSIG' ) {
1883 Operation => 'Verify',
1885 Message => 'Not possible to check the signature',
1887 @res{qw(Key PubkeyAlgo HashAlgo Class Timestamp ReasonCode Other)}
1888 = split /\s+/, $args, 7;
1890 $res{'Reason'} = ReasonCodeToText( $keyword, $res{'ReasonCode'} );
1891 $res{'Message'} .= ", the reason is ". $res{'Reason'};
1895 elsif ( $keyword eq 'SIG_CREATED' ) {
1896 # SIG_CREATED <type> <pubkey algo> <hash algo> <class> <timestamp> <key fpr>
1897 my @props = split /\s+/, $args;
1899 Operation => 'Sign',
1901 Message => "Signed message",
1903 PubKeyAlgo => $props[1],
1904 HashKeyAlgo => $props[2],
1906 Timestamp => $props[4],
1907 KeyFingerprint => $props[5],
1908 User => $user_hint{ $latest_user_main_key },
1910 $res[-1]->{Message} .= ' by '. $user_hint{ $latest_user_main_key }->{'EmailAddress'}
1911 if $user_hint{ $latest_user_main_key };
1913 elsif ( $keyword eq 'INV_RECP' ) {
1914 my ($rcode, $recipient) = split /\s+/, $args, 2;
1915 my $reason = ReasonCodeToText( $keyword, $rcode );
1917 Operation => 'RecipientsCheck',
1919 Message => "Recipient '$recipient' is unusable, the reason is '$reason'",
1920 Recipient => $recipient,
1921 ReasonCode => $rcode,
1925 elsif ( $keyword eq 'NODATA' ) {
1926 my $rcode = (split /\s+/, $args)[0];
1927 my $reason = ReasonCodeToText( $keyword, $rcode );
1929 Operation => 'Data',
1931 Message => "No data has been found. The reason is '$reason'",
1932 ReasonCode => $rcode,
1937 $RT::Logger->warning("Keyword $keyword is unknown");
1940 $res[-1]{'Keyword'} = $keyword if @res && !$res[-1]{'Keyword'};
1945 sub _ParseUserHint {
1946 my ($status, $hint) = (@_);
1947 my ($main_key_id, $user_str) = ($hint =~ /^USERID_HINT\s+(\S+)\s+(.*)$/);
1948 return () unless $main_key_id;
1950 MainKey => $main_key_id,
1951 String => $user_str,
1952 EmailAddress => (map $_->address, Email::Address->parse( $user_str ))[0],
1956 sub _PrepareGnuPGOptions {
1958 my %res = map { lc $_ => $opt{ $_ } } grep $supported_opt{ lc $_ }, keys %opt;
1959 $res{'extra_args'} ||= [];
1960 foreach my $o ( grep !$supported_opt{ lc $_ }, keys %opt ) {
1961 push @{ $res{'extra_args'} }, '--'. lc $o;
1962 push @{ $res{'extra_args'} }, $opt{ $o }
1963 if defined $opt{ $o };
1970 # one arg -> return preferred key
1972 sub UseKeyForEncryption {
1975 } elsif ( @_ > 1 ) {
1977 $key{ lc($_) } = delete $key{ $_ } foreach grep lc ne $_, keys %key;
1979 return $key{ $_[0] };
1984 =head2 UseKeyForSigning
1986 Returns or sets identifier of the key that should be used for signing.
1988 Returns the current value when called without arguments.
1990 Sets new value when called with one argument and unsets if it's undef.
1995 sub UseKeyForSigning {
2002 =head2 GetKeysForEncryption
2004 Takes identifier and returns keys suitable for encryption.
2006 B<Note> that keys for which trust level is not set are
2011 sub GetKeysForEncryption {
2013 my %res = GetKeysInfo( $key_id, 'public', @_ );
2014 return %res if $res{'exit_code'};
2015 return %res unless $res{'info'};
2017 foreach my $key ( splice @{ $res{'info'} } ) {
2018 # skip disabled keys
2019 next if $key->{'Capabilities'} =~ /D/;
2020 # skip keys not suitable for encryption
2021 next unless $key->{'Capabilities'} =~ /e/i;
2022 # skip disabled, expired, revoke and keys with no trust,
2023 # but leave keys with unknown trust level
2024 next if $key->{'TrustLevel'} < 0;
2026 push @{ $res{'info'} }, $key;
2028 delete $res{'info'} unless @{ $res{'info'} };
2032 sub GetKeysForSigning {
2034 return GetKeysInfo( $key_id, 'private', @_ );
2037 sub CheckRecipients {
2038 my @recipients = (@_);
2040 my ($status, @issues) = (1, ());
2043 foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) {
2044 my %res = GetKeysForEncryption( $address );
2045 if ( $res{'info'} && @{ $res{'info'} } == 1 && $res{'info'}[0]{'TrustLevel'} > 0 ) {
2046 # good, one suitable and trusted key
2049 my $user = RT::User->new( RT->SystemUser );
2050 $user->LoadByEmail( $address );
2051 # it's possible that we have no User record with the email
2052 $user = undef unless $user->id;
2054 if ( my $fpr = UseKeyForEncryption( $address ) ) {
2055 if ( $res{'info'} && @{ $res{'info'} } ) {
2057 grep lc $_->{'Fingerprint'} eq lc $fpr,
2058 grep $_->{'TrustLevel'} > 0,
2064 EmailAddress => $address,
2065 $user? (User => $user) : (),
2068 $issue{'Message'} = "Selected key either is not trusted or doesn't exist anymore."; #loc
2069 push @issues, \%issue;
2074 $prefered_key = $user->PreferredKey if $user;
2075 #XXX: prefered key is not yet implemented...
2080 EmailAddress => $address,
2081 $user? (User => $user) : (),
2085 unless ( $res{'info'} && @{ $res{'info'} } ) {
2087 $issue{'Message'} = "There is no key suitable for encryption."; #loc
2089 elsif ( @{ $res{'info'} } == 1 && !$res{'info'}[0]{'TrustLevel'} ) {
2091 $issue{'Message'} = "There is one suitable key, but trust level is not set."; #loc
2095 $issue{'Message'} = "There are several keys suitable for encryption."; #loc
2097 push @issues, \%issue;
2099 return ($status, @issues);
2102 sub GetPublicKeyInfo {
2103 return GetKeyInfo( shift, 'public', @_ );
2106 sub GetPrivateKeyInfo {
2107 return GetKeyInfo( shift, 'private', @_ );
2111 my %res = GetKeysInfo(@_);
2112 $res{'info'} = $res{'info'}->[0];
2118 my $type = shift || 'public';
2122 return (exit_code => 0) unless $force;
2125 my $gnupg = GnuPG::Interface->new();
2126 my %opt = RT->Config->Get('GnuPGOptions');
2127 $opt{'digest-algo'} ||= 'SHA1';
2128 $opt{'with-colons'} = undef; # parseable format
2129 $opt{'fingerprint'} = undef; # show fingerprint
2130 $opt{'fixed-list-mode'} = undef; # don't merge uid with keys
2131 $gnupg->options->hash_init(
2132 _PrepareGnuPGOptions( %opt ),
2134 meta_interactive => 0,
2139 my ($handles, $handle_list) = _make_gpg_handles();
2140 my %handle = %$handle_list;
2143 local $SIG{'CHLD'} = 'DEFAULT';
2144 my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
2145 my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email
2146 ? (command_args => [ "--", $email])
2148 close $handle{'stdin'};
2152 my @info = readline $handle{'stdout'};
2153 close $handle{'stdout'};
2155 $res{'exit_code'} = $?;
2156 foreach ( qw(stderr logger status) ) {
2157 $res{$_} = do { local $/; readline $handle{$_} };
2158 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2161 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2162 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2163 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2165 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
2169 @info = ParseKeysInfo( @info );
2170 $res{'info'} = \@info;
2177 my %gpg_opt = RT->Config->Get('GnuPGOptions');
2180 foreach my $line( @lines ) {
2183 ($tag, $line) = split /:/, $line, 2;
2184 if ( $tag eq 'pub' ) {
2187 TrustChar KeyLength Algorithm Key
2188 Created Expire Empty OwnerTrustChar
2189 Empty Empty Capabilities Other
2190 ) } = split /:/, $line, 12;
2192 # workaround gnupg's wierd behaviour, --list-keys command report calculated trust levels
2193 # for any model except 'always', so you can change models and see changes, but not for 'always'
2194 # we try to handle it in a simple way - we set ultimate trust for any key with trust
2195 # level >= 0 if trust model is 'always'
2197 $always_trust = 1 if exists $gpg_opt{'always-trust'};
2198 $always_trust = 1 if exists $gpg_opt{'trust-model'} && $gpg_opt{'trust-model'} eq 'always';
2199 @info{qw(Trust TrustTerse TrustLevel)} =
2200 _ConvertTrustChar( $info{'TrustChar'} );
2201 if ( $always_trust && $info{'TrustLevel'} >= 0 ) {
2202 @info{qw(Trust TrustTerse TrustLevel)} =
2203 _ConvertTrustChar( 'u' );
2206 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
2207 _ConvertTrustChar( $info{'OwnerTrustChar'} );
2208 $info{ $_ } = _ParseDate( $info{ $_ } )
2209 foreach qw(Created Expire);
2212 elsif ( $tag eq 'sec' ) {
2215 Empty KeyLength Algorithm Key
2216 Created Expire Empty OwnerTrustChar
2217 Empty Empty Capabilities Other
2218 ) } = split /:/, $line, 12;
2219 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
2220 _ConvertTrustChar( $info{'OwnerTrustChar'} );
2221 $info{ $_ } = _ParseDate( $info{ $_ } )
2222 foreach qw(Created Expire);
2225 elsif ( $tag eq 'uid' ) {
2227 @info{ qw(Trust Created Expire String) }
2228 = (split /:/, $line)[0,4,5,8];
2229 $info{ $_ } = _ParseDate( $info{ $_ } )
2230 foreach qw(Created Expire);
2231 push @{ $res[-1]{'User'} ||= [] }, \%info;
2233 elsif ( $tag eq 'fpr' ) {
2234 $res[-1]{'Fingerprint'} = (split /:/, $line, 10)[8];
2244 "The key has been disabled", #loc
2245 "key disabled", #loc
2250 "The key has been revoked", #loc
2255 e => [ "The key has expired", #loc
2260 n => [ "Don't trust this key at all", #loc
2265 #gpupg docs says that '-' and 'q' may safely be treated as the same value
2267 'Unknown (no trust value assigned)', #loc
2272 'Unknown (no trust value assigned)', #loc
2277 'Unknown (this value is new to the system)', #loc
2283 "There is marginal trust in this key", #loc
2288 "The key is fully trusted", #loc
2293 "The key is ultimately trusted", #loc
2299 sub _ConvertTrustChar {
2301 return @{ $verbose{'-'} } unless $value;
2302 $value = substr $value, 0, 1;
2303 return @{ $verbose{ $value } || $verbose{'o'} };
2310 return $value unless $value;
2313 my $obj = RT::Date->new( RT->SystemUser );
2315 if ( $value =~ /^\d+$/ ) {
2316 $obj->Set( Value => $value );
2318 $obj->Set( Format => 'unknown', Value => $value, Timezone => 'utc' );
2326 my $gnupg = GnuPG::Interface->new();
2327 my %opt = RT->Config->Get('GnuPGOptions');
2328 $gnupg->options->hash_init(
2329 _PrepareGnuPGOptions( %opt ),
2330 meta_interactive => 0,
2333 my ($handles, $handle_list) = _make_gpg_handles();
2334 my %handle = %$handle_list;
2337 local $SIG{'CHLD'} = 'DEFAULT';
2338 my $pid = safe_run_child { $gnupg->wrap_call(
2339 handles => $handles,
2340 commands => ['--delete-secret-and-public-key'],
2341 command_args => ["--", $key],
2343 close $handle{'stdin'};
2344 while ( my $str = readline $handle{'status'} ) {
2345 if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) {
2346 print { $handle{'command'} } "y\n";
2352 close $handle{'stdout'};
2355 $res{'exit_code'} = $?;
2356 foreach ( qw(stderr logger status) ) {
2357 $res{$_} = do { local $/; readline $handle{$_} };
2358 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2361 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2362 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2363 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2364 if ( $err || $res{'exit_code'} ) {
2365 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
2373 my $gnupg = GnuPG::Interface->new();
2374 my %opt = RT->Config->Get('GnuPGOptions');
2375 $gnupg->options->hash_init(
2376 _PrepareGnuPGOptions( %opt ),
2377 meta_interactive => 0,
2380 my ($handles, $handle_list) = _make_gpg_handles();
2381 my %handle = %$handle_list;
2384 local $SIG{'CHLD'} = 'DEFAULT';
2385 my $pid = safe_run_child { $gnupg->wrap_call(
2386 handles => $handles,
2387 commands => ['--import'],
2389 print { $handle{'stdin'} } $key;
2390 close $handle{'stdin'};
2394 close $handle{'stdout'};
2397 $res{'exit_code'} = $?;
2398 foreach ( qw(stderr logger status) ) {
2399 $res{$_} = do { local $/; readline $handle{$_} };
2400 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2403 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2404 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2405 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2406 if ( $err || $res{'exit_code'} ) {
2407 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
2414 Signs a small message with the key, to make sure the key exists and
2415 we have a useable passphrase. The first argument MUST be a key identifier
2416 of the signer: either email address, key id or finger print.
2418 Returns a true value if all went well.
2425 my $mime = MIME::Entity->build(
2426 Type => "text/plain",
2427 From => 'nobody@localhost',
2428 To => 'nobody@localhost',
2429 Subject => "dry sign",
2433 my %res = SignEncrypt(
2440 return $res{exit_code} == 0;
2447 This routine returns true if RT's GnuPG support is configured and working
2448 properly (and false otherwise).
2455 my $gnupg = GnuPG::Interface->new();
2456 my %opt = RT->Config->Get('GnuPGOptions');
2457 $gnupg->options->hash_init(
2458 _PrepareGnuPGOptions( %opt ),
2460 meta_interactive => 0,
2463 my ($handles, $handle_list) = _make_gpg_handles();
2464 my %handle = %$handle_list;
2468 local $SIG{'CHLD'} = 'DEFAULT';
2469 my $pid = safe_run_child { $gnupg->wrap_call( commands => ['--version' ], handles => $handles ) };
2470 close $handle{'stdin'};
2475 "Probe for GPG failed."
2476 ." Couldn't run `gpg --version`: ". $@
2481 # on some systems gpg exits with code 2, but still 100% functional,
2482 # it's general error system error or incorrect command, command is correct,
2483 # but there is no way to get actuall error
2484 if ( $? && ($? >> 8) != 2 ) {
2485 my $msg = "Probe for GPG failed."
2486 ." Process exitted with code ". ($? >> 8)
2487 . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '')
2489 foreach ( qw(stderr logger status) ) {
2490 my $tmp = do { local $/; readline $handle{$_} };
2491 next unless $tmp && $tmp =~ /\S/s;
2493 $msg .= "\n$_:\n$tmp\n";
2495 $RT::Logger->debug( $msg );
2502 sub _make_gpg_handles {
2503 my %handle_map = (@_);
2504 $handle_map{$_} = IO::Handle->new
2505 foreach grep !defined $handle_map{$_},
2506 qw(stdin stdout stderr logger status command);
2508 my $handles = GnuPG::Handles->new(%handle_map);
2509 return ($handles, \%handle_map);
2512 RT::Base->_ImportOverlays();
2514 # helper package to avoid using temp file
2515 package IO::Handle::CRLF;
2517 use base qw(IO::Handle);
2520 my ($self, @args) = (@_);
2521 s/\r*\n/\x0D\x0A/g foreach @args;
2522 return $self->SUPER::print( @args );