Master to 4.2.8
[usit-rt.git] / lib / RT / Crypt / GnuPG.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
320f0092 5# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
84fb5b46
MKG
6# <sales@bestpractical.com>
7#
8# (Except where explicitly superseded by other copyright notices)
9#
10#
11# LICENSE:
12#
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
16# from www.gnu.org.
17#
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.
22#
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.
28#
29#
30# CONTRIBUTION SUBMISSION POLICY:
31#
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.)
37#
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.
46#
47# END BPS TAGGED BLOCK }}}
48
49use strict;
50use warnings;
af59614d 51use 5.010;
84fb5b46
MKG
52
53package RT::Crypt::GnuPG;
54
af59614d
MKG
55use Role::Basic 'with';
56with 'RT::Crypt::Role';
57
84fb5b46 58use IO::Handle;
af59614d
MKG
59use File::Which qw();
60use RT::Crypt::GnuPG::CRLFHandle;
84fb5b46
MKG
61use GnuPG::Interface;
62use RT::EmailParser ();
63use RT::Util 'safe_run_child', 'mime_recommended_filename';
64
65=head1 NAME
66
af59614d 67RT::Crypt::GnuPG - GNU Privacy Guard encryption/decryption/verification/signing
84fb5b46
MKG
68
69=head1 DESCRIPTION
70
af59614d
MKG
71This module provides support for encryption and signing of outgoing
72messages using GnuPG, as well as the decryption and verification of
73incoming email.
84fb5b46
MKG
74
75=head1 CONFIGURATION
76
af59614d
MKG
77There are two reveant configuration options, both of which are hashes:
78C<GnuPG> and C<GnuPGOptions>. The first one controls RT specific
79options; it enables you to enable/disable the GPG protocol or change the
80format of messages. The second one is a hash with options which are
81passed to the C<gnupg> utility. You can use it to define a keyserver,
82enable auto-retrieval of keys, or set almost any option which C<gnupg>
83supports on your system.
84fb5b46
MKG
84
85=head2 %GnuPG
86
87=head3 Enabling GnuPG
88
89Set to true value to enable this subsystem:
90
91 Set( %GnuPG,
92 Enable => 1,
93 ... other options ...
94 );
95
af59614d 96However, note that you B<must> add the 'Auth::Crypt' email filter to enable
84fb5b46
MKG
97the handling of incoming encrypted/signed messages.
98
99=head3 Format of outgoing messages
100
af59614d
MKG
101The format of outgoing messages can be controlled using the
102C<OutgoingMessagesFormat> option in the RT config:
84fb5b46
MKG
103
104 Set( %GnuPG,
105 ... other options ...
106 OutgoingMessagesFormat => 'RFC',
107 ... other options ...
108 );
109
110or
111
112 Set( %GnuPG,
113 ... other options ...
114 OutgoingMessagesFormat => 'Inline',
115 ... other options ...
116 );
117
af59614d 118The two formats for GPG mail are as follows:
84fb5b46
MKG
119
120=over
121
122=item RFC
123
af59614d
MKG
124This format, the default, is also known as GPG/MIME, and is described in
125RFC3156 and RFC1847. The technique described in these RFCs is well
126supported by many mail user agents (MUA); however, some older MUAs only
127support inline signatures and encryption.
84fb5b46
MKG
128
129=item Inline
130
af59614d
MKG
131This format doesn't take advantage of MIME, but some mail clients do not
132support GPG/MIME. In general, this format is discouraged because modern
133mail clients typically do not support it well.
84fb5b46 134
af59614d
MKG
135Text parts are signed using clear-text signatures. For each attachment,
136the signature is attached separately as a file with a '.sig' extension
137added to the filename. Encryption of text parts is implemented using
138inline format, while other parts are replaced with attachments with the
139filename extension '.pgp'.
84fb5b46
MKG
140
141=back
142
af59614d 143=head3 Passphrases
84fb5b46 144
af59614d
MKG
145Passphrases for keys may be set by passing C<Passphrase>. It may be set
146to a scalar (to use for all keys), an anonymous function, or a hash (to
147look up by address). If the hash is used, the '' key is used as a
148default.
84fb5b46
MKG
149
150=head2 %GnuPGOptions
151
af59614d
MKG
152Use this hash to set additional options of the 'gnupg' program. The
153only options which are diallowed are options which alter the output
154format or attempt to run commands; thiss includes C<--sign>,
155C<--list-options>, etc.
84fb5b46 156
af59614d
MKG
157Some GnuPG options take arguments, while others take none. (Such as
158C<--use-agent>). For options without specific value use C<undef> as
159hash value. To disable these options, you may comment them out or
160delete them from the hash:
84fb5b46
MKG
161
162 Set(%GnuPGOptions,
163 'option-with-value' => 'value',
164 'enabled-option-without-value' => undef,
165 # 'commented-option' => 'value or undef',
166 );
167
af59614d
MKG
168B<NOTE> that options may contain the '-' character and such options
169B<MUST> be quoted, otherwise you will see the quite cryptic error C<gpg:
170Invalid option "--0">.
171
172Common options include:
84fb5b46
MKG
173
174=over
175
176=item --homedir
177
af59614d
MKG
178The GnuPG home directory where the keyrings are stored; by default it is
179set to F</opt/rt4/var/data/gpg>.
84fb5b46 180
af59614d
MKG
181You can manage this data with the 'gpg' commandline utility using the
182GNUPGHOME environment variable or C<--homedir> option. Other utilities may
183be used as well.
84fb5b46 184
af59614d
MKG
185In a standard installation, access to this directory should be granted
186to the web server user which is running RT's web interface; however, if
187you are running cronjobs or other utilities that access RT directly via
188API, and may generate encrypted/signed notifications, then the users you
189execute these scripts under must have access too.
84fb5b46 190
af59614d
MKG
191Be aware that granting access to the directory to many users makes the
192keys less secure -- and some features, such as auto-import of keys, may
193not be available if directory permissions are too permissive. To enable
194these features and suppress warnings about permissions on the directory,
195add the C<--no-permission-warning> option to C<GnuPGOptions>.
84fb5b46
MKG
196
197=item --digest-algo
198
af59614d
MKG
199This option is required when the C<RFC> format for outgoing messages is
200used. RT defaults to 'SHA1' by default, but you may wish to override
201it. C<gnupng --version> will list the algorithms supported by your
202C<gnupg> installation under 'hash functions'; these generally include
203MD5, SHA1, RIPEMD160, and SHA256.
84fb5b46
MKG
204
205=item --use-agent
206
af59614d
MKG
207This option lets you use GPG Agent to cache the passphrase of secret
208keys. See
84fb5b46
MKG
209L<http://www.gnupg.org/documentation/manuals/gnupg/Invoking-GPG_002dAGENT.html>
210for information about GPG Agent.
211
212=item --passphrase
213
af59614d
MKG
214This option lets you set the passphrase of RT's key directly. This
215option is special in that it is not passed directly to GPG; rather, it
216is put into a file that GPG then reads (which is more secure). The
217downside is that anyone who has read access to your RT_SiteConfig.pm
218file can see the passphrase -- thus we recommend the --use-agent option
219whenever possible.
84fb5b46
MKG
220
221=item other
222
af59614d 223Read C<man gpg> to get list of all options this program supports.
84fb5b46
MKG
224
225=back
226
227=head2 Per-queue options
228
229Using the web interface it's possible to enable signing and/or encrypting by
af59614d 230default. As an administrative user of RT, open 'Admin' then 'Queues',
84fb5b46
MKG
231and select a queue. On the page you can see information about the queue's keys
232at the bottom and two checkboxes to choose default actions.
233
234As well, encryption is enabled for autoreplies and other notifications when
235an encypted message enters system via mailgate interface even if queue's
236option is disabled.
237
238=head2 Handling incoming messages
239
240To enable handling of encrypted and signed message in the RT you should add
af59614d 241'Auth::Crypt' mail plugin.
84fb5b46 242
af59614d 243 Set(@MailPlugins, 'Auth::MailFrom', 'Auth::Crypt', ...other filter...);
84fb5b46 244
af59614d 245See also `perldoc lib/RT/Interface/Email/Auth/Crypt.pm`.
84fb5b46 246
af59614d 247=head2 Encrypting to untrusted keys
84fb5b46
MKG
248
249Due to limitations of GnuPG, it's impossible to encrypt to an untrusted key,
250unless 'always trust' mode is enabled.
251
af59614d 252=head1 FOR DEVELOPERS
84fb5b46 253
af59614d 254=head2 Documentation and references
84fb5b46 255
af59614d 256=over
84fb5b46 257
af59614d 258=item RFC1847
84fb5b46 259
af59614d
MKG
260Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted.
261Describes generic MIME security framework, "mulitpart/signed" and
262"multipart/encrypted" MIME types.
84fb5b46 263
84fb5b46 264
af59614d 265=item RFC3156
84fb5b46 266
af59614d 267MIME Security with Pretty Good Privacy (PGP), updates RFC2015.
84fb5b46 268
af59614d 269=back
84fb5b46
MKG
270
271=cut
272
273# gnupg options supported by GnuPG::Interface
274# other otions should be handled via extra_args argument
275my %supported_opt = map { $_ => 1 } qw(
276 always_trust
277 armor
278 batch
279 comment
280 compress_algo
281 default_key
282 encrypt_to
283 extra_args
284 force_v3_sigs
285 homedir
286 logger_fd
287 no_greeting
288 no_options
289 no_verbose
290 openpgp
291 options
292 passphrase_fd
293 quiet
294 recipients
295 rfc1991
296 status_fd
297 textmode
298 verbose
299);
300
301our $RE_FILE_EXTENSIONS = qr/pgp|asc/i;
302
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()),
311# ...
312# );
313
af59614d
MKG
314sub CallGnuPG {
315 my $self = shift;
316 my %args = (
317 Options => undef,
318 Signer => undef,
319 Recipients => [],
320 Passphrase => undef,
321
322 Command => undef,
323 CommandArgs => [],
324
325 Content => undef,
326 Handles => {},
327 Direct => undef,
328 Output => undef,
329 @_
330 );
84fb5b46 331
af59614d
MKG
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;
84fb5b46 337
af59614d
MKG
338 my $content = $args{Content};
339 my $command = $args{Command};
84fb5b46 340
af59614d
MKG
341 my %GnuPGOptions = RT->Config->Get('GnuPGOptions');
342 my %opt = (
343 'digest-algo' => 'SHA1',
344 %GnuPGOptions,
345 %{ $args{Options} || {} },
346 );
347 my $gnupg = GnuPG::Interface->new;
348 $gnupg->call( $self->GnuPGPath );
349 $gnupg->options->hash_init(
350 _PrepareGnuPGOptions( %opt ),
351 );
352 $gnupg->options->armor( 1 );
353 $gnupg->options->meta_interactive( 0 );
354 $gnupg->options->default_key( $args{Signer} )
355 if defined $args{Signer};
84fb5b46 356
af59614d
MKG
357 my %seen;
358 $gnupg->options->push_recipients( $_ ) for
359 map { RT::Crypt->UseKeyForEncryption($_) || $_ }
360 grep { !$seen{ $_ }++ }
361 @{ $args{Recipients} || [] };
84fb5b46 362
af59614d
MKG
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};
84fb5b46 369
af59614d
MKG
370 eval {
371 local $SIG{'CHLD'} = 'DEFAULT';
372 my $pid = safe_run_child {
373 if ($command =~ /^--/) {
374 $gnupg->wrap_call(
375 handles => $handles,
376 commands => [$command],
377 command_args => $args{CommandArgs},
378 );
379 } else {
380 $gnupg->$command(
381 handles => $handles,
382 command_args => $args{CommandArgs},
383 );
384 }
385 };
386 {
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 );
394 }
395 close $handle{'stdin'} or die "Can't close gnupg input handle: $!";
396 $args{Callback}->(%handle) if $args{Callback};
397 }
398 waitpid $pid, 0;
399 };
400 my $err = $@;
401 if ($args{Output}) {
402 push @{$args{Output}}, readline $handle{stdout};
403 if (not close $handle{stdout}) {
404 $err ||= "Can't close gnupg output handle: $!";
405 }
406 }
84fb5b46 407
af59614d
MKG
408 my %res;
409 $res{'exit_code'} = $?;
84fb5b46 410
af59614d
MKG
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: $!";
416 }
417 }
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);
423 }
84fb5b46 424
af59614d
MKG
425 return %res;
426}
84fb5b46
MKG
427
428sub SignEncrypt {
af59614d 429 my $self = shift;
84fb5b46 430
84fb5b46
MKG
431 my $format = lc RT->Config->Get('GnuPG')->{'OutgoingMessagesFormat'} || 'RFC';
432 if ( $format eq 'inline' ) {
af59614d 433 return $self->SignEncryptInline( @_ );
84fb5b46 434 } else {
af59614d 435 return $self->SignEncryptRFC3156( @_ );
84fb5b46
MKG
436 }
437}
438
439sub SignEncryptRFC3156 {
af59614d 440 my $self = shift;
84fb5b46
MKG
441 my %args = (
442 Entity => undef,
443
444 Sign => 1,
445 Signer => undef,
446 Passphrase => undef,
447
448 Encrypt => 1,
449 Recipients => undef,
450
451 @_
452 );
453
84fb5b46 454 my $entity = $args{'Entity'};
84fb5b46
MKG
455 my %res;
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'
463 );
464 }
465 }
af59614d
MKG
466 $entity->make_multipart( 'mixed', Force => 1 );
467
468 my @signature;
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 },
475 Direct => [],
476 Passphrase => $args{'Passphrase'},
477 Content => $entity->parts(0),
478 Output => \@signature,
479 );
480 return %res if $res{message};
84fb5b46
MKG
481
482 # setup RFC1847(Ch.2.1) requirements
483 my $protocol = 'application/pgp-signature';
af59614d 484 my $algo = RT->Config->Get('GnuPGOptions')->{'digest-algo'} || 'SHA1';
84fb5b46
MKG
485 $entity->head->mime_attr( 'Content-Type' => 'multipart/signed' );
486 $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
af59614d 487 $entity->head->mime_attr( 'Content-Type.micalg' => 'pgp-'. lc $algo );
84fb5b46
MKG
488 $entity->attach(
489 Type => $protocol,
490 Disposition => 'inline',
491 Data => \@signature,
492 Encoding => '7bit',
493 );
494 }
495 if ( $args{'Encrypt'} ) {
af59614d 496 my @recipients = map $_->address,
c33a4027
MKG
497 map Email::Address->parse( Encode::decode( "UTF-8", $_ ) ),
498 map $entity->head->get( $_ ),
84fb5b46
MKG
499 qw(To Cc Bcc);
500
501 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
502 binmode $tmp_fh, ':raw';
503
af59614d
MKG
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),
512 );
513 return %res if $res{message};
84fb5b46
MKG
514
515 my $protocol = 'application/pgp-encrypted';
516 $entity->parts([]);
517 $entity->head->mime_attr( 'Content-Type' => 'multipart/encrypted' );
518 $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
519 $entity->attach(
520 Type => $protocol,
521 Disposition => 'inline',
522 Data => ['Version: 1',''],
523 Encoding => '7bit',
524 );
525 $entity->attach(
526 Type => 'application/octet-stream',
527 Disposition => 'inline',
528 Path => $tmp_fn,
529 Filename => '',
530 Encoding => '7bit',
531 );
532 $entity->parts(-1)->bodyhandle->{'_dirty_hack_to_save_a_ref_tmp_fh'} = $tmp_fh;
533 }
534 return %res;
535}
536
537sub SignEncryptInline {
af59614d 538 my $self = shift;
84fb5b46
MKG
539 my %args = ( @_ );
540
541 my $entity = $args{'Entity'};
542
543 my %res;
544 $entity->make_singlepart;
545 if ( $entity->is_multipart ) {
546 foreach ( $entity->parts ) {
af59614d 547 %res = $self->SignEncryptInline( @_, Entity => $_ );
84fb5b46
MKG
548 return %res if $res{'exit_code'};
549 }
550 return %res;
551 }
552
af59614d 553 return $self->_SignEncryptTextInline( @_ )
84fb5b46
MKG
554 if $entity->effective_type =~ /^text\//i;
555
af59614d 556 return $self->_SignEncryptAttachmentInline( @_ );
84fb5b46
MKG
557}
558
559sub _SignEncryptTextInline {
af59614d 560 my $self = shift;
84fb5b46
MKG
561 my %args = (
562 Entity => undef,
563
564 Sign => 1,
565 Signer => undef,
566 Passphrase => undef,
567
568 Encrypt => 1,
569 Recipients => undef,
570
571 @_
572 );
573 return unless $args{'Sign'} || $args{'Encrypt'};
574
84fb5b46
MKG
575 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
576 binmode $tmp_fh, ':raw';
577
84fb5b46 578 my $entity = $args{'Entity'};
af59614d
MKG
579 my %res = $self->CallGnuPG(
580 Signer => $args{'Signer'},
581 Recipients => $args{'Recipients'},
582 Command => ( $args{'Sign'} && $args{'Encrypt'}
583 ? 'sign_and_encrypt'
584 : ( $args{'Sign'}
585 ? 'clearsign'
586 : 'encrypt' ) ),
587 Handles => { stdout => $tmp_fh },
588 Passphrase => $args{'Passphrase'},
589 Content => $entity->bodyhandle,
590 );
591 return %res if $res{message};
84fb5b46
MKG
592
593 $entity->bodyhandle( MIME::Body::File->new( $tmp_fn) );
594 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
595
596 return %res;
597}
598
599sub _SignEncryptAttachmentInline {
af59614d 600 my $self = shift;
84fb5b46
MKG
601 my %args = (
602 Entity => undef,
603
604 Sign => 1,
605 Signer => undef,
606 Passphrase => undef,
607
608 Encrypt => 1,
609 Recipients => undef,
610
611 @_
612 );
613 return unless $args{'Sign'} || $args{'Encrypt'};
614
84fb5b46
MKG
615
616 my $entity = $args{'Entity'};
84fb5b46
MKG
617
618 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
619 binmode $tmp_fh, ':raw';
620
af59614d
MKG
621 my %res = $self->CallGnuPG(
622 Signer => $args{'Signer'},
623 Recipients => $args{'Recipients'},
624 Command => ( $args{'Sign'} && $args{'Encrypt'}
625 ? 'sign_and_encrypt'
626 : ( $args{'Sign'}
627 ? 'detach_sign'
628 : 'encrypt' ) ),
629 Handles => { stdout => $tmp_fh },
630 Passphrase => $args{'Passphrase'},
631 Content => $entity->bodyhandle,
632 );
633 return %res if $res{message};
84fb5b46
MKG
634
635 my $filename = mime_recommended_filename( $entity ) || 'no_name';
636 if ( $args{'Sign'} && !$args{'Encrypt'} ) {
637 $entity->make_multipart;
638 $entity->attach(
639 Type => 'application/octet-stream',
640 Path => $tmp_fn,
641 Filename => "$filename.sig",
642 Disposition => 'attachment',
643 );
644 } else {
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));
649
650 }
651 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
652
653 return %res;
654}
655
656sub SignEncryptContent {
af59614d 657 my $self = shift;
84fb5b46
MKG
658 my %args = (
659 Content => undef,
660
661 Sign => 1,
662 Signer => undef,
663 Passphrase => undef,
664
665 Encrypt => 1,
666 Recipients => undef,
667
668 @_
669 );
670 return unless $args{'Sign'} || $args{'Encrypt'};
671
84fb5b46
MKG
672 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
673 binmode $tmp_fh, ':raw';
674
af59614d
MKG
675 my %res = $self->CallGnuPG(
676 Signer => $args{'Signer'},
677 Recipients => $args{'Recipients'},
678 Command => ( $args{'Sign'} && $args{'Encrypt'}
679 ? 'sign_and_encrypt'
680 : ( $args{'Sign'}
681 ? 'clearsign'
682 : 'encrypt' ) ),
683 Handles => { stdout => $tmp_fh },
684 Passphrase => $args{'Passphrase'},
685 Content => $args{'Content'},
686 );
687 return %res if $res{message};
84fb5b46
MKG
688
689 ${ $args{'Content'} } = '';
690 seek $tmp_fh, 0, 0;
691 while (1) {
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 ) {
696 last;
697 }
698 ${ $args{'Content'} } .= $buf;
699 }
700
701 return %res;
702}
703
af59614d
MKG
704sub CheckIfProtected {
705 my $self = shift;
706 my %args = ( Entity => undef, @_ );
84fb5b46 707
af59614d 708 my $entity = $args{'Entity'};
84fb5b46 709
af59614d
MKG
710 # we check inline PGP block later in another sub
711 return () unless $entity->is_multipart;
dab09ea8 712
af59614d
MKG
713 # RFC3156, multipart/{signed,encrypted}
714 my $type = $entity->effective_type;
715 return () unless $type =~ /^multipart\/(?:encrypted|signed)$/;
dab09ea8 716
af59614d
MKG
717 unless ( $entity->parts == 2 ) {
718 $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
84fb5b46
MKG
719 return ();
720 }
721
af59614d
MKG
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;
84fb5b46 728
af59614d
MKG
729 if ( $protected eq 'signature' ) {
730 $RT::Logger->debug("Found part signed according to RFC3156");
731 return (
84fb5b46
MKG
732 Type => 'signed',
733 Format => 'RFC3156',
af59614d
MKG
734 Top => $entity,
735 Data => $entity->parts(0),
84fb5b46 736 Signature => $entity->parts(1),
af59614d
MKG
737 );
738 } else {
739 $RT::Logger->debug("Found part encrypted according to RFC3156");
740 return (
741 Type => 'encrypted',
742 Format => 'RFC3156',
743 Top => $entity,
744 Data => $entity->parts(1),
745 Info => $entity->parts(0),
746 );
747 }
748 }
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" );
752 return ();
753 }
754 $RT::Logger->debug("Found part encrypted according to RFC3156");
755 return (
756 Type => 'encrypted',
757 Format => 'RFC3156',
758 Top => $entity,
759 Data => $entity->parts(1),
760 Info => $entity->parts(0),
761 );
762 } else {
763 unless ( $protocol eq 'application/pgp-signature' ) {
764 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
765 return ();
84fb5b46 766 }
af59614d
MKG
767 $RT::Logger->debug("Found part signed according to RFC3156");
768 return (
769 Type => 'signed',
770 Format => 'RFC3156',
771 Top => $entity,
772 Data => $entity->parts(0),
773 Signature => $entity->parts(1),
774 );
84fb5b46 775 }
af59614d
MKG
776 return ();
777}
778
779
780sub FindScatteredParts {
781 my $self = shift;
782 my %args = ( Parts => [], Skip => {}, @_ );
783
784 my @res;
785
786 my @parts = @{ $args{'Parts'} };
84fb5b46
MKG
787
788 # attachments signed with signature in another part
af59614d
MKG
789 {
790 my @file_indices;
791 for (my $i = 0; $i < @parts; $i++ ) {
792 my $part = $parts[ $i ];
84fb5b46 793
af59614d
MKG
794 # we can not associate a signature within an attachment
795 # without file names
796 my $fname = $part->head->recommended_filename;
797 next unless $fname;
84fb5b46 798
af59614d
MKG
799 my $type = $part->effective_type;
800
801 if ( $type eq 'application/pgp-signature' ) {
802 push @file_indices, $i;
803 }
804 elsif ( $type eq 'application/octet-stream' && $fname =~ /\.sig$/i ) {
805 push @file_indices, $i;
806 }
84fb5b46 807 }
af59614d
MKG
808
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)?$/;
813
814 my ($data_part_idx) =
815 grep $file_name eq ($parts[$_]->head->recommended_filename||''),
816 grep $sig_part ne $parts[$_],
817 0 .. @parts - 1;
818 unless ( defined $data_part_idx ) {
819 $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
820 next;
821 }
822
823 my $data_part_in = $parts[ $data_part_idx ];
824
825 $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
826
827 $args{'Skip'}{$data_part_in} = 1;
828 $args{'Skip'}{$sig_part} = 1;
829 push @res, {
830 Type => 'signed',
831 Format => 'Attachment',
832 Top => $args{'Parents'}{$sig_part},
833 Data => $data_part_in,
834 Signature => $sig_part,
835 };
84fb5b46
MKG
836 }
837 }
838
af59614d
MKG
839 # attachments with inline encryption
840 foreach my $part ( @parts ) {
841 next if $args{'Skip'}{$part};
842
843 my $fname = $part->head->recommended_filename || '';
844 next unless $fname =~ /\.${RE_FILE_EXTENSIONS}$/;
84fb5b46 845
af59614d
MKG
846 $RT::Logger->debug("Found encrypted attachment '$fname'");
847
848 $args{'Skip'}{$part} = 1;
84fb5b46 849 push @res, {
af59614d
MKG
850 Type => 'encrypted',
851 Format => 'Attachment',
852 Data => $part,
84fb5b46
MKG
853 };
854 }
855
af59614d
MKG
856 # inline PGP block
857 foreach my $part ( @parts ) {
858 next if $args{'Skip'}{$part};
859
860 my $type = $self->_CheckIfProtectedInline( $part );
861 next unless $type;
862
863 my $file = ($part->head->recommended_filename||'') =~ /\.${RE_FILE_EXTENSIONS}$/;
864
865 $args{'Skip'}{$part} = 1;
84fb5b46 866 push @res, {
af59614d
MKG
867 Type => $type,
868 Format => !$file || $type eq 'signed'? 'Inline' : 'Attachment',
869 Data => $part,
84fb5b46
MKG
870 };
871 }
872
84fb5b46
MKG
873 return @res;
874}
875
af59614d
MKG
876sub _CheckIfProtectedInline {
877 my $self = shift;
878 my $entity = shift;
879 my $check_for_signature = shift || 0;
84fb5b46 880
af59614d
MKG
881 my $io = $entity->open('r');
882 unless ( $io ) {
883 $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
884 return '';
885 }
886
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 );
892 if ($decoder) {
893 local $@;
894 eval {
895 my $buf = '';
896 open my $fh, '>', \$buf
897 or die "Couldn't open scalar for writing: $!";
898 binmode $fh, ":raw";
899 $decoder->decode($io, $fh);
900 close $fh or die "Couldn't close scalar: $!";
901
902 open $fh, '<', \$buf
903 or die "Couldn't re-open scalar for reading: $!";
904 binmode $fh, ":raw";
905 $io = $fh;
906 1;
907 } or do {
908 $RT::Logger->error("Couldn't decode body: $@");
909 }
910 }
911 }
912
913 while ( defined($_ = $io->getline) ) {
914 if ( /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) {
915 return $1? 'signed': 'encrypted';
916 }
917 elsif ( $check_for_signature && !/^-----BEGIN PGP SIGNATURE-----/ ) {
918 return 'signature';
919 }
920 }
921 $io->close;
922 return '';
923}
84fb5b46
MKG
924
925sub VerifyDecrypt {
af59614d 926 my $self = shift;
84fb5b46 927 my %args = (
af59614d 928 Info => undef,
84fb5b46
MKG
929 @_
930 );
af59614d
MKG
931
932 my %res;
933
934 my $item = $args{'Info'};
935 my $status_on;
936 if ( $item->{'Type'} eq 'signed' ) {
84fb5b46 937 if ( $item->{'Format'} eq 'RFC3156' ) {
af59614d 938 %res = $self->VerifyRFC3156( %$item );
84fb5b46
MKG
939 $status_on = $item->{'Top'};
940 } elsif ( $item->{'Format'} eq 'Inline' ) {
af59614d 941 %res = $self->VerifyInline( %$item );
84fb5b46
MKG
942 $status_on = $item->{'Data'};
943 } elsif ( $item->{'Format'} eq 'Attachment' ) {
af59614d 944 %res = $self->VerifyAttachment( %$item );
84fb5b46 945 $status_on = $item->{'Data'};
af59614d
MKG
946 } else {
947 die "Unknown format '".$item->{'Format'} . "' of GnuPG signed part";
84fb5b46 948 }
af59614d 949 } elsif ( $item->{'Type'} eq 'encrypted' ) {
84fb5b46 950 if ( $item->{'Format'} eq 'RFC3156' ) {
af59614d 951 %res = $self->DecryptRFC3156( %$item );
84fb5b46
MKG
952 $status_on = $item->{'Top'};
953 } elsif ( $item->{'Format'} eq 'Inline' ) {
af59614d 954 %res = $self->DecryptInline( %$item );
84fb5b46
MKG
955 $status_on = $item->{'Data'};
956 } elsif ( $item->{'Format'} eq 'Attachment' ) {
af59614d 957 %res = $self->DecryptAttachment( %$item );
84fb5b46 958 $status_on = $item->{'Data'};
af59614d
MKG
959 } else {
960 die "Unknown format '".$item->{'Format'} . "' of GnuPG encrypted part";
84fb5b46 961 }
af59614d
MKG
962 } else {
963 die "Unknown type '".$item->{'Type'} . "' of protected item";
84fb5b46 964 }
af59614d
MKG
965
966 return (%res, status_on => $status_on);
84fb5b46
MKG
967}
968
af59614d 969sub VerifyInline { return (shift)->DecryptInline( @_ ) }
84fb5b46
MKG
970
971sub VerifyAttachment {
af59614d
MKG
972 my $self = shift;
973 my %args = ( Data => undef, Signature => undef, @_ );
84fb5b46
MKG
974
975 foreach ( $args{'Data'}, $args{'Signature'} ) {
976 next unless $_->bodyhandle->is_encoded;
977
978 require RT::EmailParser;
979 RT::EmailParser->_DecodeBody($_);
980 }
981
982 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
983 binmode $tmp_fh, ':raw';
984 $args{'Data'}->bodyhandle->print( $tmp_fh );
985 $tmp_fh->flush;
986
af59614d
MKG
987 my %res = $self->CallGnuPG(
988 Command => "verify",
989 CommandArgs => [ '-', $tmp_fn ],
990 Passphrase => $args{'Passphrase'},
991 Content => $args{'Signature'}->bodyhandle,
992 );
993
994 $args{'Top'}->parts( [
995 grep "$_" ne $args{'Signature'}, $args{'Top'}->parts
996 ] );
997 $args{'Top'}->make_singlepart;
84fb5b46 998
84fb5b46
MKG
999 return %res;
1000}
1001
1002sub VerifyRFC3156 {
af59614d
MKG
1003 my $self = shift;
1004 my %args = ( Data => undef, Signature => undef, @_ );
84fb5b46
MKG
1005
1006 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1007 binmode $tmp_fh, ':raw:eol(CRLF?)';
1008 $args{'Data'}->print( $tmp_fh );
1009 $tmp_fh->flush;
1010
af59614d
MKG
1011 my %res = $self->CallGnuPG(
1012 Command => "verify",
1013 CommandArgs => [ '-', $tmp_fn ],
1014 Passphrase => $args{'Passphrase'},
1015 Content => $args{'Signature'}->bodyhandle,
1016 );
1017
1018 $args{'Top'}->parts( [ $args{'Data'} ] );
1019 $args{'Top'}->make_singlepart;
84fb5b46 1020
84fb5b46
MKG
1021 return %res;
1022}
1023
1024sub DecryptRFC3156 {
af59614d 1025 my $self = shift;
84fb5b46
MKG
1026 my %args = (
1027 Data => undef,
1028 Info => undef,
1029 Top => undef,
1030 Passphrase => undef,
1031 @_
1032 );
1033
84fb5b46
MKG
1034 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1035 require RT::EmailParser;
1036 RT::EmailParser->_DecodeBody($args{'Data'});
1037 }
1038
84fb5b46
MKG
1039 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1040 binmode $tmp_fh, ':raw';
1041
af59614d
MKG
1042 my %res = $self->CallGnuPG(
1043 Command => "decrypt",
1044 Handles => { stdout => $tmp_fh },
1045 Passphrase => $args{'Passphrase'},
1046 Content => $args{'Data'}->bodyhandle,
1047 );
84fb5b46
MKG
1048
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
af59614d
MKG
1052 delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
1053
1054 return %res if $res{message};
84fb5b46
MKG
1055
1056 seek $tmp_fh, 0, 0;
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;
af59614d
MKG
1060
1061 $args{'Top'}->parts( [$decrypted] );
84fb5b46 1062 $args{'Top'}->make_singlepart;
af59614d 1063
84fb5b46
MKG
1064 return %res;
1065}
1066
1067sub DecryptInline {
af59614d 1068 my $self = shift;
84fb5b46
MKG
1069 my %args = (
1070 Data => undef,
1071 Passphrase => undef,
1072 @_
1073 );
1074
84fb5b46
MKG
1075 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1076 require RT::EmailParser;
1077 RT::EmailParser->_DecodeBody($args{'Data'});
1078 }
1079
84fb5b46
MKG
1080 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1081 binmode $tmp_fh, ':raw';
1082
1083 my $io = $args{'Data'}->open('r');
1084 unless ( $io ) {
1085 die "Entity has no body, never should happen";
1086 }
1087
1088 my %res;
1089
1090 my ($had_literal, $in_block) = ('', 0);
1091 my ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1092 binmode $block_fh, ':raw';
1093
1094 while ( defined(my $str = $io->getline) ) {
1095 if ( $in_block && $str =~ /^-----END PGP (?:MESSAGE|SIGNATURE)-----/ ) {
1096 print $block_fh $str;
1097 $in_block--;
1098 next if $in_block > 0;
1099
1100 seek $block_fh, 0, 0;
1101
1102 my ($res_fh, $res_fn);
af59614d 1103 ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
84fb5b46 1104 %args,
84fb5b46
MKG
1105 BlockHandle => $block_fh,
1106 );
1107 return %res unless $res_fh;
1108
1109 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1110 while (my $buf = <$res_fh> ) {
1111 print $tmp_fh $buf;
1112 }
1113 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1114
1115 ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1116 binmode $block_fh, ':raw';
1117 $in_block = 0;
1118 }
1119 elsif ( $str =~ /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) {
1120 $in_block++;
1121 print $block_fh $str;
1122 }
1123 elsif ( $in_block ) {
1124 print $block_fh $str;
1125 }
1126 else {
1127 print $tmp_fh $str;
1128 $had_literal = 1 if /\S/s;
1129 }
1130 }
1131 $io->close;
1132
1133 if ( $in_block ) {
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;
1137
1138 my ($res_fh, $res_fn);
af59614d 1139 ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
84fb5b46 1140 %args,
84fb5b46
MKG
1141 BlockHandle => $block_fh,
1142 );
1143 return %res unless $res_fh;
1144
1145 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1146 while (my $buf = <$res_fh> ) {
1147 print $tmp_fh $buf;
1148 }
1149 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1150 }
1151
1152 seek $tmp_fh, 0, 0;
1153 $args{'Data'}->bodyhandle(MIME::Body::File->new( $tmp_fn ));
1154 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
1155 return %res;
1156}
1157
1158sub _DecryptInlineBlock {
af59614d 1159 my $self = shift;
84fb5b46 1160 my %args = (
84fb5b46
MKG
1161 BlockHandle => undef,
1162 Passphrase => undef,
1163 @_
1164 );
84fb5b46
MKG
1165
1166 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1167 binmode $tmp_fh, ':raw';
1168
af59614d
MKG
1169 my %res = $self->CallGnuPG(
1170 Command => "decrypt",
1171 Handles => { stdout => $tmp_fh, stdin => $args{'BlockHandle'} },
1172 Passphrase => $args{'Passphrase'},
1173 );
84fb5b46
MKG
1174
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
af59614d
MKG
1178 delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
1179
1180 return (undef, undef, %res) if $res{message};
84fb5b46
MKG
1181
1182 seek $tmp_fh, 0, 0;
1183 return ($tmp_fh, $tmp_fn, %res);
1184}
1185
1186sub DecryptAttachment {
af59614d 1187 my $self = shift;
84fb5b46 1188 my %args = (
84fb5b46
MKG
1189 Data => undef,
1190 Passphrase => undef,
1191 @_
1192 );
1193
84fb5b46
MKG
1194 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1195 require RT::EmailParser;
1196 RT::EmailParser->_DecodeBody($args{'Data'});
1197 }
1198
84fb5b46
MKG
1199 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1200 binmode $tmp_fh, ':raw';
1201 $args{'Data'}->bodyhandle->print( $tmp_fh );
1202 seek $tmp_fh, 0, 0;
1203
af59614d 1204 my ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
84fb5b46 1205 %args,
84fb5b46
MKG
1206 BlockHandle => $tmp_fh,
1207 );
1208 return %res unless $res_fh;
1209
1210 $args{'Data'}->bodyhandle(MIME::Body::File->new($res_fn) );
1211 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $res_fh;
1212
1213 my $head = $args{'Data'}->head;
1214
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' );
1219
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));
1224
1225 return %res;
1226}
1227
1228sub DecryptContent {
af59614d 1229 my $self = shift;
84fb5b46
MKG
1230 my %args = (
1231 Content => undef,
1232 Passphrase => undef,
1233 @_
1234 );
1235
84fb5b46
MKG
1236 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1237 binmode $tmp_fh, ':raw';
1238
af59614d
MKG
1239 my %res = $self->CallGnuPG(
1240 Command => "decrypt",
1241 Handles => { stdout => $tmp_fh },
1242 Passphrase => $args{'Passphrase'},
1243 Content => $args{'Content'},
1244 );
84fb5b46
MKG
1245
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
af59614d
MKG
1249 delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
1250
1251 return %res if $res{'message'};
84fb5b46
MKG
1252
1253 ${ $args{'Content'} } = '';
1254 seek $tmp_fh, 0, 0;
1255 while (1) {
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 ) {
1260 last;
1261 }
1262 ${ $args{'Content'} } .= $buf;
1263 }
1264
1265 return %res;
1266}
1267
84fb5b46
MKG
1268my %REASON_CODE_TO_TEXT = (
1269 NODATA => {
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",
1274 },
1275 INV_RECP => {
1276 0 => "No specific reason given",
1277 1 => "Not Found",
1278 2 => "Ambigious specification",
1279 3 => "Wrong key usage",
1280 4 => "Key revoked",
1281 5 => "Key expired",
1282 6 => "No CRL known",
1283 7 => "CRL too old",
1284 8 => "Policy mismatch",
1285 9 => "Not a secret key",
1286 10 => "Key not trusted",
1287 },
1288 ERRSIG => {
1289 0 => 'not specified',
1290 4 => 'unknown algorithm',
1291 9 => 'missing public key',
1292 },
1293);
1294
1295sub ReasonCodeToText {
1296 my $keyword = shift;
1297 my $code = shift;
1298 return $REASON_CODE_TO_TEXT{ $keyword }{ $code }
1299 if exists $REASON_CODE_TO_TEXT{ $keyword }{ $code };
1300 return 'unknown';
1301}
1302
1303my %simple_keyword = (
1304 NO_RECP => {
1305 Operation => 'RecipientsCheck',
1306 Status => 'ERROR',
1307 Message => 'No recipients',
1308 },
1309 UNEXPECTED => {
1310 Operation => 'Data',
1311 Status => 'ERROR',
1312 Message => 'Unexpected data has been encountered',
1313 },
1314 BADARMOR => {
1315 Operation => 'Data',
1316 Status => 'ERROR',
1317 Message => 'The ASCII armor is corrupted',
1318 },
1319);
1320
1321# keywords we parse
1322my %parse_keyword = map { $_ => 1 } qw(
1323 USERID_HINT
1324 SIG_CREATED GOODSIG BADSIG ERRSIG
1325 END_ENCRYPTION
1326 DECRYPTION_FAILED DECRYPTION_OKAY
1327 BAD_PASSPHRASE GOOD_PASSPHRASE
1328 NO_SECKEY NO_PUBKEY
1329 NO_RECP INV_RECP NODATA UNEXPECTED
1330);
1331
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
1334my %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
dab09ea8 1339 DECRYPTION_INFO
84fb5b46
MKG
1340);
1341
1342sub ParseStatus {
af59614d 1343 my $self = shift;
84fb5b46
MKG
1344 my $status = shift;
1345 return () unless $status;
1346
1347 my @status;
1348 while ( $status =~ /\[GNUPG:\]\s*(.*?)(?=\[GNUPG:\]|\z)/igms ) {
1349 push @status, $1; $status[-1] =~ s/\s+/ /g; $status[-1] =~ s/\s+$//;
1350 }
1351 $status = join "\n", @status;
1352 study $status;
1353
1354 my @res;
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;
1362 next;
1363 }
1364 unless ( $parse_keyword{ $keyword } ) {
1365 $RT::Logger->warning("Skipped $keyword") unless $ignore_keyword{ $keyword };
1366 next;
1367 }
1368
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;
1375 }
1376 } else {
1377 $user_hint{ $tmp{'MainKey'} } = \%tmp;
1378 }
1379 next;
1380 }
1381 elsif ( $keyword eq 'BAD_PASSPHRASE' || $keyword eq 'GOOD_PASSPHRASE' ) {
1382 my $key_id = $args;
1383 my %res = (
1384 Operation => 'PassphraseCheck',
1385 Status => $keyword eq 'BAD_PASSPHRASE'? 'BAD' : 'DONE',
1386 Key => $key_id,
1387 );
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);
1393 last;
1394 }
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'};
1399 } else {
1400 $res{'Message'} .= " for '0x$key_id'";
1401 }
1402 push @res, \%res;
1403 }
1404 elsif ( $keyword eq 'END_ENCRYPTION' ) {
1405 my %res = (
1406 Operation => 'Encrypt',
1407 Status => 'DONE',
1408 Message => 'Data has been encrypted',
1409 );
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);
1413 last;
1414 }
1415 push @res, \%res;
1416 }
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');
1423
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);
1427
1428 my %encrypted_to = (
1429 Message => "The message is encrypted to '0x$key'",
1430 User => ( $user_hint{ $key } ||= {} ),
1431 Key => $key,
1432 KeyLength => $key_length,
1433 Algorithm => $alg,
1434 );
1435
1436 push @{ $res{'EncryptedTo'} ||= [] }, \%encrypted_to;
1437 }
1438
1439 push @res, \%res;
1440 }
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';
1444 my %res = (
1445 Operation => 'KeyCheck',
1446 Status => 'MISSING',
1447 Message => ucfirst( $type ) ." key '0x$key' is not available",
1448 Key => $key,
1449 KeyType => $type,
1450 );
1451 $res{'User'} = ( $user_hint{ $key } ||= {} );
1452 $res{'User'}{ ucfirst( $type ). 'KeyMissing' } = 1;
1453 push @res, \%res;
1454 }
1455 # GOODSIG, BADSIG, VALIDSIG, TRUST_*
1456 elsif ( $keyword eq 'GOODSIG' ) {
1457 my %res = (
1458 Operation => 'Verify',
1459 Status => 'DONE',
1460 Message => 'The signature is good',
1461 );
1462 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1463 $res{'Message'} .= ', signed by '. $res{'UserString'};
1464
1465 foreach my $line ( @status[ $i .. $#status ] ) {
1466 next unless $line =~ /^TRUST_(\S+)/;
1467 $res{'Trust'} = $1;
1468 last;
1469 }
1470 $res{'Message'} .= ', trust level is '. lc( $res{'Trust'} || 'unknown');
1471
1472 foreach my $line ( @status[ $i .. $#status ] ) {
1473 next unless $line =~ /^VALIDSIG\s+(.*)/;
1474 @res{ qw(
1475 Fingerprint
1476 CreationDate
1477 Timestamp
1478 ExpireTimestamp
1479 Version
1480 Reserved
1481 PubkeyAlgo
1482 HashAlgo
1483 Class
1484 PKFingerprint
1485 Other
1486 ) } = split /\s+/, $1, 10;
1487 last;
1488 }
1489 push @res, \%res;
1490 }
1491 elsif ( $keyword eq 'BADSIG' ) {
1492 my %res = (
1493 Operation => 'Verify',
1494 Status => 'BAD',
1495 Message => 'The signature has not been verified okay',
1496 );
1497 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1498 push @res, \%res;
1499 }
1500 elsif ( $keyword eq 'ERRSIG' ) {
1501 my %res = (
1502 Operation => 'Verify',
1503 Status => 'ERROR',
1504 Message => 'Not possible to check the signature',
1505 );
1506 @res{qw(Key PubkeyAlgo HashAlgo Class Timestamp ReasonCode Other)}
1507 = split /\s+/, $args, 7;
1508
1509 $res{'Reason'} = ReasonCodeToText( $keyword, $res{'ReasonCode'} );
1510 $res{'Message'} .= ", the reason is ". $res{'Reason'};
1511
1512 push @res, \%res;
1513 }
1514 elsif ( $keyword eq 'SIG_CREATED' ) {
1515 # SIG_CREATED <type> <pubkey algo> <hash algo> <class> <timestamp> <key fpr>
1516 my @props = split /\s+/, $args;
1517 push @res, {
1518 Operation => 'Sign',
1519 Status => 'DONE',
1520 Message => "Signed message",
1521 Type => $props[0],
1522 PubKeyAlgo => $props[1],
1523 HashKeyAlgo => $props[2],
1524 Class => $props[3],
1525 Timestamp => $props[4],
1526 KeyFingerprint => $props[5],
1527 User => $user_hint{ $latest_user_main_key },
1528 };
1529 $res[-1]->{Message} .= ' by '. $user_hint{ $latest_user_main_key }->{'EmailAddress'}
1530 if $user_hint{ $latest_user_main_key };
1531 }
1532 elsif ( $keyword eq 'INV_RECP' ) {
1533 my ($rcode, $recipient) = split /\s+/, $args, 2;
1534 my $reason = ReasonCodeToText( $keyword, $rcode );
1535 push @res, {
1536 Operation => 'RecipientsCheck',
1537 Status => 'ERROR',
1538 Message => "Recipient '$recipient' is unusable, the reason is '$reason'",
1539 Recipient => $recipient,
1540 ReasonCode => $rcode,
1541 Reason => $reason,
1542 };
1543 }
1544 elsif ( $keyword eq 'NODATA' ) {
1545 my $rcode = (split /\s+/, $args)[0];
1546 my $reason = ReasonCodeToText( $keyword, $rcode );
1547 push @res, {
1548 Operation => 'Data',
1549 Status => 'ERROR',
1550 Message => "No data has been found. The reason is '$reason'",
1551 ReasonCode => $rcode,
1552 Reason => $reason,
1553 };
1554 }
1555 else {
1556 $RT::Logger->warning("Keyword $keyword is unknown");
1557 next;
1558 }
1559 $res[-1]{'Keyword'} = $keyword if @res && !$res[-1]{'Keyword'};
1560 }
1561 return @res;
1562}
1563
1564sub _ParseUserHint {
1565 my ($status, $hint) = (@_);
1566 my ($main_key_id, $user_str) = ($hint =~ /^USERID_HINT\s+(\S+)\s+(.*)$/);
1567 return () unless $main_key_id;
1568 return (
1569 MainKey => $main_key_id,
1570 String => $user_str,
1571 EmailAddress => (map $_->address, Email::Address->parse( $user_str ))[0],
1572 );
1573}
1574
1575sub _PrepareGnuPGOptions {
1576 my %opt = @_;
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 };
1583 }
1584 return %res;
1585}
1586
84fb5b46 1587sub GetKeysForEncryption {
af59614d
MKG
1588 my $self = shift;
1589 my %args = (Recipient => undef, @_);
1590 my %res = $self->GetKeysInfo( Key => delete $args{'Recipient'}, %args, Type => 'public' );
84fb5b46
MKG
1591 return %res if $res{'exit_code'};
1592 return %res unless $res{'info'};
1593
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;
af59614d 1599 # skip disabled, expired, revoked and keys with no trust,
84fb5b46
MKG
1600 # but leave keys with unknown trust level
1601 next if $key->{'TrustLevel'} < 0;
1602
1603 push @{ $res{'info'} }, $key;
1604 }
1605 delete $res{'info'} unless @{ $res{'info'} };
1606 return %res;
1607}
1608
1609sub GetKeysForSigning {
af59614d
MKG
1610 my $self = shift;
1611 my %args = (Signer => undef, @_);
1612 return $self->GetKeysInfo( Key => delete $args{'Signer'}, %args, Type => 'private' );
84fb5b46
MKG
1613}
1614
1615sub GetKeysInfo {
af59614d
MKG
1616 my $self = shift;
1617 my %args = (
1618 Key => undef,
1619 Type => 'public',
1620 Force => 0,
1621 @_
1622 );
84fb5b46 1623
af59614d
MKG
1624 my $email = $args{'Key'};
1625 my $type = $args{'Type'};
84fb5b46 1626 unless ( $email ) {
af59614d
MKG
1627 return (exit_code => 0) unless $args{'Force'};
1628 }
1629
1630 my @info;
1631 my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
1632 my %res = $self->CallGnuPG(
1633 Options => {
1634 'with-colons' => undef, # parseable format
1635 'fingerprint' => undef, # show fingerprint
1636 'fixed-list-mode' => undef, # don't merge uid with keys
1637 },
1638 Command => $method,
1639 ( $email ? (CommandArgs => ['--', $email]) : () ),
1640 Output => \@info,
84fb5b46
MKG
1641 );
1642
af59614d
MKG
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};
84fb5b46
MKG
1647 }
1648
af59614d
MKG
1649 return %res if $res{'message'};
1650
1651 @info = $self->ParseKeysInfo( @info );
84fb5b46
MKG
1652 $res{'info'} = \@info;
1653 return %res;
1654}
1655
1656sub ParseKeysInfo {
af59614d 1657 my $self = shift;
84fb5b46
MKG
1658 my @lines = @_;
1659
1660 my %gpg_opt = RT->Config->Get('GnuPGOptions');
1661
1662 my @res = ();
1663 foreach my $line( @lines ) {
1664 chomp $line;
1665 my $tag;
1666 ($tag, $line) = split /:/, $line, 2;
1667 if ( $tag eq 'pub' ) {
1668 my %info;
1669 @info{ qw(
1670 TrustChar KeyLength Algorithm Key
1671 Created Expire Empty OwnerTrustChar
1672 Empty Empty Capabilities Other
1673 ) } = split /:/, $line, 12;
1674
1675 # workaround gnupg's wierd behaviour, --list-keys command report calculated trust levels
1676 # for any model except 'always', so you can change models and see changes, but not for 'always'
1677 # we try to handle it in a simple way - we set ultimate trust for any key with trust
1678 # level >= 0 if trust model is 'always'
1679 my $always_trust;
1680 $always_trust = 1 if exists $gpg_opt{'always-trust'};
1681 $always_trust = 1 if exists $gpg_opt{'trust-model'} && $gpg_opt{'trust-model'} eq 'always';
1682 @info{qw(Trust TrustTerse TrustLevel)} =
1683 _ConvertTrustChar( $info{'TrustChar'} );
1684 if ( $always_trust && $info{'TrustLevel'} >= 0 ) {
1685 @info{qw(Trust TrustTerse TrustLevel)} =
1686 _ConvertTrustChar( 'u' );
1687 }
1688
1689 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
1690 _ConvertTrustChar( $info{'OwnerTrustChar'} );
af59614d 1691 $info{ $_ } = $self->ParseDate( $info{ $_ } )
84fb5b46
MKG
1692 foreach qw(Created Expire);
1693 push @res, \%info;
1694 }
1695 elsif ( $tag eq 'sec' ) {
1696 my %info;
1697 @info{ qw(
1698 Empty KeyLength Algorithm Key
1699 Created Expire Empty OwnerTrustChar
1700 Empty Empty Capabilities Other
1701 ) } = split /:/, $line, 12;
1702 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
1703 _ConvertTrustChar( $info{'OwnerTrustChar'} );
af59614d 1704 $info{ $_ } = $self->ParseDate( $info{ $_ } )
84fb5b46
MKG
1705 foreach qw(Created Expire);
1706 push @res, \%info;
1707 }
1708 elsif ( $tag eq 'uid' ) {
1709 my %info;
1710 @info{ qw(Trust Created Expire String) }
1711 = (split /:/, $line)[0,4,5,8];
af59614d 1712 $info{ $_ } = $self->ParseDate( $info{ $_ } )
84fb5b46
MKG
1713 foreach qw(Created Expire);
1714 push @{ $res[-1]{'User'} ||= [] }, \%info;
1715 }
1716 elsif ( $tag eq 'fpr' ) {
1717 $res[-1]{'Fingerprint'} = (split /:/, $line, 10)[8];
1718 }
1719 }
1720 return @res;
1721}
1722
1723{
1724 my %verbose = (
1725 # deprecated
1726 d => [
1727 "The key has been disabled", #loc
1728 "key disabled", #loc
1729 "-2"
1730 ],
1731
1732 r => [
1733 "The key has been revoked", #loc
1734 "key revoked", #loc
1735 -3,
1736 ],
1737
1738 e => [ "The key has expired", #loc
1739 "key expired", #loc
1740 '-4',
1741 ],
1742
1743 n => [ "Don't trust this key at all", #loc
1744 'none', #loc
1745 -1,
1746 ],
1747
1748 #gpupg docs says that '-' and 'q' may safely be treated as the same value
1749 '-' => [
1750 'Unknown (no trust value assigned)', #loc
1751 'not set',
1752 0,
1753 ],
1754 q => [
1755 'Unknown (no trust value assigned)', #loc
1756 'not set',
1757 0,
1758 ],
1759 o => [
1760 'Unknown (this value is new to the system)', #loc
1761 'unknown',
1762 0,
1763 ],
1764
1765 m => [
1766 "There is marginal trust in this key", #loc
1767 'marginal', #loc
1768 1,
1769 ],
1770 f => [
1771 "The key is fully trusted", #loc
1772 'full', #loc
1773 2,
1774 ],
1775 u => [
1776 "The key is ultimately trusted", #loc
1777 'ultimate', #loc
1778 3,
1779 ],
1780 );
1781
1782 sub _ConvertTrustChar {
1783 my $value = shift;
1784 return @{ $verbose{'-'} } unless $value;
1785 $value = substr $value, 0, 1;
1786 return @{ $verbose{ $value } || $verbose{'o'} };
1787 }
1788}
1789
84fb5b46 1790sub DeleteKey {
af59614d 1791 my $self = shift;
84fb5b46
MKG
1792 my $key = shift;
1793
af59614d
MKG
1794 return $self->CallGnuPG(
1795 Command => "--delete-secret-and-public-key",
1796 CommandArgs => ["--", $key],
1797 Callback => sub {
1798 my %handle = @_;
1799 while ( my $str = readline $handle{'status'} ) {
1800 if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) {
1801 print { $handle{'command'} } "y\n";
1802 }
84fb5b46 1803 }
af59614d
MKG
1804 },
1805 );
84fb5b46
MKG
1806}
1807
1808sub ImportKey {
af59614d 1809 my $self = shift;
84fb5b46
MKG
1810 my $key = shift;
1811
af59614d
MKG
1812 return $self->CallGnuPG(
1813 Command => "import_keys",
1814 Content => $key,
84fb5b46 1815 );
84fb5b46
MKG
1816}
1817
af59614d
MKG
1818sub GnuPGPath {
1819 state $cache = RT->Config->Get('GnuPG')->{'GnuPG'};
1820 $cache = $_[1] if @_ > 1;
1821 return $cache;
84fb5b46
MKG
1822}
1823
af59614d
MKG
1824sub Probe {
1825 my $self = shift;
1826 my $gnupg = GnuPG::Interface->new;
1827
1828 my $bin = $self->GnuPGPath();
1829 unless ($bin) {
1830 $RT::Logger->warning(
1831 "No gpg path set; GnuPG support has been disabled. ".
1832 "Check the 'GnuPG' configuration in %GnuPG");
1833 return 0;
1834 }
84fb5b46 1835
af59614d
MKG
1836 if ($bin =~ m{^/}) {
1837 unless (-f $bin and -x _) {
1838 $RT::Logger->warning(
1839 "Invalid gpg path $bin; GnuPG support has been disabled. ".
1840 "Check the 'GnuPG' configuration in %GnuPG");
1841 return 0;
1842 }
1843 } else {
320f0092
MKG
1844 local $ENV{PATH} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin'
1845 unless defined $ENV{PATH};
af59614d
MKG
1846 my $path = File::Which::which( $bin );
1847 unless ($path) {
1848 $RT::Logger->warning(
320f0092
MKG
1849 "Can't find gpg binary '$bin' in PATH ($ENV{PATH}); GnuPG support has been disabled. ".
1850 "You may need to specify a full path to gpg via the 'GnuPG' configuration in %GnuPG");
af59614d
MKG
1851 return 0;
1852 }
1853 $self->GnuPGPath( $bin = $path );
1854 }
84fb5b46 1855
af59614d 1856 $gnupg->call( $bin );
84fb5b46 1857 $gnupg->options->hash_init(
af59614d 1858 _PrepareGnuPGOptions( RT->Config->Get('GnuPGOptions') )
84fb5b46 1859 );
af59614d 1860 $gnupg->options->meta_interactive( 0 );
84fb5b46
MKG
1861
1862 my ($handles, $handle_list) = _make_gpg_handles();
1863 my %handle = %$handle_list;
1864
af59614d 1865 local $@ = undef;
84fb5b46
MKG
1866 eval {
1867 local $SIG{'CHLD'} = 'DEFAULT';
af59614d
MKG
1868 my $pid = safe_run_child {
1869 $gnupg->wrap_call(
1870 commands => ['--version' ],
1871 handles => $handles
1872 )
1873 };
1874 close $handle{'stdin'} or die "Can't close gnupg input handle: $!";
84fb5b46
MKG
1875 waitpid $pid, 0;
1876 };
1877 if ( $@ ) {
af59614d
MKG
1878 $RT::Logger->warning(
1879 "RT's GnuPG libraries couldn't successfully execute gpg.".
1880 " GnuPG support has been disabled");
84fb5b46
MKG
1881 $RT::Logger->debug(
1882 "Probe for GPG failed."
1883 ." Couldn't run `gpg --version`: ". $@
1884 );
1885 return 0;
1886 }
1887
1888# on some systems gpg exits with code 2, but still 100% functional,
1889# it's general error system error or incorrect command, command is correct,
1890# but there is no way to get actuall error
1891 if ( $? && ($? >> 8) != 2 ) {
1892 my $msg = "Probe for GPG failed."
af59614d 1893 ." Process exited with code ". ($? >> 8)
84fb5b46
MKG
1894 . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '')
1895 . ".";
1896 foreach ( qw(stderr logger status) ) {
af59614d 1897 my $tmp = do { local $/ = undef; readline $handle{$_} };
84fb5b46 1898 next unless $tmp && $tmp =~ /\S/s;
af59614d 1899 close $handle{$_} or $tmp .= "\nFailed to close: $!";
84fb5b46
MKG
1900 $msg .= "\n$_:\n$tmp\n";
1901 }
af59614d
MKG
1902 $RT::Logger->warning(
1903 "RT's GnuPG libraries couldn't successfully execute gpg.".
1904 " GnuPG support has been disabled");
84fb5b46
MKG
1905 $RT::Logger->debug( $msg );
1906 return 0;
1907 }
1908 return 1;
1909}
1910
1911
1912sub _make_gpg_handles {
1913 my %handle_map = (@_);
1914 $handle_map{$_} = IO::Handle->new
1915 foreach grep !defined $handle_map{$_},
1916 qw(stdin stdout stderr logger status command);
1917
1918 my $handles = GnuPG::Handles->new(%handle_map);
1919 return ($handles, \%handle_map);
1920}
1921
1922RT::Base->_ImportOverlays();
1923
84fb5b46 19241;