1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2016 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 }}}
53 package RT::Crypt::GnuPG;
55 use Role::Basic 'with';
56 with 'RT::Crypt::Role';
60 use RT::Crypt::GnuPG::CRLFHandle;
62 use RT::EmailParser ();
63 use RT::Util 'safe_run_child', 'mime_recommended_filename';
67 RT::Crypt::GnuPG - GNU Privacy Guard encryption/decryption/verification/signing
71 This module provides support for encryption and signing of outgoing
72 messages using GnuPG, as well as the decryption and verification of
77 There are two reveant configuration options, both of which are hashes:
78 C<GnuPG> and C<GnuPGOptions>. The first one controls RT specific
79 options; it enables you to enable/disable the GPG protocol or change the
80 format of messages. The second one is a hash with options which are
81 passed to the C<gnupg> utility. You can use it to define a keyserver,
82 enable auto-retrieval of keys, or set almost any option which C<gnupg>
83 supports on your system.
89 Set to true value to enable this subsystem:
96 However, note that you B<must> add the 'Auth::Crypt' email filter to enable
97 the handling of incoming encrypted/signed messages.
99 =head3 Format of outgoing messages
101 The format of outgoing messages can be controlled using the
102 C<OutgoingMessagesFormat> option in the RT config:
105 ... other options ...
106 OutgoingMessagesFormat => 'RFC',
107 ... other options ...
113 ... other options ...
114 OutgoingMessagesFormat => 'Inline',
115 ... other options ...
118 The two formats for GPG mail are as follows:
124 This format, the default, is also known as GPG/MIME, and is described in
125 RFC3156 and RFC1847. The technique described in these RFCs is well
126 supported by many mail user agents (MUA); however, some older MUAs only
127 support inline signatures and encryption.
131 This format doesn't take advantage of MIME, but some mail clients do not
132 support GPG/MIME. In general, this format is discouraged because modern
133 mail clients typically do not support it well.
135 Text parts are signed using clear-text signatures. For each attachment,
136 the signature is attached separately as a file with a '.sig' extension
137 added to the filename. Encryption of text parts is implemented using
138 inline format, while other parts are replaced with attachments with the
139 filename extension '.pgp'.
145 Passphrases for keys may be set by passing C<Passphrase>. It may be set
146 to a scalar (to use for all keys), an anonymous function, or a hash (to
147 look up by address). If the hash is used, the '' key is used as a
152 Use this hash to set additional options of the 'gnupg' program. The
153 only options which are diallowed are options which alter the output
154 format or attempt to run commands; thiss includes C<--sign>,
155 C<--list-options>, etc.
157 Some GnuPG options take arguments, while others take none. (Such as
158 C<--use-agent>). For options without specific value use C<undef> as
159 hash value. To disable these options, you may comment them out or
160 delete them from the hash:
163 'option-with-value' => 'value',
164 'enabled-option-without-value' => undef,
165 # 'commented-option' => 'value or undef',
168 B<NOTE> that options may contain the '-' character and such options
169 B<MUST> be quoted, otherwise you will see the quite cryptic error C<gpg:
170 Invalid option "--0">.
172 Common options include:
178 The GnuPG home directory where the keyrings are stored; by default it is
179 set to F</opt/rt4/var/data/gpg>.
181 You can manage this data with the 'gpg' commandline utility using the
182 GNUPGHOME environment variable or C<--homedir> option. Other utilities may
185 In a standard installation, access to this directory should be granted
186 to the web server user which is running RT's web interface; however, if
187 you are running cronjobs or other utilities that access RT directly via
188 API, and may generate encrypted/signed notifications, then the users you
189 execute these scripts under must have access too.
191 Be aware that granting access to the directory to many users makes the
192 keys less secure -- and some features, such as auto-import of keys, may
193 not be available if directory permissions are too permissive. To enable
194 these features and suppress warnings about permissions on the directory,
195 add the C<--no-permission-warning> option to C<GnuPGOptions>.
199 This option is required when the C<RFC> format for outgoing messages is
200 used. RT defaults to 'SHA1' by default, but you may wish to override
201 it. C<gnupng --version> will list the algorithms supported by your
202 C<gnupg> installation under 'hash functions'; these generally include
203 MD5, SHA1, RIPEMD160, and SHA256.
207 This option lets you use GPG Agent to cache the passphrase of secret
209 L<http://www.gnupg.org/documentation/manuals/gnupg/Invoking-GPG_002dAGENT.html>
210 for information about GPG Agent.
214 This option lets you set the passphrase of RT's key directly. This
215 option is special in that it is not passed directly to GPG; rather, it
216 is put into a file that GPG then reads (which is more secure). The
217 downside is that anyone who has read access to your RT_SiteConfig.pm
218 file can see the passphrase -- thus we recommend the --use-agent option
223 Read C<man gpg> to get list of all options this program supports.
227 =head2 Per-queue options
229 Using the web interface it's possible to enable signing and/or encrypting by
230 default. As an administrative user of RT, open 'Admin' then 'Queues',
231 and select a queue. On the page you can see information about the queue's keys
232 at the bottom and two checkboxes to choose default actions.
234 As well, encryption is enabled for autoreplies and other notifications when
235 an encypted message enters system via mailgate interface even if queue's
238 =head2 Handling incoming messages
240 To enable handling of encrypted and signed message in the RT you should add
241 'Auth::Crypt' mail plugin.
243 Set(@MailPlugins, 'Auth::MailFrom', 'Auth::Crypt', ...other filter...);
245 See also `perldoc lib/RT/Interface/Email/Auth/Crypt.pm`.
247 =head2 Encrypting to untrusted keys
249 Due to limitations of GnuPG, it's impossible to encrypt to an untrusted key,
250 unless 'always trust' mode is enabled.
252 =head1 FOR DEVELOPERS
254 =head2 Documentation and references
260 Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted.
261 Describes generic MIME security framework, "mulitpart/signed" and
262 "multipart/encrypted" MIME types.
267 MIME Security with Pretty Good Privacy (PGP), updates RFC2015.
273 # gnupg options supported by GnuPG::Interface
274 # other otions should be handled via extra_args argument
275 my %supported_opt = map { $_ => 1 } qw(
301 our $RE_FILE_EXTENSIONS = qr/pgp|asc/i;
303 # DEV WARNING: always pass all STD* handles to GnuPG interface even if we don't
304 # need them, just pass 'IO::Handle->new()' and then close it after safe_run_child.
305 # we don't want to leak anything into FCGI/Apache/MP handles, this break things.
306 # So code should look like:
307 # my $handles = GnuPG::Handles->new(
308 # stdin => ($handle{'stdin'} = IO::Handle->new()),
309 # stdout => ($handle{'stdout'} = IO::Handle->new()),
310 # stderr => ($handle{'stderr'} = IO::Handle->new()),
332 my %handle = %{$args{Handles}};
333 my ($handles, $handle_list) = _make_gpg_handles( %handle );
334 $handles->options( $_ )->{'direct'} = 1
335 for @{$args{Direct} || [keys %handle] };
336 %handle = %$handle_list;
338 my $content = $args{Content};
339 my $command = $args{Command};
341 my %GnuPGOptions = RT->Config->Get('GnuPGOptions');
343 'digest-algo' => 'SHA1',
345 %{ $args{Options} || {} },
347 my $gnupg = GnuPG::Interface->new;
348 $gnupg->call( $self->GnuPGPath );
349 $gnupg->options->hash_init(
350 _PrepareGnuPGOptions( %opt ),
352 $gnupg->options->armor( 1 );
353 $gnupg->options->meta_interactive( 0 );
354 $gnupg->options->default_key( $args{Signer} )
355 if defined $args{Signer};
358 $gnupg->options->push_recipients( $_ ) for
359 map { RT::Crypt->UseKeyForEncryption($_) || $_ }
360 grep { !$seen{ $_ }++ }
361 @{ $args{Recipients} || [] };
363 $args{Passphrase} = $GnuPGOptions{passphrase}
364 unless defined $args{'Passphrase'};
365 $args{Passphrase} = $self->GetPassphrase( Address => $args{Signer} )
366 unless defined $args{'Passphrase'};
367 $gnupg->passphrase( $args{'Passphrase'} )
368 if defined $args{Passphrase};
371 local $SIG{'CHLD'} = 'DEFAULT';
372 my $pid = safe_run_child {
373 if ($command =~ /^--/) {
376 commands => [$command],
377 command_args => $args{CommandArgs},
382 command_args => $args{CommandArgs},
387 local $SIG{'PIPE'} = 'IGNORE';
388 if (Scalar::Util::blessed($content) and $content->can("print")) {
389 $content->print( $handle{'stdin'} );
390 } elsif (ref($content) eq "SCALAR") {
391 $handle{'stdin'}->print( ${ $content } );
392 } elsif (defined $content) {
393 $handle{'stdin'}->print( $content );
395 close $handle{'stdin'} or die "Can't close gnupg input handle: $!";
396 $args{Callback}->(%handle) if $args{Callback};
402 push @{$args{Output}}, readline $handle{stdout};
403 if (not close $handle{stdout}) {
404 $err ||= "Can't close gnupg output handle: $!";
409 $res{'exit_code'} = $?;
411 foreach ( qw(stderr logger status) ) {
412 $res{$_} = do { local $/ = undef; readline $handle{$_} };
413 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
414 if (not close $handle{$_}) {
415 $err ||= "Can't close gnupg $_ handle: $!";
418 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
419 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
420 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
421 if ( $err || $res{'exit_code'} ) {
422 $res{'message'} = $err? $err : "gpg exited with error code ". ($res{'exit_code'} >> 8);
431 my $format = lc RT->Config->Get('GnuPG')->{'OutgoingMessagesFormat'} || 'RFC';
432 if ( $format eq 'inline' ) {
433 return $self->SignEncryptInline( @_ );
435 return $self->SignEncryptRFC3156( @_ );
439 sub SignEncryptRFC3156 {
454 my $entity = $args{'Entity'};
456 if ( $args{'Sign'} && !$args{'Encrypt'} ) {
457 # required by RFC3156(Ch. 5) and RFC1847(Ch. 2.1)
458 foreach ( grep !$_->is_multipart, $entity->parts_DFS ) {
459 my $tenc = $_->head->mime_encoding;
460 unless ( $tenc =~ m/^(?:7bit|quoted-printable|base64)$/i ) {
461 $_->head->mime_attr( 'Content-Transfer-Encoding'
462 => $_->effective_type =~ m{^text/}? 'quoted-printable': 'base64'
466 $entity->make_multipart( 'mixed', Force => 1 );
469 # We use RT::Crypt::GnuPG::CRLFHandle to canonicalize the
470 # MIME::Entity output to use \r\n instead of \n for its newlines
471 %res = $self->CallGnuPG(
472 Signer => $args{'Signer'},
473 Command => "detach_sign",
474 Handles => { stdin => RT::Crypt::GnuPG::CRLFHandle->new },
476 Passphrase => $args{'Passphrase'},
477 Content => $entity->parts(0),
478 Output => \@signature,
480 return %res if $res{message};
482 # setup RFC1847(Ch.2.1) requirements
483 my $protocol = 'application/pgp-signature';
484 my $algo = RT->Config->Get('GnuPGOptions')->{'digest-algo'} || 'SHA1';
485 $entity->head->mime_attr( 'Content-Type' => 'multipart/signed' );
486 $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
487 $entity->head->mime_attr( 'Content-Type.micalg' => 'pgp-'. lc $algo );
490 Disposition => 'inline',
495 if ( $args{'Encrypt'} ) {
496 my @recipients = map $_->address,
497 map Email::Address->parse( Encode::decode( "UTF-8", $_ ) ),
498 map $entity->head->get( $_ ),
501 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
502 binmode $tmp_fh, ':raw';
504 $entity->make_multipart( 'mixed', Force => 1 );
505 %res = $self->CallGnuPG(
506 Signer => $args{'Signer'},
507 Recipients => \@recipients,
508 Command => ( $args{'Sign'} ? "sign_and_encrypt" : "encrypt" ),
509 Handles => { stdout => $tmp_fh },
510 Passphrase => $args{'Passphrase'},
511 Content => $entity->parts(0),
513 return %res if $res{message};
515 my $protocol = 'application/pgp-encrypted';
517 $entity->head->mime_attr( 'Content-Type' => 'multipart/encrypted' );
518 $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
521 Disposition => 'inline',
522 Data => ['Version: 1',''],
526 Type => 'application/octet-stream',
527 Disposition => 'inline',
532 $entity->parts(-1)->bodyhandle->{'_dirty_hack_to_save_a_ref_tmp_fh'} = $tmp_fh;
537 sub SignEncryptInline {
541 my $entity = $args{'Entity'};
544 $entity->make_singlepart;
545 if ( $entity->is_multipart ) {
546 foreach ( $entity->parts ) {
547 %res = $self->SignEncryptInline( @_, Entity => $_ );
548 return %res if $res{'exit_code'};
553 return $self->_SignEncryptTextInline( @_ )
554 if $entity->effective_type =~ /^text\//i;
556 return $self->_SignEncryptAttachmentInline( @_ );
559 sub _SignEncryptTextInline {
573 return unless $args{'Sign'} || $args{'Encrypt'};
575 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
576 binmode $tmp_fh, ':raw';
578 my $entity = $args{'Entity'};
579 my %res = $self->CallGnuPG(
580 Signer => $args{'Signer'},
581 Recipients => $args{'Recipients'},
582 Command => ( $args{'Sign'} && $args{'Encrypt'}
587 Handles => { stdout => $tmp_fh },
588 Passphrase => $args{'Passphrase'},
589 Content => $entity->bodyhandle,
591 return %res if $res{message};
593 $entity->bodyhandle( MIME::Body::File->new( $tmp_fn) );
594 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
599 sub _SignEncryptAttachmentInline {
613 return unless $args{'Sign'} || $args{'Encrypt'};
616 my $entity = $args{'Entity'};
618 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
619 binmode $tmp_fh, ':raw';
621 my %res = $self->CallGnuPG(
622 Signer => $args{'Signer'},
623 Recipients => $args{'Recipients'},
624 Command => ( $args{'Sign'} && $args{'Encrypt'}
629 Handles => { stdout => $tmp_fh },
630 Passphrase => $args{'Passphrase'},
631 Content => $entity->bodyhandle,
633 return %res if $res{message};
635 my $filename = mime_recommended_filename( $entity ) || 'no_name';
636 if ( $args{'Sign'} && !$args{'Encrypt'} ) {
637 $entity->make_multipart;
639 Type => 'application/octet-stream',
641 Filename => "$filename.sig",
642 Disposition => 'attachment',
645 $entity->bodyhandle(MIME::Body::File->new( $tmp_fn) );
646 $entity->effective_type('application/octet-stream');
647 $entity->head->mime_attr( $_ => "$filename.pgp" )
648 foreach (qw(Content-Type.name Content-Disposition.filename));
651 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
656 sub SignEncryptContent {
670 return unless $args{'Sign'} || $args{'Encrypt'};
672 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
673 binmode $tmp_fh, ':raw';
675 my %res = $self->CallGnuPG(
676 Signer => $args{'Signer'},
677 Recipients => $args{'Recipients'},
678 Command => ( $args{'Sign'} && $args{'Encrypt'}
683 Handles => { stdout => $tmp_fh },
684 Passphrase => $args{'Passphrase'},
685 Content => $args{'Content'},
687 return %res if $res{message};
689 ${ $args{'Content'} } = '';
692 my $status = read $tmp_fh, my $buf, 4*1024;
693 unless ( defined $status ) {
694 $RT::Logger->crit( "couldn't read message: $!" );
695 } elsif ( !$status ) {
698 ${ $args{'Content'} } .= $buf;
704 sub CheckIfProtected {
706 my %args = ( Entity => undef, @_ );
708 my $entity = $args{'Entity'};
710 # we check inline PGP block later in another sub
711 return () unless $entity->is_multipart;
713 # RFC3156, multipart/{signed,encrypted}
714 my $type = $entity->effective_type;
715 return () unless $type =~ /^multipart\/(?:encrypted|signed)$/;
717 unless ( $entity->parts == 2 ) {
718 $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
722 my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
723 unless ( $protocol ) {
724 # if protocol is not set then we can check second part for PGP message
725 $RT::Logger->error( "Entity is '$type', but has no protocol defined. Checking for PGP part" );
726 my $protected = $self->_CheckIfProtectedInline( $entity->parts(1), 1 );
727 return () unless $protected;
729 if ( $protected eq 'signature' ) {
730 $RT::Logger->debug("Found part signed according to RFC3156");
735 Data => $entity->parts(0),
736 Signature => $entity->parts(1),
739 $RT::Logger->debug("Found part encrypted according to RFC3156");
744 Data => $entity->parts(1),
745 Info => $entity->parts(0),
749 elsif ( $type eq 'multipart/encrypted' ) {
750 unless ( $protocol eq 'application/pgp-encrypted' ) {
751 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" );
754 $RT::Logger->debug("Found part encrypted according to RFC3156");
759 Data => $entity->parts(1),
760 Info => $entity->parts(0),
763 unless ( $protocol eq 'application/pgp-signature' ) {
764 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
767 $RT::Logger->debug("Found part signed according to RFC3156");
772 Data => $entity->parts(0),
773 Signature => $entity->parts(1),
780 sub FindScatteredParts {
782 my %args = ( Parts => [], Skip => {}, @_ );
786 my @parts = @{ $args{'Parts'} };
788 # attachments signed with signature in another part
791 for (my $i = 0; $i < @parts; $i++ ) {
792 my $part = $parts[ $i ];
794 # we can not associate a signature within an attachment
796 my $fname = $part->head->recommended_filename;
799 my $type = $part->effective_type;
801 if ( $type eq 'application/pgp-signature' ) {
802 push @file_indices, $i;
804 elsif ( $type eq 'application/octet-stream' && $fname =~ /\.sig$/i ) {
805 push @file_indices, $i;
809 foreach my $i ( @file_indices ) {
810 my $sig_part = $parts[ $i ];
811 my $sig_name = $sig_part->head->recommended_filename;
812 my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/;
814 my ($data_part_idx) =
815 grep $file_name eq ($parts[$_]->head->recommended_filename||''),
816 grep $sig_part ne $parts[$_],
818 unless ( defined $data_part_idx ) {
819 $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
823 my $data_part_in = $parts[ $data_part_idx ];
825 $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
827 $args{'Skip'}{$data_part_in} = 1;
828 $args{'Skip'}{$sig_part} = 1;
831 Format => 'Attachment',
832 Top => $args{'Parents'}{$sig_part},
833 Data => $data_part_in,
834 Signature => $sig_part,
839 # attachments with inline encryption
840 foreach my $part ( @parts ) {
841 next if $args{'Skip'}{$part};
843 my $fname = $part->head->recommended_filename || '';
844 next unless $fname =~ /\.${RE_FILE_EXTENSIONS}$/;
846 $RT::Logger->debug("Found encrypted attachment '$fname'");
848 $args{'Skip'}{$part} = 1;
851 Format => 'Attachment',
857 foreach my $part ( @parts ) {
858 next if $args{'Skip'}{$part};
860 my $type = $self->_CheckIfProtectedInline( $part );
863 my $file = ($part->head->recommended_filename||'') =~ /\.${RE_FILE_EXTENSIONS}$/;
865 $args{'Skip'}{$part} = 1;
868 Format => !$file || $type eq 'signed'? 'Inline' : 'Attachment',
876 sub _CheckIfProtectedInline {
879 my $check_for_signature = shift || 0;
881 my $io = $entity->open('r');
883 $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
887 # Deal with "partitioned" PGP mail, which (contrary to common
888 # sense) unnecessarily applies a base64 transfer encoding to PGP
889 # mail (whose content is already base64-encoded).
890 if ( $entity->bodyhandle->is_encoded and $entity->head->mime_encoding ) {
891 my $decoder = MIME::Decoder->new( $entity->head->mime_encoding );
896 open my $fh, '>', \$buf
897 or die "Couldn't open scalar for writing: $!";
899 $decoder->decode($io, $fh);
900 close $fh or die "Couldn't close scalar: $!";
903 or die "Couldn't re-open scalar for reading: $!";
908 $RT::Logger->error("Couldn't decode body: $@");
913 while ( defined($_ = $io->getline) ) {
914 if ( /^-----BEGIN PGP (SIGNED )?MESSAGE-----\s*$/ ) {
915 return $1? 'signed': 'encrypted';
917 elsif ( $check_for_signature && !/^-----BEGIN PGP SIGNATURE-----\s*$/ ) {
934 my $item = $args{'Info'};
936 if ( $item->{'Type'} eq 'signed' ) {
937 if ( $item->{'Format'} eq 'RFC3156' ) {
938 %res = $self->VerifyRFC3156( %$item );
939 $status_on = $item->{'Top'};
940 } elsif ( $item->{'Format'} eq 'Inline' ) {
941 %res = $self->VerifyInline( %$item );
942 $status_on = $item->{'Data'};
943 } elsif ( $item->{'Format'} eq 'Attachment' ) {
944 %res = $self->VerifyAttachment( %$item );
945 $status_on = $item->{'Data'};
947 die "Unknown format '".$item->{'Format'} . "' of GnuPG signed part";
949 } elsif ( $item->{'Type'} eq 'encrypted' ) {
950 if ( $item->{'Format'} eq 'RFC3156' ) {
951 %res = $self->DecryptRFC3156( %$item );
952 $status_on = $item->{'Top'};
953 } elsif ( $item->{'Format'} eq 'Inline' ) {
954 %res = $self->DecryptInline( %$item );
955 $status_on = $item->{'Data'};
956 } elsif ( $item->{'Format'} eq 'Attachment' ) {
957 %res = $self->DecryptAttachment( %$item );
958 $status_on = $item->{'Data'};
960 die "Unknown format '".$item->{'Format'} . "' of GnuPG encrypted part";
963 die "Unknown type '".$item->{'Type'} . "' of protected item";
966 return (%res, status_on => $status_on);
969 sub VerifyInline { return (shift)->DecryptInline( @_ ) }
971 sub VerifyAttachment {
973 my %args = ( Data => undef, Signature => undef, @_ );
975 foreach ( $args{'Data'}, $args{'Signature'} ) {
976 next unless $_->bodyhandle->is_encoded;
978 require RT::EmailParser;
979 RT::EmailParser->_DecodeBody($_);
982 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
983 binmode $tmp_fh, ':raw';
984 $args{'Data'}->bodyhandle->print( $tmp_fh );
987 my %res = $self->CallGnuPG(
989 CommandArgs => [ '-', $tmp_fn ],
990 Passphrase => $args{'Passphrase'},
991 Content => $args{'Signature'}->bodyhandle,
994 $args{'Top'}->parts( [
995 grep "$_" ne $args{'Signature'}, $args{'Top'}->parts
997 $args{'Top'}->make_singlepart;
1004 my %args = ( Data => undef, Signature => undef, @_ );
1006 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1007 binmode $tmp_fh, ':raw:eol(CRLF?)';
1008 $args{'Data'}->print( $tmp_fh );
1011 my %res = $self->CallGnuPG(
1012 Command => "verify",
1013 CommandArgs => [ '-', $tmp_fn ],
1014 Passphrase => $args{'Passphrase'},
1015 Content => $args{'Signature'}->bodyhandle,
1018 $args{'Top'}->parts( [ $args{'Data'} ] );
1019 $args{'Top'}->make_singlepart;
1024 sub DecryptRFC3156 {
1030 Passphrase => undef,
1034 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1035 require RT::EmailParser;
1036 RT::EmailParser->_DecodeBody($args{'Data'});
1039 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1040 binmode $tmp_fh, ':raw';
1042 my %res = $self->CallGnuPG(
1043 Command => "decrypt",
1044 Handles => { stdout => $tmp_fh },
1045 Passphrase => $args{'Passphrase'},
1046 Content => $args{'Data'}->bodyhandle,
1049 # if the decryption is fine but the signature is bad, then without this
1050 # status check we lose the decrypted text
1051 # XXX: add argument to the function to control this check
1052 delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
1054 return %res if $res{message};
1057 my $parser = RT::EmailParser->new();
1058 my $decrypted = $parser->ParseMIMEEntityFromFileHandle( $tmp_fh, 0 );
1059 $decrypted->{'__store_link_to_object_to_avoid_early_cleanup'} = $parser;
1061 $args{'Top'}->parts( [$decrypted] );
1062 $args{'Top'}->make_singlepart;
1071 Passphrase => undef,
1075 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1076 require RT::EmailParser;
1077 RT::EmailParser->_DecodeBody($args{'Data'});
1080 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1081 binmode $tmp_fh, ':raw';
1083 my $io = $args{'Data'}->open('r');
1085 die "Entity has no body, never should happen";
1090 my ($had_literal, $in_block) = ('', 0);
1091 my ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1092 binmode $block_fh, ':raw';
1094 while ( defined(my $str = $io->getline) ) {
1095 if ( $in_block && $str =~ /^-----END PGP (?:MESSAGE|SIGNATURE)-----\s*$/ ) {
1096 print $block_fh $str;
1098 next if $in_block > 0;
1100 seek $block_fh, 0, 0;
1102 my ($res_fh, $res_fn);
1103 ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
1105 BlockHandle => $block_fh,
1107 return %res unless $res_fh;
1109 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1110 while (my $buf = <$res_fh> ) {
1113 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1115 ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1116 binmode $block_fh, ':raw';
1119 elsif ( $str =~ /^-----BEGIN PGP (SIGNED )?MESSAGE-----\s*$/ ) {
1121 print $block_fh $str;
1123 elsif ( $in_block ) {
1124 print $block_fh $str;
1128 $had_literal = 1 if /\S/s;
1134 # we're still in a block, this not bad not good. let's try to
1135 # decrypt what we have, it can be just missing -----END PGP...
1136 seek $block_fh, 0, 0;
1138 my ($res_fh, $res_fn);
1139 ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
1141 BlockHandle => $block_fh,
1143 return %res unless $res_fh;
1145 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1146 while (my $buf = <$res_fh> ) {
1149 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1153 $args{'Data'}->bodyhandle(MIME::Body::File->new( $tmp_fn ));
1154 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
1158 sub _DecryptInlineBlock {
1161 BlockHandle => undef,
1162 Passphrase => undef,
1166 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1167 binmode $tmp_fh, ':raw';
1169 my %res = $self->CallGnuPG(
1170 Command => "decrypt",
1171 Handles => { stdout => $tmp_fh, stdin => $args{'BlockHandle'} },
1172 Passphrase => $args{'Passphrase'},
1175 # if the decryption is fine but the signature is bad, then without this
1176 # status check we lose the decrypted text
1177 # XXX: add argument to the function to control this check
1178 delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
1180 return (undef, undef, %res) if $res{message};
1183 return ($tmp_fh, $tmp_fn, %res);
1186 sub DecryptAttachment {
1190 Passphrase => undef,
1194 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1195 require RT::EmailParser;
1196 RT::EmailParser->_DecodeBody($args{'Data'});
1199 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1200 binmode $tmp_fh, ':raw';
1201 $args{'Data'}->bodyhandle->print( $tmp_fh );
1204 my ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
1206 BlockHandle => $tmp_fh,
1208 return %res unless $res_fh;
1210 $args{'Data'}->bodyhandle(MIME::Body::File->new($res_fn) );
1211 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $res_fh;
1213 my $head = $args{'Data'}->head;
1215 # we can not trust original content type
1216 # TODO: and don't have way to detect, so we just use octet-stream
1217 # some clients may send .asc files (encryped) as text/plain
1218 $head->mime_attr( "Content-Type" => 'application/octet-stream' );
1220 my $filename = $head->recommended_filename;
1221 $filename =~ s/\.${RE_FILE_EXTENSIONS}$//i;
1222 $head->mime_attr( $_ => $filename )
1223 foreach (qw(Content-Type.name Content-Disposition.filename));
1228 sub DecryptContent {
1232 Passphrase => undef,
1236 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1237 binmode $tmp_fh, ':raw';
1239 my %res = $self->CallGnuPG(
1240 Command => "decrypt",
1241 Handles => { stdout => $tmp_fh },
1242 Passphrase => $args{'Passphrase'},
1243 Content => $args{'Content'},
1246 # if the decryption is fine but the signature is bad, then without this
1247 # status check we lose the decrypted text
1248 # XXX: add argument to the function to control this check
1249 delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
1251 return %res if $res{'message'};
1253 ${ $args{'Content'} } = '';
1256 my $status = read $tmp_fh, my $buf, 4*1024;
1257 unless ( defined $status ) {
1258 $RT::Logger->crit( "couldn't read message: $!" );
1259 } elsif ( !$status ) {
1262 ${ $args{'Content'} } .= $buf;
1268 my %REASON_CODE_TO_TEXT = (
1270 1 => "No armored data",
1271 2 => "Expected a packet, but did not found one",
1272 3 => "Invalid packet found",
1273 4 => "Signature expected, but not found",
1276 0 => "No specific reason given",
1278 2 => "Ambigious specification",
1279 3 => "Wrong key usage",
1282 6 => "No CRL known",
1284 8 => "Policy mismatch",
1285 9 => "Not a secret key",
1286 10 => "Key not trusted",
1289 0 => 'not specified',
1290 4 => 'unknown algorithm',
1291 9 => 'missing public key',
1295 sub ReasonCodeToText {
1296 my $keyword = shift;
1298 return $REASON_CODE_TO_TEXT{ $keyword }{ $code }
1299 if exists $REASON_CODE_TO_TEXT{ $keyword }{ $code };
1303 my %simple_keyword = (
1305 Operation => 'RecipientsCheck',
1307 Message => 'No recipients',
1310 Operation => 'Data',
1312 Message => 'Unexpected data has been encountered',
1315 Operation => 'Data',
1317 Message => 'The ASCII armor is corrupted',
1322 my %parse_keyword = map { $_ => 1 } qw(
1324 SIG_CREATED GOODSIG BADSIG ERRSIG
1326 DECRYPTION_FAILED DECRYPTION_OKAY
1327 BAD_PASSPHRASE GOOD_PASSPHRASE
1329 NO_RECP INV_RECP NODATA UNEXPECTED
1332 # keywords we ignore without any messages as we parse them using other
1333 # keywords as starting point or just ignore as they are useless for us
1334 my %ignore_keyword = map { $_ => 1 } qw(
1335 NEED_PASSPHRASE MISSING_PASSPHRASE BEGIN_SIGNING PLAINTEXT PLAINTEXT_LENGTH
1336 BEGIN_ENCRYPTION SIG_ID VALIDSIG
1337 ENC_TO BEGIN_DECRYPTION END_DECRYPTION GOODMDC
1338 TRUST_UNDEFINED TRUST_NEVER TRUST_MARGINAL TRUST_FULLY TRUST_ULTIMATE
1345 return () unless $status;
1348 while ( $status =~ /\[GNUPG:\]\s*(.*?)(?=\[GNUPG:\]|\z)/igms ) {
1349 push @status, $1; $status[-1] =~ s/\s+/ /g; $status[-1] =~ s/\s+$//;
1351 $status = join "\n", @status;
1355 my (%user_hint, $latest_user_main_key);
1356 for ( my $i = 0; $i < @status; $i++ ) {
1357 my $line = $status[$i];
1358 my ($keyword, $args) = ($line =~ /^(\S+)\s*(.*)$/s);
1359 if ( $simple_keyword{ $keyword } ) {
1360 push @res, $simple_keyword{ $keyword };
1361 $res[-1]->{'Keyword'} = $keyword;
1364 unless ( $parse_keyword{ $keyword } ) {
1365 $RT::Logger->warning("Skipped $keyword") unless $ignore_keyword{ $keyword };
1369 if ( $keyword eq 'USERID_HINT' ) {
1370 my %tmp = _ParseUserHint($status, $line);
1371 $latest_user_main_key = $tmp{'MainKey'};
1372 if ( $user_hint{ $tmp{'MainKey'} } ) {
1373 while ( my ($k, $v) = each %tmp ) {
1374 $user_hint{ $tmp{'MainKey'} }->{$k} = $v;
1377 $user_hint{ $tmp{'MainKey'} } = \%tmp;
1381 elsif ( $keyword eq 'BAD_PASSPHRASE' || $keyword eq 'GOOD_PASSPHRASE' ) {
1384 Operation => 'PassphraseCheck',
1385 Status => $keyword eq 'BAD_PASSPHRASE'? 'BAD' : 'DONE',
1388 $res{'Status'} = 'MISSING' if $status[ $i - 1 ] =~ /^MISSING_PASSPHRASE/;
1389 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1390 next unless $line =~ /^NEED_PASSPHRASE\s+(\S+)\s+(\S+)\s+(\S+)/;
1391 next if $key_id && $2 ne $key_id;
1392 @res{'MainKey', 'Key', 'KeyType'} = ($1, $2, $3);
1395 $res{'Message'} = ucfirst( lc( $res{'Status'} eq 'DONE'? 'GOOD': $res{'Status'} ) ) .' passphrase';
1396 $res{'User'} = ( $user_hint{ $res{'MainKey'} } ||= {} ) if $res{'MainKey'};
1397 if ( exists $res{'User'}->{'EmailAddress'} ) {
1398 $res{'Message'} .= ' for '. $res{'User'}->{'EmailAddress'};
1400 $res{'Message'} .= " for '0x$key_id'";
1404 elsif ( $keyword eq 'END_ENCRYPTION' ) {
1406 Operation => 'Encrypt',
1408 Message => 'Data has been encrypted',
1410 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1411 next unless $line =~ /^BEGIN_ENCRYPTION\s+(\S+)\s+(\S+)/;
1412 @res{'MdcMethod', 'SymAlgo'} = ($1, $2);
1417 elsif ( $keyword eq 'DECRYPTION_FAILED' || $keyword eq 'DECRYPTION_OKAY' ) {
1418 my %res = ( Operation => 'Decrypt' );
1419 @res{'Status', 'Message'} =
1420 $keyword eq 'DECRYPTION_FAILED'
1421 ? ('ERROR', 'Decryption failed')
1422 : ('DONE', 'Decryption process succeeded');
1424 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1425 next unless $line =~ /^ENC_TO\s+(\S+)\s+(\S+)\s+(\S+)/;
1426 my ($key, $alg, $key_length) = ($1, $2, $3);
1428 my %encrypted_to = (
1429 Message => "The message is encrypted to '0x$key'",
1430 User => ( $user_hint{ $key } ||= {} ),
1432 KeyLength => $key_length,
1436 push @{ $res{'EncryptedTo'} ||= [] }, \%encrypted_to;
1441 elsif ( $keyword eq 'NO_SECKEY' || $keyword eq 'NO_PUBKEY' ) {
1442 my ($key) = split /\s+/, $args;
1443 my $type = $keyword eq 'NO_SECKEY'? 'secret': 'public';
1445 Operation => 'KeyCheck',
1446 Status => 'MISSING',
1447 Message => ucfirst( $type ) ." key '0x$key' is not available",
1451 $res{'User'} = ( $user_hint{ $key } ||= {} );
1452 $res{'User'}{ ucfirst( $type ). 'KeyMissing' } = 1;
1455 # GOODSIG, BADSIG, VALIDSIG, TRUST_*
1456 elsif ( $keyword eq 'GOODSIG' ) {
1458 Operation => 'Verify',
1460 Message => 'The signature is good',
1462 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1463 $res{'Message'} .= ', signed by '. $res{'UserString'};
1465 foreach my $line ( @status[ $i .. $#status ] ) {
1466 next unless $line =~ /^TRUST_(\S+)/;
1470 $res{'Message'} .= ', trust level is '. lc( $res{'Trust'} || 'unknown');
1472 foreach my $line ( @status[ $i .. $#status ] ) {
1473 next unless $line =~ /^VALIDSIG\s+(.*)/;
1486 ) } = split /\s+/, $1, 10;
1491 elsif ( $keyword eq 'BADSIG' ) {
1493 Operation => 'Verify',
1495 Message => 'The signature has not been verified okay',
1497 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1500 elsif ( $keyword eq 'ERRSIG' ) {
1502 Operation => 'Verify',
1504 Message => 'Not possible to check the signature',
1506 @res{qw(Key PubkeyAlgo HashAlgo Class Timestamp ReasonCode Other)}
1507 = split /\s+/, $args, 7;
1509 $res{'Reason'} = ReasonCodeToText( $keyword, $res{'ReasonCode'} );
1510 $res{'Message'} .= ", the reason is ". $res{'Reason'};
1514 elsif ( $keyword eq 'SIG_CREATED' ) {
1515 # SIG_CREATED <type> <pubkey algo> <hash algo> <class> <timestamp> <key fpr>
1516 my @props = split /\s+/, $args;
1518 Operation => 'Sign',
1520 Message => "Signed message",
1522 PubKeyAlgo => $props[1],
1523 HashKeyAlgo => $props[2],
1525 Timestamp => $props[4],
1526 KeyFingerprint => $props[5],
1527 User => $user_hint{ $latest_user_main_key },
1529 $res[-1]->{Message} .= ' by '. $user_hint{ $latest_user_main_key }->{'EmailAddress'}
1530 if $user_hint{ $latest_user_main_key };
1532 elsif ( $keyword eq 'INV_RECP' ) {
1533 my ($rcode, $recipient) = split /\s+/, $args, 2;
1534 my $reason = ReasonCodeToText( $keyword, $rcode );
1536 Operation => 'RecipientsCheck',
1538 Message => "Recipient '$recipient' is unusable, the reason is '$reason'",
1539 Recipient => $recipient,
1540 ReasonCode => $rcode,
1544 elsif ( $keyword eq 'NODATA' ) {
1545 my $rcode = (split /\s+/, $args)[0];
1546 my $reason = ReasonCodeToText( $keyword, $rcode );
1548 Operation => 'Data',
1550 Message => "No data has been found. The reason is '$reason'",
1551 ReasonCode => $rcode,
1556 $RT::Logger->warning("Keyword $keyword is unknown");
1559 $res[-1]{'Keyword'} = $keyword if @res && !$res[-1]{'Keyword'};
1564 sub _ParseUserHint {
1565 my ($status, $hint) = (@_);
1566 my ($main_key_id, $user_str) = ($hint =~ /^USERID_HINT\s+(\S+)\s+(.*)$/);
1567 return () unless $main_key_id;
1569 MainKey => $main_key_id,
1570 String => $user_str,
1571 EmailAddress => (map $_->address, Email::Address->parse( $user_str ))[0],
1575 sub _PrepareGnuPGOptions {
1577 my %res = map { lc $_ => $opt{ $_ } } grep $supported_opt{ lc $_ }, keys %opt;
1578 $res{'extra_args'} ||= [];
1579 foreach my $o ( grep !$supported_opt{ lc $_ }, keys %opt ) {
1580 push @{ $res{'extra_args'} }, '--'. lc $o;
1581 push @{ $res{'extra_args'} }, $opt{ $o }
1582 if defined $opt{ $o };
1587 sub GetKeysForEncryption {
1589 my %args = (Recipient => undef, @_);
1590 my %res = $self->GetKeysInfo( Key => delete $args{'Recipient'}, %args, Type => 'public' );
1591 return %res if $res{'exit_code'};
1592 return %res unless $res{'info'};
1594 foreach my $key ( splice @{ $res{'info'} } ) {
1595 # skip disabled keys
1596 next if $key->{'Capabilities'} =~ /D/;
1597 # skip keys not suitable for encryption
1598 next unless $key->{'Capabilities'} =~ /e/i;
1599 # skip disabled, expired, revoked and keys with no trust,
1600 # but leave keys with unknown trust level
1601 next if $key->{'TrustLevel'} < 0;
1603 push @{ $res{'info'} }, $key;
1605 delete $res{'info'} unless @{ $res{'info'} };
1609 sub GetKeysForSigning {
1611 my %args = (Signer => undef, @_);
1612 return $self->GetKeysInfo( Key => delete $args{'Signer'}, %args, Type => 'private' );
1624 my $email = $args{'Key'};
1625 my $type = $args{'Type'};
1627 return (exit_code => 0) unless $args{'Force'};
1631 my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
1632 my %res = $self->CallGnuPG(
1634 'with-colons' => undef, # parseable format
1635 'fingerprint' => undef, # show fingerprint
1636 'fixed-list-mode' => undef, # don't merge uid with keys
1639 ( $email ? (CommandArgs => ['--', $email]) : () ),
1643 # Asking for a non-existent key is not an error
1644 if ($res{message} and $res{logger} =~ /(secret key not available|public key not found)/) {
1645 delete $res{exit_code};
1646 delete $res{message};
1649 return %res if $res{'message'};
1651 @info = $self->ParseKeysInfo( @info );
1652 $res{'info'} = \@info;
1654 for my $key (@{$res{info}}) {
1656 join("; ", map {$_->{String}} @{$key->{User}})
1657 . " (".substr($key->{Fingerprint}, -8) . ")";
1667 my %gpg_opt = RT->Config->Get('GnuPGOptions');
1670 foreach my $line( @lines ) {
1673 ($tag, $line) = split /:/, $line, 2;
1674 if ( $tag eq 'pub' ) {
1677 TrustChar KeyLength Algorithm Key
1678 Created Expire Empty OwnerTrustChar
1679 Empty Empty Capabilities Other
1680 ) } = split /:/, $line, 12;
1682 # workaround gnupg's wierd behaviour, --list-keys command report calculated trust levels
1683 # for any model except 'always', so you can change models and see changes, but not for 'always'
1684 # we try to handle it in a simple way - we set ultimate trust for any key with trust
1685 # level >= 0 if trust model is 'always'
1687 $always_trust = 1 if exists $gpg_opt{'always-trust'};
1688 $always_trust = 1 if exists $gpg_opt{'trust-model'} && $gpg_opt{'trust-model'} eq 'always';
1689 @info{qw(Trust TrustTerse TrustLevel)} =
1690 _ConvertTrustChar( $info{'TrustChar'} );
1691 if ( $always_trust && $info{'TrustLevel'} >= 0 ) {
1692 @info{qw(Trust TrustTerse TrustLevel)} =
1693 _ConvertTrustChar( 'u' );
1696 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
1697 _ConvertTrustChar( $info{'OwnerTrustChar'} );
1698 $info{ $_ } = $self->ParseDate( $info{ $_ } )
1699 foreach qw(Created Expire);
1702 elsif ( $tag eq 'sec' ) {
1705 Empty KeyLength Algorithm Key
1706 Created Expire Empty OwnerTrustChar
1707 Empty Empty Capabilities Other
1708 ) } = split /:/, $line, 12;
1709 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
1710 _ConvertTrustChar( $info{'OwnerTrustChar'} );
1711 $info{ $_ } = $self->ParseDate( $info{ $_ } )
1712 foreach qw(Created Expire);
1715 elsif ( $tag eq 'uid' ) {
1717 @info{ qw(Trust Created Expire String) }
1718 = (split /:/, $line)[0,4,5,8];
1719 $info{ $_ } = $self->ParseDate( $info{ $_ } )
1720 foreach qw(Created Expire);
1721 push @{ $res[-1]{'User'} ||= [] }, \%info;
1723 elsif ( $tag eq 'fpr' ) {
1724 $res[-1]{'Fingerprint'} = (split /:/, $line, 10)[8];
1734 "The key has been disabled", #loc
1735 "key disabled", #loc
1740 "The key has been revoked", #loc
1745 e => [ "The key has expired", #loc
1750 n => [ "Don't trust this key at all", #loc
1755 #gpupg docs says that '-' and 'q' may safely be treated as the same value
1757 'Unknown (no trust value assigned)', #loc
1762 'Unknown (no trust value assigned)', #loc
1767 'Unknown (this value is new to the system)', #loc
1773 "There is marginal trust in this key", #loc
1778 "The key is fully trusted", #loc
1783 "The key is ultimately trusted", #loc
1789 sub _ConvertTrustChar {
1791 return @{ $verbose{'-'} } unless $value;
1792 $value = substr $value, 0, 1;
1793 return @{ $verbose{ $value } || $verbose{'o'} };
1801 return $self->CallGnuPG(
1802 Command => "--delete-secret-and-public-key",
1803 CommandArgs => ["--", $key],
1806 while ( my $str = readline $handle{'status'} ) {
1807 if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) {
1808 print { $handle{'command'} } "y\n";
1819 return $self->CallGnuPG(
1820 Command => "import_keys",
1826 state $cache = RT->Config->Get('GnuPG')->{'GnuPG'};
1827 $cache = $_[1] if @_ > 1;
1833 my $gnupg = GnuPG::Interface->new;
1835 my $bin = $self->GnuPGPath();
1837 $RT::Logger->warning(
1838 "No gpg path set; GnuPG support has been disabled. ".
1839 "Check the 'GnuPG' configuration in %GnuPG");
1843 if ($bin =~ m{^/}) {
1844 unless (-f $bin and -x _) {
1845 $RT::Logger->warning(
1846 "Invalid gpg path $bin; GnuPG support has been disabled. ".
1847 "Check the 'GnuPG' configuration in %GnuPG");
1851 local $ENV{PATH} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin'
1852 unless defined $ENV{PATH};
1853 my $path = File::Which::which( $bin );
1855 $RT::Logger->warning(
1856 "Can't find gpg binary '$bin' in PATH ($ENV{PATH}); GnuPG support has been disabled. ".
1857 "You may need to specify a full path to gpg via the 'GnuPG' configuration in %GnuPG");
1860 $self->GnuPGPath( $bin = $path );
1863 $gnupg->call( $bin );
1864 $gnupg->options->hash_init(
1865 _PrepareGnuPGOptions( RT->Config->Get('GnuPGOptions') )
1867 $gnupg->options->meta_interactive( 0 );
1869 my ($handles, $handle_list) = _make_gpg_handles();
1870 my %handle = %$handle_list;
1874 local $SIG{'CHLD'} = 'DEFAULT';
1875 my $pid = safe_run_child {
1877 commands => ['--version' ],
1881 close $handle{'stdin'} or die "Can't close gnupg input handle: $!";
1885 $RT::Logger->warning(
1886 "RT's GnuPG libraries couldn't successfully execute gpg.".
1887 " GnuPG support has been disabled");
1889 "Probe for GPG failed."
1890 ." Couldn't run `gpg --version`: ". $@
1895 # on some systems gpg exits with code 2, but still 100% functional,
1896 # it's general error system error or incorrect command, command is correct,
1897 # but there is no way to get actuall error
1898 if ( $? && ($? >> 8) != 2 ) {
1899 my $msg = "Probe for GPG failed."
1900 ." Process exited with code ". ($? >> 8)
1901 . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '')
1903 foreach ( qw(stderr logger status) ) {
1904 my $tmp = do { local $/ = undef; readline $handle{$_} };
1905 next unless $tmp && $tmp =~ /\S/s;
1906 close $handle{$_} or $tmp .= "\nFailed to close: $!";
1907 $msg .= "\n$_:\n$tmp\n";
1909 $RT::Logger->warning(
1910 "RT's GnuPG libraries couldn't successfully execute gpg.".
1911 " GnuPG support has been disabled");
1912 $RT::Logger->debug( $msg );
1919 sub _make_gpg_handles {
1920 my %handle_map = (@_);
1921 $handle_map{$_} = IO::Handle->new
1922 foreach grep !defined $handle_map{$_},
1923 qw(stdin stdout stderr logger status command);
1925 my $handles = GnuPG::Handles->new(%handle_map);
1926 return ($handles, \%handle_map);
1929 RT::Base->_ImportOverlays();