1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2015 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 my @addresses = Email::Address->parse( Encode::decode("UTF-8",$entity->head->get( 'From' )));
405 $args{'Signer'} = UseKeyForSigning()
406 || $addresses[0]->address;
408 if ( $args{'Encrypt'} && !$args{'Recipients'} ) {
410 $args{'Recipients'} = [
411 grep $_ && !$seen{ $_ }++, map $_->address,
412 map Email::Address->parse( Encode::decode("UTF-8",$entity->head->get( $_ ) ) ),
417 my $format = lc RT->Config->Get('GnuPG')->{'OutgoingMessagesFormat'} || 'RFC';
418 if ( $format eq 'inline' ) {
419 return SignEncryptInline( %args );
421 return SignEncryptRFC3156( %args );
425 sub SignEncryptRFC3156 {
439 my $gnupg = GnuPG::Interface->new();
440 my %opt = RT->Config->Get('GnuPGOptions');
442 # handling passphrase in GnuPGOptions
443 $args{'Passphrase'} = delete $opt{'passphrase'}
444 if !defined $args{'Passphrase'};
446 $opt{'digest-algo'} ||= 'SHA1';
447 $opt{'default_key'} = $args{'Signer'}
448 if $args{'Sign'} && $args{'Signer'};
449 $gnupg->options->hash_init(
450 _PrepareGnuPGOptions( %opt ),
452 meta_interactive => 0,
455 my $entity = $args{'Entity'};
457 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
458 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
462 if ( $args{'Sign'} && !$args{'Encrypt'} ) {
463 # required by RFC3156(Ch. 5) and RFC1847(Ch. 2.1)
464 foreach ( grep !$_->is_multipart, $entity->parts_DFS ) {
465 my $tenc = $_->head->mime_encoding;
466 unless ( $tenc =~ m/^(?:7bit|quoted-printable|base64)$/i ) {
467 $_->head->mime_attr( 'Content-Transfer-Encoding'
468 => $_->effective_type =~ m{^text/}? 'quoted-printable': 'base64'
473 my ($handles, $handle_list) = _make_gpg_handles(stdin =>IO::Handle::CRLF->new );
474 my %handle = %$handle_list;
476 $gnupg->passphrase( $args{'Passphrase'} );
479 local $SIG{'CHLD'} = 'DEFAULT';
480 my $pid = safe_run_child { $gnupg->detach_sign( handles => $handles ) };
481 $entity->make_multipart( 'mixed', Force => 1 );
483 local $SIG{'PIPE'} = 'IGNORE';
484 $entity->parts(0)->print( $handle{'stdin'} );
485 close $handle{'stdin'};
490 my @signature = readline $handle{'stdout'};
491 close $handle{'stdout'};
493 $res{'exit_code'} = $?;
494 foreach ( qw(stderr logger status) ) {
495 $res{$_} = do { local $/; readline $handle{$_} };
496 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
499 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
500 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
501 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
502 if ( $err || $res{'exit_code'} ) {
503 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
507 # setup RFC1847(Ch.2.1) requirements
508 my $protocol = 'application/pgp-signature';
509 $entity->head->mime_attr( 'Content-Type' => 'multipart/signed' );
510 $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
511 $entity->head->mime_attr( 'Content-Type.micalg' => 'pgp-'. lc $opt{'digest-algo'} );
514 Disposition => 'inline',
519 if ( $args{'Encrypt'} ) {
521 $gnupg->options->push_recipients( $_ ) foreach
522 map UseKeyForEncryption($_) || $_,
523 grep !$seen{ $_ }++, map $_->address,
524 map Email::Address->parse( Encode::decode( "UTF-8", $entity->head->get( $_ ) ) ),
527 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
528 binmode $tmp_fh, ':raw';
530 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
531 my %handle = %$handle_list;
532 $handles->options( 'stdout' )->{'direct'} = 1;
533 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
536 local $SIG{'CHLD'} = 'DEFAULT';
537 my $pid = safe_run_child { $args{'Sign'}
538 ? $gnupg->sign_and_encrypt( handles => $handles )
539 : $gnupg->encrypt( handles => $handles ) };
540 $entity->make_multipart( 'mixed', Force => 1 );
542 local $SIG{'PIPE'} = 'IGNORE';
543 $entity->parts(0)->print( $handle{'stdin'} );
544 close $handle{'stdin'};
549 $res{'exit_code'} = $?;
550 foreach ( qw(stderr logger status) ) {
551 $res{$_} = do { local $/; readline $handle{$_} };
552 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
555 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
556 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
557 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
559 $res{'message'} = $@? $@: "gpg exited with error code ". ($? >> 8);
563 my $protocol = 'application/pgp-encrypted';
565 $entity->head->mime_attr( 'Content-Type' => 'multipart/encrypted' );
566 $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
569 Disposition => 'inline',
570 Data => ['Version: 1',''],
574 Type => 'application/octet-stream',
575 Disposition => 'inline',
580 $entity->parts(-1)->bodyhandle->{'_dirty_hack_to_save_a_ref_tmp_fh'} = $tmp_fh;
585 sub SignEncryptInline {
588 my $entity = $args{'Entity'};
591 $entity->make_singlepart;
592 if ( $entity->is_multipart ) {
593 foreach ( $entity->parts ) {
594 %res = SignEncryptInline( @_, Entity => $_ );
595 return %res if $res{'exit_code'};
600 return _SignEncryptTextInline( @_ )
601 if $entity->effective_type =~ /^text\//i;
603 return _SignEncryptAttachmentInline( @_ );
606 sub _SignEncryptTextInline {
619 return unless $args{'Sign'} || $args{'Encrypt'};
621 my $gnupg = GnuPG::Interface->new();
622 my %opt = RT->Config->Get('GnuPGOptions');
624 # handling passphrase in GnupGOptions
625 $args{'Passphrase'} = delete $opt{'passphrase'}
626 if !defined($args{'Passphrase'});
628 $opt{'digest-algo'} ||= 'SHA1';
629 $opt{'default_key'} = $args{'Signer'}
630 if $args{'Sign'} && $args{'Signer'};
631 $gnupg->options->hash_init(
632 _PrepareGnuPGOptions( %opt ),
634 meta_interactive => 0,
637 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
638 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
641 if ( $args{'Encrypt'} ) {
642 $gnupg->options->push_recipients( $_ ) foreach
643 map UseKeyForEncryption($_) || $_,
644 @{ $args{'Recipients'} || [] };
649 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
650 binmode $tmp_fh, ':raw';
652 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
653 my %handle = %$handle_list;
655 $handles->options( 'stdout' )->{'direct'} = 1;
656 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
658 my $entity = $args{'Entity'};
660 local $SIG{'CHLD'} = 'DEFAULT';
661 my $method = $args{'Sign'} && $args{'Encrypt'}
663 : ($args{'Sign'}? 'clearsign': 'encrypt');
664 my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
666 local $SIG{'PIPE'} = 'IGNORE';
667 $entity->bodyhandle->print( $handle{'stdin'} );
668 close $handle{'stdin'};
672 $res{'exit_code'} = $?;
675 foreach ( qw(stderr logger status) ) {
676 $res{$_} = do { local $/; readline $handle{$_} };
677 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
680 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
681 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
682 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
683 if ( $err || $res{'exit_code'} ) {
684 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
688 $entity->bodyhandle( MIME::Body::File->new( $tmp_fn) );
689 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
694 sub _SignEncryptAttachmentInline {
707 return unless $args{'Sign'} || $args{'Encrypt'};
709 my $gnupg = GnuPG::Interface->new();
710 my %opt = RT->Config->Get('GnuPGOptions');
712 # handling passphrase in GnupGOptions
713 $args{'Passphrase'} = delete $opt{'passphrase'}
714 if !defined($args{'Passphrase'});
716 $opt{'digest-algo'} ||= 'SHA1';
717 $opt{'default_key'} = $args{'Signer'}
718 if $args{'Sign'} && $args{'Signer'};
719 $gnupg->options->hash_init(
720 _PrepareGnuPGOptions( %opt ),
722 meta_interactive => 0,
725 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
726 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
729 my $entity = $args{'Entity'};
730 if ( $args{'Encrypt'} ) {
731 $gnupg->options->push_recipients( $_ ) foreach
732 map UseKeyForEncryption($_) || $_,
733 @{ $args{'Recipients'} || [] };
738 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
739 binmode $tmp_fh, ':raw';
741 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
742 my %handle = %$handle_list;
743 $handles->options( 'stdout' )->{'direct'} = 1;
744 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
747 local $SIG{'CHLD'} = 'DEFAULT';
748 my $method = $args{'Sign'} && $args{'Encrypt'}
750 : ($args{'Sign'}? 'detach_sign': 'encrypt');
751 my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
753 local $SIG{'PIPE'} = 'IGNORE';
754 $entity->bodyhandle->print( $handle{'stdin'} );
755 close $handle{'stdin'};
759 $res{'exit_code'} = $?;
762 foreach ( qw(stderr logger status) ) {
763 $res{$_} = do { local $/; readline $handle{$_} };
764 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
767 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
768 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
769 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
770 if ( $err || $res{'exit_code'} ) {
771 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
775 my $filename = mime_recommended_filename( $entity ) || 'no_name';
776 if ( $args{'Sign'} && !$args{'Encrypt'} ) {
777 $entity->make_multipart;
779 Type => 'application/octet-stream',
781 Filename => "$filename.sig",
782 Disposition => 'attachment',
785 $entity->bodyhandle(MIME::Body::File->new( $tmp_fn) );
786 $entity->effective_type('application/octet-stream');
787 $entity->head->mime_attr( $_ => "$filename.pgp" )
788 foreach (qw(Content-Type.name Content-Disposition.filename));
791 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
796 sub SignEncryptContent {
809 return unless $args{'Sign'} || $args{'Encrypt'};
811 my $gnupg = GnuPG::Interface->new();
812 my %opt = RT->Config->Get('GnuPGOptions');
814 # handling passphrase in GnupGOptions
815 $args{'Passphrase'} = delete $opt{'passphrase'}
816 if !defined($args{'Passphrase'});
818 $opt{'digest-algo'} ||= 'SHA1';
819 $opt{'default_key'} = $args{'Signer'}
820 if $args{'Sign'} && $args{'Signer'};
821 $gnupg->options->hash_init(
822 _PrepareGnuPGOptions( %opt ),
824 meta_interactive => 0,
827 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
828 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
831 if ( $args{'Encrypt'} ) {
832 $gnupg->options->push_recipients( $_ ) foreach
833 map UseKeyForEncryption($_) || $_,
834 @{ $args{'Recipients'} || [] };
839 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
840 binmode $tmp_fh, ':raw';
842 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
843 my %handle = %$handle_list;
844 $handles->options( 'stdout' )->{'direct'} = 1;
845 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
848 local $SIG{'CHLD'} = 'DEFAULT';
849 my $method = $args{'Sign'} && $args{'Encrypt'}
851 : ($args{'Sign'}? 'clearsign': 'encrypt');
852 my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
854 local $SIG{'PIPE'} = 'IGNORE';
855 $handle{'stdin'}->print( ${ $args{'Content'} } );
856 close $handle{'stdin'};
860 $res{'exit_code'} = $?;
863 foreach ( qw(stderr logger status) ) {
864 $res{$_} = do { local $/; readline $handle{$_} };
865 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
868 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
869 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
870 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
871 if ( $err || $res{'exit_code'} ) {
872 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
876 ${ $args{'Content'} } = '';
879 my $status = read $tmp_fh, my $buf, 4*1024;
880 unless ( defined $status ) {
881 $RT::Logger->crit( "couldn't read message: $!" );
882 } elsif ( !$status ) {
885 ${ $args{'Content'} } .= $buf;
891 sub FindProtectedParts {
892 my %args = ( Entity => undef, CheckBody => 1, @_ );
893 my $entity = $args{'Entity'};
895 # inline PGP block, only in singlepart
896 unless ( $entity->is_multipart ) {
897 my $file = ($entity->head->recommended_filename||'') =~ /\.${RE_FILE_EXTENSIONS}$/;
899 my $io = $entity->open('r');
901 $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
905 # Deal with "partitioned" PGP mail, which (contrary to common
906 # sense) unnecessarily applies a base64 transfer encoding to PGP
907 # mail (whose content is already base64-encoded).
908 if ( $entity->bodyhandle->is_encoded and $entity->head->mime_encoding ) {
909 my $decoder = MIME::Decoder->new( $entity->head->mime_encoding );
914 open my $fh, '>', \$buf
915 or die "Couldn't open scalar for writing: $!";
917 $decoder->decode($io, $fh);
918 close $fh or die "Couldn't close scalar: $!";
921 or die "Couldn't re-open scalar for reading: $!";
926 $RT::Logger->error("Couldn't decode body: $@");
931 while ( defined($_ = $io->getline) ) {
932 next unless /^-----BEGIN PGP (SIGNED )?MESSAGE-----/;
933 my $type = $1? 'signed': 'encrypted';
934 $RT::Logger->debug("Found $type inline part");
937 Format => !$file || $type eq 'signed'? 'Inline' : 'Attachment',
945 # RFC3156, multipart/{signed,encrypted}
946 if ( ( my $type = $entity->effective_type ) =~ /^multipart\/(?:encrypted|signed)$/ ) {
947 unless ( $entity->parts == 2 ) {
948 $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
952 my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
953 unless ( $protocol ) {
954 $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" );
958 if ( $type eq 'multipart/encrypted' ) {
959 unless ( $protocol eq 'application/pgp-encrypted' ) {
960 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" );
963 $RT::Logger->debug("Found encrypted according to RFC3156 part");
968 Data => $entity->parts(1),
969 Info => $entity->parts(0),
972 unless ( $protocol eq 'application/pgp-signature' ) {
973 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
976 $RT::Logger->debug("Found signed according to RFC3156 part");
981 Data => $entity->parts(0),
982 Signature => $entity->parts(1),
987 # attachments signed with signature in another part
989 foreach my $i ( 0 .. $entity->parts - 1 ) {
990 my $part = $entity->parts($i);
992 # we can not associate a signature within an attachment
994 my $fname = $part->head->recommended_filename;
997 if ( $part->effective_type eq 'application/pgp-signature' ) {
998 push @file_indices, $i;
1000 elsif ( $fname =~ /\.sig$/i && $part->effective_type eq 'application/octet-stream' ) {
1001 push @file_indices, $i;
1006 foreach my $i ( @file_indices ) {
1007 my $sig_part = $entity->parts($i);
1008 $skip{"$sig_part"}++;
1009 my $sig_name = $sig_part->head->recommended_filename;
1010 my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/;
1012 my ($data_part_idx) =
1013 grep $file_name eq ($entity->parts($_)->head->recommended_filename||''),
1014 grep $sig_part ne $entity->parts($_),
1015 0 .. $entity->parts - 1;
1016 unless ( defined $data_part_idx ) {
1017 $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
1020 my $data_part_in = $entity->parts($data_part_idx);
1022 $skip{"$data_part_in"}++;
1023 $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
1026 Format => 'Attachment',
1028 Data => $data_part_in,
1029 Signature => $sig_part,
1033 # attachments with inline encryption
1034 my @encrypted_indices =
1035 grep {($entity->parts($_)->head->recommended_filename || '') =~ /\.${RE_FILE_EXTENSIONS}$/}
1036 0 .. $entity->parts - 1;
1038 foreach my $i ( @encrypted_indices ) {
1039 my $part = $entity->parts($i);
1041 $RT::Logger->debug("Found encrypted attachment '". $part->head->recommended_filename ."'");
1043 Type => 'encrypted',
1044 Format => 'Attachment',
1050 push @res, FindProtectedParts( Entity => $_ )
1051 foreach grep !$skip{"$_"}, $entity->parts;
1056 =head2 VerifyDecrypt Entity => undef, [ Detach => 1, Passphrase => undef, SetStatus => 1 ]
1068 my @protected = FindProtectedParts( Entity => $args{'Entity'} );
1070 # XXX: detaching may brake nested signatures
1071 foreach my $item( grep $_->{'Type'} eq 'signed', @protected ) {
1073 if ( $item->{'Format'} eq 'RFC3156' ) {
1074 push @res, { VerifyRFC3156( %$item, SetStatus => $args{'SetStatus'} ) };
1075 if ( $args{'Detach'} ) {
1076 $item->{'Top'}->parts( [ $item->{'Data'} ] );
1077 $item->{'Top'}->make_singlepart;
1079 $status_on = $item->{'Top'};
1080 } elsif ( $item->{'Format'} eq 'Inline' ) {
1081 push @res, { VerifyInline( %$item ) };
1082 $status_on = $item->{'Data'};
1083 } elsif ( $item->{'Format'} eq 'Attachment' ) {
1084 push @res, { VerifyAttachment( %$item ) };
1085 if ( $args{'Detach'} ) {
1086 $item->{'Top'}->parts( [
1087 grep "$_" ne $item->{'Signature'}, $item->{'Top'}->parts
1089 $item->{'Top'}->make_singlepart;
1091 $status_on = $item->{'Data'};
1093 if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
1094 my $method = $args{'AddStatus'} ? 'add' : 'set';
1095 # Let the header be modified so continuations are handled
1096 my $modify = $status_on->head->modify;
1097 $status_on->head->modify(1);
1098 $status_on->head->$method(
1099 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
1101 $status_on->head->modify($modify);
1104 foreach my $item( grep $_->{'Type'} eq 'encrypted', @protected ) {
1106 if ( $item->{'Format'} eq 'RFC3156' ) {
1107 push @res, { DecryptRFC3156( %$item ) };
1108 $status_on = $item->{'Top'};
1109 } elsif ( $item->{'Format'} eq 'Inline' ) {
1110 push @res, { DecryptInline( %$item ) };
1111 $status_on = $item->{'Data'};
1112 } elsif ( $item->{'Format'} eq 'Attachment' ) {
1113 push @res, { DecryptAttachment( %$item ) };
1114 $status_on = $item->{'Data'};
1116 if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
1117 my $method = $args{'AddStatus'} ? 'add' : 'set';
1118 # Let the header be modified so continuations are handled
1119 my $modify = $status_on->head->modify;
1120 $status_on->head->modify(1);
1121 $status_on->head->$method(
1122 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
1124 $status_on->head->modify($modify);
1130 sub VerifyInline { return DecryptInline( @_ ) }
1132 sub VerifyAttachment {
1133 my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
1135 my $gnupg = GnuPG::Interface->new();
1136 my %opt = RT->Config->Get('GnuPGOptions');
1137 $opt{'digest-algo'} ||= 'SHA1';
1138 $gnupg->options->hash_init(
1139 _PrepareGnuPGOptions( %opt ),
1140 meta_interactive => 0,
1143 foreach ( $args{'Data'}, $args{'Signature'} ) {
1144 next unless $_->bodyhandle->is_encoded;
1146 require RT::EmailParser;
1147 RT::EmailParser->_DecodeBody($_);
1150 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1151 binmode $tmp_fh, ':raw';
1152 $args{'Data'}->bodyhandle->print( $tmp_fh );
1155 my ($handles, $handle_list) = _make_gpg_handles();
1156 my %handle = %$handle_list;
1160 local $SIG{'CHLD'} = 'DEFAULT';
1161 my $pid = safe_run_child { $gnupg->verify(
1162 handles => $handles, command_args => [ '-', $tmp_fn ]
1165 local $SIG{'PIPE'} = 'IGNORE';
1166 $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
1167 close $handle{'stdin'};
1171 $res{'exit_code'} = $?;
1172 foreach ( qw(stderr logger status) ) {
1173 $res{$_} = do { local $/; readline $handle{$_} };
1174 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1177 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1178 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1179 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1181 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1187 my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
1189 my $gnupg = GnuPG::Interface->new();
1190 my %opt = RT->Config->Get('GnuPGOptions');
1191 $opt{'digest-algo'} ||= 'SHA1';
1192 $gnupg->options->hash_init(
1193 _PrepareGnuPGOptions( %opt ),
1194 meta_interactive => 0,
1197 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1198 binmode $tmp_fh, ':raw:eol(CRLF?)';
1199 $args{'Data'}->print( $tmp_fh );
1202 my ($handles, $handle_list) = _make_gpg_handles();
1203 my %handle = %$handle_list;
1207 local $SIG{'CHLD'} = 'DEFAULT';
1208 my $pid = safe_run_child { $gnupg->verify(
1209 handles => $handles, command_args => [ '-', $tmp_fn ]
1212 local $SIG{'PIPE'} = 'IGNORE';
1213 $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
1214 close $handle{'stdin'};
1218 $res{'exit_code'} = $?;
1219 foreach ( qw(stderr logger status) ) {
1220 $res{$_} = do { local $/; readline $handle{$_} };
1221 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1224 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1225 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1226 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1228 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1233 sub DecryptRFC3156 {
1238 Passphrase => undef,
1242 my $gnupg = GnuPG::Interface->new();
1243 my %opt = RT->Config->Get('GnuPGOptions');
1245 # handling passphrase in GnupGOptions
1246 $args{'Passphrase'} = delete $opt{'passphrase'}
1247 if !defined($args{'Passphrase'});
1249 $opt{'digest-algo'} ||= 'SHA1';
1250 $gnupg->options->hash_init(
1251 _PrepareGnuPGOptions( %opt ),
1252 meta_interactive => 0,
1255 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1256 require RT::EmailParser;
1257 RT::EmailParser->_DecodeBody($args{'Data'});
1260 $args{'Passphrase'} = GetPassphrase()
1261 unless defined $args{'Passphrase'};
1263 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1264 binmode $tmp_fh, ':raw';
1266 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
1267 my %handle = %$handle_list;
1268 $handles->options( 'stdout' )->{'direct'} = 1;
1272 local $SIG{'CHLD'} = 'DEFAULT';
1273 $gnupg->passphrase( $args{'Passphrase'} );
1274 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1276 local $SIG{'PIPE'} = 'IGNORE';
1277 $args{'Data'}->bodyhandle->print( $handle{'stdin'} );
1278 close $handle{'stdin'}
1283 $res{'exit_code'} = $?;
1284 foreach ( qw(stderr logger status) ) {
1285 $res{$_} = do { local $/; readline $handle{$_} };
1286 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1289 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1290 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1291 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1293 # if the decryption is fine but the signature is bad, then without this
1294 # status check we lose the decrypted text
1295 # XXX: add argument to the function to control this check
1296 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1298 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1304 my $parser = RT::EmailParser->new();
1305 my $decrypted = $parser->ParseMIMEEntityFromFileHandle( $tmp_fh, 0 );
1306 $decrypted->{'__store_link_to_object_to_avoid_early_cleanup'} = $parser;
1307 $args{'Top'}->parts( [] );
1308 $args{'Top'}->add_part( $decrypted );
1309 $args{'Top'}->make_singlepart;
1316 Passphrase => undef,
1320 my $gnupg = GnuPG::Interface->new();
1321 my %opt = RT->Config->Get('GnuPGOptions');
1323 # handling passphrase in GnuPGOptions
1324 $args{'Passphrase'} = delete $opt{'passphrase'}
1325 if !defined($args{'Passphrase'});
1327 $opt{'digest-algo'} ||= 'SHA1';
1328 $gnupg->options->hash_init(
1329 _PrepareGnuPGOptions( %opt ),
1330 meta_interactive => 0,
1333 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1334 require RT::EmailParser;
1335 RT::EmailParser->_DecodeBody($args{'Data'});
1338 $args{'Passphrase'} = GetPassphrase()
1339 unless defined $args{'Passphrase'};
1341 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1342 binmode $tmp_fh, ':raw';
1344 my $io = $args{'Data'}->open('r');
1346 die "Entity has no body, never should happen";
1351 my ($had_literal, $in_block) = ('', 0);
1352 my ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1353 binmode $block_fh, ':raw';
1355 while ( defined(my $str = $io->getline) ) {
1356 if ( $in_block && $str =~ /^-----END PGP (?:MESSAGE|SIGNATURE)-----/ ) {
1357 print $block_fh $str;
1359 next if $in_block > 0;
1361 seek $block_fh, 0, 0;
1363 my ($res_fh, $res_fn);
1364 ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1367 BlockHandle => $block_fh,
1369 return %res unless $res_fh;
1371 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1372 while (my $buf = <$res_fh> ) {
1375 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1377 ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1378 binmode $block_fh, ':raw';
1381 elsif ( $str =~ /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) {
1383 print $block_fh $str;
1385 elsif ( $in_block ) {
1386 print $block_fh $str;
1390 $had_literal = 1 if /\S/s;
1396 # we're still in a block, this not bad not good. let's try to
1397 # decrypt what we have, it can be just missing -----END PGP...
1398 seek $block_fh, 0, 0;
1400 my ($res_fh, $res_fn);
1401 ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1404 BlockHandle => $block_fh,
1406 return %res unless $res_fh;
1408 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1409 while (my $buf = <$res_fh> ) {
1412 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1416 $args{'Data'}->bodyhandle(MIME::Body::File->new( $tmp_fn ));
1417 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
1421 sub _DecryptInlineBlock {
1424 BlockHandle => undef,
1425 Passphrase => undef,
1428 my $gnupg = $args{'GnuPG'};
1430 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1431 binmode $tmp_fh, ':raw';
1433 my ($handles, $handle_list) = _make_gpg_handles(
1434 stdin => $args{'BlockHandle'},
1436 my %handle = %$handle_list;
1437 $handles->options( 'stdout' )->{'direct'} = 1;
1438 $handles->options( 'stdin' )->{'direct'} = 1;
1442 local $SIG{'CHLD'} = 'DEFAULT';
1443 $gnupg->passphrase( $args{'Passphrase'} );
1444 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1447 $res{'exit_code'} = $?;
1448 foreach ( qw(stderr logger status) ) {
1449 $res{$_} = do { local $/; readline $handle{$_} };
1450 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1453 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1454 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1455 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1457 # if the decryption is fine but the signature is bad, then without this
1458 # status check we lose the decrypted text
1459 # XXX: add argument to the function to control this check
1460 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1462 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1463 return (undef, undef, %res);
1468 return ($tmp_fh, $tmp_fn, %res);
1471 sub DecryptAttachment {
1475 Passphrase => undef,
1479 my $gnupg = GnuPG::Interface->new();
1480 my %opt = RT->Config->Get('GnuPGOptions');
1482 # handling passphrase in GnuPGOptions
1483 $args{'Passphrase'} = delete $opt{'passphrase'}
1484 if !defined($args{'Passphrase'});
1486 $opt{'digest-algo'} ||= 'SHA1';
1487 $gnupg->options->hash_init(
1488 _PrepareGnuPGOptions( %opt ),
1489 meta_interactive => 0,
1492 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1493 require RT::EmailParser;
1494 RT::EmailParser->_DecodeBody($args{'Data'});
1497 $args{'Passphrase'} = GetPassphrase()
1498 unless defined $args{'Passphrase'};
1500 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1501 binmode $tmp_fh, ':raw';
1502 $args{'Data'}->bodyhandle->print( $tmp_fh );
1505 my ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1508 BlockHandle => $tmp_fh,
1510 return %res unless $res_fh;
1512 $args{'Data'}->bodyhandle(MIME::Body::File->new($res_fn) );
1513 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $res_fh;
1515 my $head = $args{'Data'}->head;
1517 # we can not trust original content type
1518 # TODO: and don't have way to detect, so we just use octet-stream
1519 # some clients may send .asc files (encryped) as text/plain
1520 $head->mime_attr( "Content-Type" => 'application/octet-stream' );
1522 my $filename = $head->recommended_filename;
1523 $filename =~ s/\.${RE_FILE_EXTENSIONS}$//i;
1524 $head->mime_attr( $_ => $filename )
1525 foreach (qw(Content-Type.name Content-Disposition.filename));
1530 sub DecryptContent {
1533 Passphrase => undef,
1537 my $gnupg = GnuPG::Interface->new();
1538 my %opt = RT->Config->Get('GnuPGOptions');
1540 # handling passphrase in GnupGOptions
1541 $args{'Passphrase'} = delete $opt{'passphrase'}
1542 if !defined($args{'Passphrase'});
1544 $opt{'digest-algo'} ||= 'SHA1';
1545 $gnupg->options->hash_init(
1546 _PrepareGnuPGOptions( %opt ),
1547 meta_interactive => 0,
1550 $args{'Passphrase'} = GetPassphrase()
1551 unless defined $args{'Passphrase'};
1553 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1554 binmode $tmp_fh, ':raw';
1556 my ($handles, $handle_list) = _make_gpg_handles(
1558 my %handle = %$handle_list;
1559 $handles->options( 'stdout' )->{'direct'} = 1;
1563 local $SIG{'CHLD'} = 'DEFAULT';
1564 $gnupg->passphrase( $args{'Passphrase'} );
1565 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1567 local $SIG{'PIPE'} = 'IGNORE';
1568 print { $handle{'stdin'} } ${ $args{'Content'} };
1569 close $handle{'stdin'};
1574 $res{'exit_code'} = $?;
1575 foreach ( qw(stderr logger status) ) {
1576 $res{$_} = do { local $/; readline $handle{$_} };
1577 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1580 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1581 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1582 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1584 # if the decryption is fine but the signature is bad, then without this
1585 # status check we lose the decrypted text
1586 # XXX: add argument to the function to control this check
1587 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1589 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1594 ${ $args{'Content'} } = '';
1597 my $status = read $tmp_fh, my $buf, 4*1024;
1598 unless ( defined $status ) {
1599 $RT::Logger->crit( "couldn't read message: $!" );
1600 } elsif ( !$status ) {
1603 ${ $args{'Content'} } .= $buf;
1609 =head2 GetPassphrase [ Address => undef ]
1611 Returns passphrase, called whenever it's required with Address as a named argument.
1616 my %args = ( Address => undef, @_ );
1622 Takes a string containing output of gnupg status stream. Parses it and returns
1623 array of hashes. Each element of array is a hash ref and represents line or
1624 group of lines in the status message.
1626 All hashes have Operation, Status and Message elements.
1632 Classification of operations gnupg performs. Now we have support
1633 for Sign, Encrypt, Decrypt, Verify, PassphraseCheck, RecipientsCheck and Data
1638 Informs about success. Value is 'DONE' on success, other values means that
1639 an operation failed, for example 'ERROR', 'BAD', 'MISSING' and may be other.
1643 User friendly message.
1647 This parser is based on information from GnuPG distribution.
1651 my %REASON_CODE_TO_TEXT = (
1653 1 => "No armored data",
1654 2 => "Expected a packet, but did not found one",
1655 3 => "Invalid packet found",
1656 4 => "Signature expected, but not found",
1659 0 => "No specific reason given",
1661 2 => "Ambigious specification",
1662 3 => "Wrong key usage",
1665 6 => "No CRL known",
1667 8 => "Policy mismatch",
1668 9 => "Not a secret key",
1669 10 => "Key not trusted",
1672 0 => 'not specified',
1673 4 => 'unknown algorithm',
1674 9 => 'missing public key',
1678 sub ReasonCodeToText {
1679 my $keyword = shift;
1681 return $REASON_CODE_TO_TEXT{ $keyword }{ $code }
1682 if exists $REASON_CODE_TO_TEXT{ $keyword }{ $code };
1686 my %simple_keyword = (
1688 Operation => 'RecipientsCheck',
1690 Message => 'No recipients',
1693 Operation => 'Data',
1695 Message => 'Unexpected data has been encountered',
1698 Operation => 'Data',
1700 Message => 'The ASCII armor is corrupted',
1705 my %parse_keyword = map { $_ => 1 } qw(
1707 SIG_CREATED GOODSIG BADSIG ERRSIG
1709 DECRYPTION_FAILED DECRYPTION_OKAY
1710 BAD_PASSPHRASE GOOD_PASSPHRASE
1712 NO_RECP INV_RECP NODATA UNEXPECTED
1715 # keywords we ignore without any messages as we parse them using other
1716 # keywords as starting point or just ignore as they are useless for us
1717 my %ignore_keyword = map { $_ => 1 } qw(
1718 NEED_PASSPHRASE MISSING_PASSPHRASE BEGIN_SIGNING PLAINTEXT PLAINTEXT_LENGTH
1719 BEGIN_ENCRYPTION SIG_ID VALIDSIG
1720 ENC_TO BEGIN_DECRYPTION END_DECRYPTION GOODMDC
1721 TRUST_UNDEFINED TRUST_NEVER TRUST_MARGINAL TRUST_FULLY TRUST_ULTIMATE
1727 return () unless $status;
1730 while ( $status =~ /\[GNUPG:\]\s*(.*?)(?=\[GNUPG:\]|\z)/igms ) {
1731 push @status, $1; $status[-1] =~ s/\s+/ /g; $status[-1] =~ s/\s+$//;
1733 $status = join "\n", @status;
1737 my (%user_hint, $latest_user_main_key);
1738 for ( my $i = 0; $i < @status; $i++ ) {
1739 my $line = $status[$i];
1740 my ($keyword, $args) = ($line =~ /^(\S+)\s*(.*)$/s);
1741 if ( $simple_keyword{ $keyword } ) {
1742 push @res, $simple_keyword{ $keyword };
1743 $res[-1]->{'Keyword'} = $keyword;
1746 unless ( $parse_keyword{ $keyword } ) {
1747 $RT::Logger->warning("Skipped $keyword") unless $ignore_keyword{ $keyword };
1751 if ( $keyword eq 'USERID_HINT' ) {
1752 my %tmp = _ParseUserHint($status, $line);
1753 $latest_user_main_key = $tmp{'MainKey'};
1754 if ( $user_hint{ $tmp{'MainKey'} } ) {
1755 while ( my ($k, $v) = each %tmp ) {
1756 $user_hint{ $tmp{'MainKey'} }->{$k} = $v;
1759 $user_hint{ $tmp{'MainKey'} } = \%tmp;
1763 elsif ( $keyword eq 'BAD_PASSPHRASE' || $keyword eq 'GOOD_PASSPHRASE' ) {
1766 Operation => 'PassphraseCheck',
1767 Status => $keyword eq 'BAD_PASSPHRASE'? 'BAD' : 'DONE',
1770 $res{'Status'} = 'MISSING' if $status[ $i - 1 ] =~ /^MISSING_PASSPHRASE/;
1771 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1772 next unless $line =~ /^NEED_PASSPHRASE\s+(\S+)\s+(\S+)\s+(\S+)/;
1773 next if $key_id && $2 ne $key_id;
1774 @res{'MainKey', 'Key', 'KeyType'} = ($1, $2, $3);
1777 $res{'Message'} = ucfirst( lc( $res{'Status'} eq 'DONE'? 'GOOD': $res{'Status'} ) ) .' passphrase';
1778 $res{'User'} = ( $user_hint{ $res{'MainKey'} } ||= {} ) if $res{'MainKey'};
1779 if ( exists $res{'User'}->{'EmailAddress'} ) {
1780 $res{'Message'} .= ' for '. $res{'User'}->{'EmailAddress'};
1782 $res{'Message'} .= " for '0x$key_id'";
1786 elsif ( $keyword eq 'END_ENCRYPTION' ) {
1788 Operation => 'Encrypt',
1790 Message => 'Data has been encrypted',
1792 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1793 next unless $line =~ /^BEGIN_ENCRYPTION\s+(\S+)\s+(\S+)/;
1794 @res{'MdcMethod', 'SymAlgo'} = ($1, $2);
1799 elsif ( $keyword eq 'DECRYPTION_FAILED' || $keyword eq 'DECRYPTION_OKAY' ) {
1800 my %res = ( Operation => 'Decrypt' );
1801 @res{'Status', 'Message'} =
1802 $keyword eq 'DECRYPTION_FAILED'
1803 ? ('ERROR', 'Decryption failed')
1804 : ('DONE', 'Decryption process succeeded');
1806 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1807 next unless $line =~ /^ENC_TO\s+(\S+)\s+(\S+)\s+(\S+)/;
1808 my ($key, $alg, $key_length) = ($1, $2, $3);
1810 my %encrypted_to = (
1811 Message => "The message is encrypted to '0x$key'",
1812 User => ( $user_hint{ $key } ||= {} ),
1814 KeyLength => $key_length,
1818 push @{ $res{'EncryptedTo'} ||= [] }, \%encrypted_to;
1823 elsif ( $keyword eq 'NO_SECKEY' || $keyword eq 'NO_PUBKEY' ) {
1824 my ($key) = split /\s+/, $args;
1825 my $type = $keyword eq 'NO_SECKEY'? 'secret': 'public';
1827 Operation => 'KeyCheck',
1828 Status => 'MISSING',
1829 Message => ucfirst( $type ) ." key '0x$key' is not available",
1833 $res{'User'} = ( $user_hint{ $key } ||= {} );
1834 $res{'User'}{ ucfirst( $type ). 'KeyMissing' } = 1;
1837 # GOODSIG, BADSIG, VALIDSIG, TRUST_*
1838 elsif ( $keyword eq 'GOODSIG' ) {
1840 Operation => 'Verify',
1842 Message => 'The signature is good',
1844 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1845 $res{'Message'} .= ', signed by '. $res{'UserString'};
1847 foreach my $line ( @status[ $i .. $#status ] ) {
1848 next unless $line =~ /^TRUST_(\S+)/;
1852 $res{'Message'} .= ', trust level is '. lc( $res{'Trust'} || 'unknown');
1854 foreach my $line ( @status[ $i .. $#status ] ) {
1855 next unless $line =~ /^VALIDSIG\s+(.*)/;
1868 ) } = split /\s+/, $1, 10;
1873 elsif ( $keyword eq 'BADSIG' ) {
1875 Operation => 'Verify',
1877 Message => 'The signature has not been verified okay',
1879 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1882 elsif ( $keyword eq 'ERRSIG' ) {
1884 Operation => 'Verify',
1886 Message => 'Not possible to check the signature',
1888 @res{qw(Key PubkeyAlgo HashAlgo Class Timestamp ReasonCode Other)}
1889 = split /\s+/, $args, 7;
1891 $res{'Reason'} = ReasonCodeToText( $keyword, $res{'ReasonCode'} );
1892 $res{'Message'} .= ", the reason is ". $res{'Reason'};
1896 elsif ( $keyword eq 'SIG_CREATED' ) {
1897 # SIG_CREATED <type> <pubkey algo> <hash algo> <class> <timestamp> <key fpr>
1898 my @props = split /\s+/, $args;
1900 Operation => 'Sign',
1902 Message => "Signed message",
1904 PubKeyAlgo => $props[1],
1905 HashKeyAlgo => $props[2],
1907 Timestamp => $props[4],
1908 KeyFingerprint => $props[5],
1909 User => $user_hint{ $latest_user_main_key },
1911 $res[-1]->{Message} .= ' by '. $user_hint{ $latest_user_main_key }->{'EmailAddress'}
1912 if $user_hint{ $latest_user_main_key };
1914 elsif ( $keyword eq 'INV_RECP' ) {
1915 my ($rcode, $recipient) = split /\s+/, $args, 2;
1916 my $reason = ReasonCodeToText( $keyword, $rcode );
1918 Operation => 'RecipientsCheck',
1920 Message => "Recipient '$recipient' is unusable, the reason is '$reason'",
1921 Recipient => $recipient,
1922 ReasonCode => $rcode,
1926 elsif ( $keyword eq 'NODATA' ) {
1927 my $rcode = (split /\s+/, $args)[0];
1928 my $reason = ReasonCodeToText( $keyword, $rcode );
1930 Operation => 'Data',
1932 Message => "No data has been found. The reason is '$reason'",
1933 ReasonCode => $rcode,
1938 $RT::Logger->warning("Keyword $keyword is unknown");
1941 $res[-1]{'Keyword'} = $keyword if @res && !$res[-1]{'Keyword'};
1946 sub _ParseUserHint {
1947 my ($status, $hint) = (@_);
1948 my ($main_key_id, $user_str) = ($hint =~ /^USERID_HINT\s+(\S+)\s+(.*)$/);
1949 return () unless $main_key_id;
1951 MainKey => $main_key_id,
1952 String => $user_str,
1953 EmailAddress => (map $_->address, Email::Address->parse( $user_str ))[0],
1957 sub _PrepareGnuPGOptions {
1959 my %res = map { lc $_ => $opt{ $_ } } grep $supported_opt{ lc $_ }, keys %opt;
1960 $res{'extra_args'} ||= [];
1961 foreach my $o ( grep !$supported_opt{ lc $_ }, keys %opt ) {
1962 push @{ $res{'extra_args'} }, '--'. lc $o;
1963 push @{ $res{'extra_args'} }, $opt{ $o }
1964 if defined $opt{ $o };
1971 # one arg -> return preferred key
1973 sub UseKeyForEncryption {
1976 } elsif ( @_ > 1 ) {
1978 $key{ lc($_) } = delete $key{ $_ } foreach grep lc ne $_, keys %key;
1980 return $key{ $_[0] };
1985 =head2 UseKeyForSigning
1987 Returns or sets identifier of the key that should be used for signing.
1989 Returns the current value when called without arguments.
1991 Sets new value when called with one argument and unsets if it's undef.
1996 sub UseKeyForSigning {
2003 =head2 GetKeysForEncryption
2005 Takes identifier and returns keys suitable for encryption.
2007 B<Note> that keys for which trust level is not set are
2012 sub GetKeysForEncryption {
2014 my %res = GetKeysInfo( $key_id, 'public', @_ );
2015 return %res if $res{'exit_code'};
2016 return %res unless $res{'info'};
2018 foreach my $key ( splice @{ $res{'info'} } ) {
2019 # skip disabled keys
2020 next if $key->{'Capabilities'} =~ /D/;
2021 # skip keys not suitable for encryption
2022 next unless $key->{'Capabilities'} =~ /e/i;
2023 # skip disabled, expired, revoke and keys with no trust,
2024 # but leave keys with unknown trust level
2025 next if $key->{'TrustLevel'} < 0;
2027 push @{ $res{'info'} }, $key;
2029 delete $res{'info'} unless @{ $res{'info'} };
2033 sub GetKeysForSigning {
2035 return GetKeysInfo( $key_id, 'private', @_ );
2038 sub CheckRecipients {
2039 my @recipients = (@_);
2041 my ($status, @issues) = (1, ());
2044 foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) {
2045 my %res = GetKeysForEncryption( $address );
2046 if ( $res{'info'} && @{ $res{'info'} } == 1 && $res{'info'}[0]{'TrustLevel'} > 0 ) {
2047 # good, one suitable and trusted key
2050 my $user = RT::User->new( RT->SystemUser );
2051 $user->LoadByEmail( $address );
2052 # it's possible that we have no User record with the email
2053 $user = undef unless $user->id;
2055 if ( my $fpr = UseKeyForEncryption( $address ) ) {
2056 if ( $res{'info'} && @{ $res{'info'} } ) {
2058 grep lc $_->{'Fingerprint'} eq lc $fpr,
2059 grep $_->{'TrustLevel'} > 0,
2065 EmailAddress => $address,
2066 $user? (User => $user) : (),
2069 $issue{'Message'} = "Selected key either is not trusted or doesn't exist anymore."; #loc
2070 push @issues, \%issue;
2075 $prefered_key = $user->PreferredKey if $user;
2076 #XXX: prefered key is not yet implemented...
2081 EmailAddress => $address,
2082 $user? (User => $user) : (),
2086 unless ( $res{'info'} && @{ $res{'info'} } ) {
2088 $issue{'Message'} = "There is no key suitable for encryption."; #loc
2090 elsif ( @{ $res{'info'} } == 1 && !$res{'info'}[0]{'TrustLevel'} ) {
2092 $issue{'Message'} = "There is one suitable key, but trust level is not set."; #loc
2096 $issue{'Message'} = "There are several keys suitable for encryption."; #loc
2098 push @issues, \%issue;
2100 return ($status, @issues);
2103 sub GetPublicKeyInfo {
2104 return GetKeyInfo( shift, 'public', @_ );
2107 sub GetPrivateKeyInfo {
2108 return GetKeyInfo( shift, 'private', @_ );
2112 my %res = GetKeysInfo(@_);
2113 $res{'info'} = $res{'info'}->[0];
2119 my $type = shift || 'public';
2123 return (exit_code => 0) unless $force;
2126 my $gnupg = GnuPG::Interface->new();
2127 my %opt = RT->Config->Get('GnuPGOptions');
2128 $opt{'digest-algo'} ||= 'SHA1';
2129 $opt{'with-colons'} = undef; # parseable format
2130 $opt{'fingerprint'} = undef; # show fingerprint
2131 $opt{'fixed-list-mode'} = undef; # don't merge uid with keys
2132 $gnupg->options->hash_init(
2133 _PrepareGnuPGOptions( %opt ),
2135 meta_interactive => 0,
2140 my ($handles, $handle_list) = _make_gpg_handles();
2141 my %handle = %$handle_list;
2144 local $SIG{'CHLD'} = 'DEFAULT';
2145 my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
2146 my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email
2147 ? (command_args => [ "--", $email])
2149 close $handle{'stdin'};
2153 my @info = readline $handle{'stdout'};
2154 close $handle{'stdout'};
2156 $res{'exit_code'} = $?;
2157 foreach ( qw(stderr logger status) ) {
2158 $res{$_} = do { local $/; readline $handle{$_} };
2159 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2162 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2163 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2164 if ( $res{'logger'} && $? ) {
2165 $RT::Logger->error( $res{'logger'} );
2166 $RT::Logger->error( 'The above error may result from an unconfigured RT/GPG installation. See perldoc etc/RT_Config.pm for information about configuring or disabling GPG support for RT' );
2169 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
2173 @info = ParseKeysInfo( @info );
2174 $res{'info'} = \@info;
2181 my %gpg_opt = RT->Config->Get('GnuPGOptions');
2184 foreach my $line( @lines ) {
2187 ($tag, $line) = split /:/, $line, 2;
2188 if ( $tag eq 'pub' ) {
2191 TrustChar KeyLength Algorithm Key
2192 Created Expire Empty OwnerTrustChar
2193 Empty Empty Capabilities Other
2194 ) } = split /:/, $line, 12;
2196 # workaround gnupg's wierd behaviour, --list-keys command report calculated trust levels
2197 # for any model except 'always', so you can change models and see changes, but not for 'always'
2198 # we try to handle it in a simple way - we set ultimate trust for any key with trust
2199 # level >= 0 if trust model is 'always'
2201 $always_trust = 1 if exists $gpg_opt{'always-trust'};
2202 $always_trust = 1 if exists $gpg_opt{'trust-model'} && $gpg_opt{'trust-model'} eq 'always';
2203 @info{qw(Trust TrustTerse TrustLevel)} =
2204 _ConvertTrustChar( $info{'TrustChar'} );
2205 if ( $always_trust && $info{'TrustLevel'} >= 0 ) {
2206 @info{qw(Trust TrustTerse TrustLevel)} =
2207 _ConvertTrustChar( 'u' );
2210 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
2211 _ConvertTrustChar( $info{'OwnerTrustChar'} );
2212 $info{ $_ } = _ParseDate( $info{ $_ } )
2213 foreach qw(Created Expire);
2216 elsif ( $tag eq 'sec' ) {
2219 Empty KeyLength Algorithm Key
2220 Created Expire Empty OwnerTrustChar
2221 Empty Empty Capabilities Other
2222 ) } = split /:/, $line, 12;
2223 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
2224 _ConvertTrustChar( $info{'OwnerTrustChar'} );
2225 $info{ $_ } = _ParseDate( $info{ $_ } )
2226 foreach qw(Created Expire);
2229 elsif ( $tag eq 'uid' ) {
2231 @info{ qw(Trust Created Expire String) }
2232 = (split /:/, $line)[0,4,5,8];
2233 $info{ $_ } = _ParseDate( $info{ $_ } )
2234 foreach qw(Created Expire);
2235 push @{ $res[-1]{'User'} ||= [] }, \%info;
2237 elsif ( $tag eq 'fpr' ) {
2238 $res[-1]{'Fingerprint'} = (split /:/, $line, 10)[8];
2248 "The key has been disabled", #loc
2249 "key disabled", #loc
2254 "The key has been revoked", #loc
2259 e => [ "The key has expired", #loc
2264 n => [ "Don't trust this key at all", #loc
2269 #gpupg docs says that '-' and 'q' may safely be treated as the same value
2271 'Unknown (no trust value assigned)', #loc
2276 'Unknown (no trust value assigned)', #loc
2281 'Unknown (this value is new to the system)', #loc
2287 "There is marginal trust in this key", #loc
2292 "The key is fully trusted", #loc
2297 "The key is ultimately trusted", #loc
2303 sub _ConvertTrustChar {
2305 return @{ $verbose{'-'} } unless $value;
2306 $value = substr $value, 0, 1;
2307 return @{ $verbose{ $value } || $verbose{'o'} };
2314 return $value unless $value;
2317 my $obj = RT::Date->new( RT->SystemUser );
2319 if ( $value =~ /^\d+$/ ) {
2320 $obj->Set( Value => $value );
2322 $obj->Set( Format => 'unknown', Value => $value, Timezone => 'utc' );
2330 my $gnupg = GnuPG::Interface->new();
2331 my %opt = RT->Config->Get('GnuPGOptions');
2332 $gnupg->options->hash_init(
2333 _PrepareGnuPGOptions( %opt ),
2334 meta_interactive => 0,
2337 my ($handles, $handle_list) = _make_gpg_handles();
2338 my %handle = %$handle_list;
2341 local $SIG{'CHLD'} = 'DEFAULT';
2342 my $pid = safe_run_child { $gnupg->wrap_call(
2343 handles => $handles,
2344 commands => ['--delete-secret-and-public-key'],
2345 command_args => ["--", $key],
2347 close $handle{'stdin'};
2348 while ( my $str = readline $handle{'status'} ) {
2349 if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) {
2350 print { $handle{'command'} } "y\n";
2356 close $handle{'stdout'};
2359 $res{'exit_code'} = $?;
2360 foreach ( qw(stderr logger status) ) {
2361 $res{$_} = do { local $/; readline $handle{$_} };
2362 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2365 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2366 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2367 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2368 if ( $err || $res{'exit_code'} ) {
2369 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
2377 my $gnupg = GnuPG::Interface->new();
2378 my %opt = RT->Config->Get('GnuPGOptions');
2379 $gnupg->options->hash_init(
2380 _PrepareGnuPGOptions( %opt ),
2381 meta_interactive => 0,
2384 my ($handles, $handle_list) = _make_gpg_handles();
2385 my %handle = %$handle_list;
2388 local $SIG{'CHLD'} = 'DEFAULT';
2389 my $pid = safe_run_child { $gnupg->wrap_call(
2390 handles => $handles,
2391 commands => ['--import'],
2393 print { $handle{'stdin'} } $key;
2394 close $handle{'stdin'};
2398 close $handle{'stdout'};
2401 $res{'exit_code'} = $?;
2402 foreach ( qw(stderr logger status) ) {
2403 $res{$_} = do { local $/; readline $handle{$_} };
2404 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2407 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2408 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2409 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2410 if ( $err || $res{'exit_code'} ) {
2411 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
2418 Signs a small message with the key, to make sure the key exists and
2419 we have a useable passphrase. The first argument MUST be a key identifier
2420 of the signer: either email address, key id or finger print.
2422 Returns a true value if all went well.
2429 my $mime = MIME::Entity->build(
2430 Type => "text/plain",
2431 From => 'nobody@localhost',
2432 To => 'nobody@localhost',
2433 Subject => "dry sign",
2437 my %res = SignEncrypt(
2444 return $res{exit_code} == 0;
2451 This routine returns true if RT's GnuPG support is configured and working
2452 properly (and false otherwise).
2459 my $gnupg = GnuPG::Interface->new();
2460 my %opt = RT->Config->Get('GnuPGOptions');
2461 $gnupg->options->hash_init(
2462 _PrepareGnuPGOptions( %opt ),
2464 meta_interactive => 0,
2467 my ($handles, $handle_list) = _make_gpg_handles();
2468 my %handle = %$handle_list;
2472 local $SIG{'CHLD'} = 'DEFAULT';
2473 my $pid = safe_run_child { $gnupg->wrap_call( commands => ['--version' ], handles => $handles ) };
2474 close $handle{'stdin'};
2479 "Probe for GPG failed."
2480 ." Couldn't run `gpg --version`: ". $@
2485 # on some systems gpg exits with code 2, but still 100% functional,
2486 # it's general error system error or incorrect command, command is correct,
2487 # but there is no way to get actuall error
2488 if ( $? && ($? >> 8) != 2 ) {
2489 my $msg = "Probe for GPG failed."
2490 ." Process exitted with code ". ($? >> 8)
2491 . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '')
2493 foreach ( qw(stderr logger status) ) {
2494 my $tmp = do { local $/; readline $handle{$_} };
2495 next unless $tmp && $tmp =~ /\S/s;
2497 $msg .= "\n$_:\n$tmp\n";
2499 $RT::Logger->debug( $msg );
2506 sub _make_gpg_handles {
2507 my %handle_map = (@_);
2508 $handle_map{$_} = IO::Handle->new
2509 foreach grep !defined $handle_map{$_},
2510 qw(stdin stdout stderr logger status command);
2512 my $handles = GnuPG::Handles->new(%handle_map);
2513 return ($handles, \%handle_map);
2516 RT::Base->_ImportOverlays();
2518 # helper package to avoid using temp file
2519 package IO::Handle::CRLF;
2521 use base qw(IO::Handle);
2524 my ($self, @args) = (@_);
2525 s/\r*\n/\x0D\x0A/g foreach @args;
2526 return $self->SUPER::print( @args );