Putting 4.2.0 on top of 4.0.17
[usit-rt.git] / lib / RT / Crypt / GnuPG.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
403d7b0b 5# This software is Copyright (c) 1996-2013 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,
84fb5b46
MKG
497 map Email::Address->parse( $entity->head->get( $_ ) ),
498 qw(To Cc Bcc);
499
500 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
501 binmode $tmp_fh, ':raw';
502
af59614d
MKG
503 $entity->make_multipart( 'mixed', Force => 1 );
504 %res = $self->CallGnuPG(
505 Signer => $args{'Signer'},
506 Recipients => \@recipients,
507 Command => ( $args{'Sign'} ? "sign_and_encrypt" : "encrypt" ),
508 Handles => { stdout => $tmp_fh },
509 Passphrase => $args{'Passphrase'},
510 Content => $entity->parts(0),
511 );
512 return %res if $res{message};
84fb5b46
MKG
513
514 my $protocol = 'application/pgp-encrypted';
515 $entity->parts([]);
516 $entity->head->mime_attr( 'Content-Type' => 'multipart/encrypted' );
517 $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
518 $entity->attach(
519 Type => $protocol,
520 Disposition => 'inline',
521 Data => ['Version: 1',''],
522 Encoding => '7bit',
523 );
524 $entity->attach(
525 Type => 'application/octet-stream',
526 Disposition => 'inline',
527 Path => $tmp_fn,
528 Filename => '',
529 Encoding => '7bit',
530 );
531 $entity->parts(-1)->bodyhandle->{'_dirty_hack_to_save_a_ref_tmp_fh'} = $tmp_fh;
532 }
533 return %res;
534}
535
536sub SignEncryptInline {
af59614d 537 my $self = shift;
84fb5b46
MKG
538 my %args = ( @_ );
539
540 my $entity = $args{'Entity'};
541
542 my %res;
543 $entity->make_singlepart;
544 if ( $entity->is_multipart ) {
545 foreach ( $entity->parts ) {
af59614d 546 %res = $self->SignEncryptInline( @_, Entity => $_ );
84fb5b46
MKG
547 return %res if $res{'exit_code'};
548 }
549 return %res;
550 }
551
af59614d 552 return $self->_SignEncryptTextInline( @_ )
84fb5b46
MKG
553 if $entity->effective_type =~ /^text\//i;
554
af59614d 555 return $self->_SignEncryptAttachmentInline( @_ );
84fb5b46
MKG
556}
557
558sub _SignEncryptTextInline {
af59614d 559 my $self = shift;
84fb5b46
MKG
560 my %args = (
561 Entity => undef,
562
563 Sign => 1,
564 Signer => undef,
565 Passphrase => undef,
566
567 Encrypt => 1,
568 Recipients => undef,
569
570 @_
571 );
572 return unless $args{'Sign'} || $args{'Encrypt'};
573
84fb5b46
MKG
574 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
575 binmode $tmp_fh, ':raw';
576
84fb5b46 577 my $entity = $args{'Entity'};
af59614d
MKG
578 my %res = $self->CallGnuPG(
579 Signer => $args{'Signer'},
580 Recipients => $args{'Recipients'},
581 Command => ( $args{'Sign'} && $args{'Encrypt'}
582 ? 'sign_and_encrypt'
583 : ( $args{'Sign'}
584 ? 'clearsign'
585 : 'encrypt' ) ),
586 Handles => { stdout => $tmp_fh },
587 Passphrase => $args{'Passphrase'},
588 Content => $entity->bodyhandle,
589 );
590 return %res if $res{message};
84fb5b46
MKG
591
592 $entity->bodyhandle( MIME::Body::File->new( $tmp_fn) );
593 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
594
595 return %res;
596}
597
598sub _SignEncryptAttachmentInline {
af59614d 599 my $self = shift;
84fb5b46
MKG
600 my %args = (
601 Entity => undef,
602
603 Sign => 1,
604 Signer => undef,
605 Passphrase => undef,
606
607 Encrypt => 1,
608 Recipients => undef,
609
610 @_
611 );
612 return unless $args{'Sign'} || $args{'Encrypt'};
613
84fb5b46
MKG
614
615 my $entity = $args{'Entity'};
84fb5b46
MKG
616
617 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
618 binmode $tmp_fh, ':raw';
619
af59614d
MKG
620 my %res = $self->CallGnuPG(
621 Signer => $args{'Signer'},
622 Recipients => $args{'Recipients'},
623 Command => ( $args{'Sign'} && $args{'Encrypt'}
624 ? 'sign_and_encrypt'
625 : ( $args{'Sign'}
626 ? 'detach_sign'
627 : 'encrypt' ) ),
628 Handles => { stdout => $tmp_fh },
629 Passphrase => $args{'Passphrase'},
630 Content => $entity->bodyhandle,
631 );
632 return %res if $res{message};
84fb5b46
MKG
633
634 my $filename = mime_recommended_filename( $entity ) || 'no_name';
635 if ( $args{'Sign'} && !$args{'Encrypt'} ) {
636 $entity->make_multipart;
637 $entity->attach(
638 Type => 'application/octet-stream',
639 Path => $tmp_fn,
640 Filename => "$filename.sig",
641 Disposition => 'attachment',
642 );
643 } else {
644 $entity->bodyhandle(MIME::Body::File->new( $tmp_fn) );
645 $entity->effective_type('application/octet-stream');
646 $entity->head->mime_attr( $_ => "$filename.pgp" )
647 foreach (qw(Content-Type.name Content-Disposition.filename));
648
649 }
650 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
651
652 return %res;
653}
654
655sub SignEncryptContent {
af59614d 656 my $self = shift;
84fb5b46
MKG
657 my %args = (
658 Content => undef,
659
660 Sign => 1,
661 Signer => undef,
662 Passphrase => undef,
663
664 Encrypt => 1,
665 Recipients => undef,
666
667 @_
668 );
669 return unless $args{'Sign'} || $args{'Encrypt'};
670
84fb5b46
MKG
671 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
672 binmode $tmp_fh, ':raw';
673
af59614d
MKG
674 my %res = $self->CallGnuPG(
675 Signer => $args{'Signer'},
676 Recipients => $args{'Recipients'},
677 Command => ( $args{'Sign'} && $args{'Encrypt'}
678 ? 'sign_and_encrypt'
679 : ( $args{'Sign'}
680 ? 'clearsign'
681 : 'encrypt' ) ),
682 Handles => { stdout => $tmp_fh },
683 Passphrase => $args{'Passphrase'},
684 Content => $args{'Content'},
685 );
686 return %res if $res{message};
84fb5b46
MKG
687
688 ${ $args{'Content'} } = '';
689 seek $tmp_fh, 0, 0;
690 while (1) {
691 my $status = read $tmp_fh, my $buf, 4*1024;
692 unless ( defined $status ) {
693 $RT::Logger->crit( "couldn't read message: $!" );
694 } elsif ( !$status ) {
695 last;
696 }
697 ${ $args{'Content'} } .= $buf;
698 }
699
700 return %res;
701}
702
af59614d
MKG
703sub CheckIfProtected {
704 my $self = shift;
705 my %args = ( Entity => undef, @_ );
84fb5b46 706
af59614d 707 my $entity = $args{'Entity'};
84fb5b46 708
af59614d
MKG
709 # we check inline PGP block later in another sub
710 return () unless $entity->is_multipart;
dab09ea8 711
af59614d
MKG
712 # RFC3156, multipart/{signed,encrypted}
713 my $type = $entity->effective_type;
714 return () unless $type =~ /^multipart\/(?:encrypted|signed)$/;
dab09ea8 715
af59614d
MKG
716 unless ( $entity->parts == 2 ) {
717 $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
84fb5b46
MKG
718 return ();
719 }
720
af59614d
MKG
721 my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
722 unless ( $protocol ) {
723 # if protocol is not set then we can check second part for PGP message
724 $RT::Logger->error( "Entity is '$type', but has no protocol defined. Checking for PGP part" );
725 my $protected = $self->_CheckIfProtectedInline( $entity->parts(1), 1 );
726 return () unless $protected;
84fb5b46 727
af59614d
MKG
728 if ( $protected eq 'signature' ) {
729 $RT::Logger->debug("Found part signed according to RFC3156");
730 return (
84fb5b46
MKG
731 Type => 'signed',
732 Format => 'RFC3156',
af59614d
MKG
733 Top => $entity,
734 Data => $entity->parts(0),
84fb5b46 735 Signature => $entity->parts(1),
af59614d
MKG
736 );
737 } else {
738 $RT::Logger->debug("Found part encrypted according to RFC3156");
739 return (
740 Type => 'encrypted',
741 Format => 'RFC3156',
742 Top => $entity,
743 Data => $entity->parts(1),
744 Info => $entity->parts(0),
745 );
746 }
747 }
748 elsif ( $type eq 'multipart/encrypted' ) {
749 unless ( $protocol eq 'application/pgp-encrypted' ) {
750 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" );
751 return ();
752 }
753 $RT::Logger->debug("Found part encrypted according to RFC3156");
754 return (
755 Type => 'encrypted',
756 Format => 'RFC3156',
757 Top => $entity,
758 Data => $entity->parts(1),
759 Info => $entity->parts(0),
760 );
761 } else {
762 unless ( $protocol eq 'application/pgp-signature' ) {
763 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
764 return ();
84fb5b46 765 }
af59614d
MKG
766 $RT::Logger->debug("Found part signed according to RFC3156");
767 return (
768 Type => 'signed',
769 Format => 'RFC3156',
770 Top => $entity,
771 Data => $entity->parts(0),
772 Signature => $entity->parts(1),
773 );
84fb5b46 774 }
af59614d
MKG
775 return ();
776}
777
778
779sub FindScatteredParts {
780 my $self = shift;
781 my %args = ( Parts => [], Skip => {}, @_ );
782
783 my @res;
784
785 my @parts = @{ $args{'Parts'} };
84fb5b46
MKG
786
787 # attachments signed with signature in another part
af59614d
MKG
788 {
789 my @file_indices;
790 for (my $i = 0; $i < @parts; $i++ ) {
791 my $part = $parts[ $i ];
84fb5b46 792
af59614d
MKG
793 # we can not associate a signature within an attachment
794 # without file names
795 my $fname = $part->head->recommended_filename;
796 next unless $fname;
84fb5b46 797
af59614d
MKG
798 my $type = $part->effective_type;
799
800 if ( $type eq 'application/pgp-signature' ) {
801 push @file_indices, $i;
802 }
803 elsif ( $type eq 'application/octet-stream' && $fname =~ /\.sig$/i ) {
804 push @file_indices, $i;
805 }
84fb5b46 806 }
af59614d
MKG
807
808 foreach my $i ( @file_indices ) {
809 my $sig_part = $parts[ $i ];
810 my $sig_name = $sig_part->head->recommended_filename;
811 my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/;
812
813 my ($data_part_idx) =
814 grep $file_name eq ($parts[$_]->head->recommended_filename||''),
815 grep $sig_part ne $parts[$_],
816 0 .. @parts - 1;
817 unless ( defined $data_part_idx ) {
818 $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
819 next;
820 }
821
822 my $data_part_in = $parts[ $data_part_idx ];
823
824 $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
825
826 $args{'Skip'}{$data_part_in} = 1;
827 $args{'Skip'}{$sig_part} = 1;
828 push @res, {
829 Type => 'signed',
830 Format => 'Attachment',
831 Top => $args{'Parents'}{$sig_part},
832 Data => $data_part_in,
833 Signature => $sig_part,
834 };
84fb5b46
MKG
835 }
836 }
837
af59614d
MKG
838 # attachments with inline encryption
839 foreach my $part ( @parts ) {
840 next if $args{'Skip'}{$part};
841
842 my $fname = $part->head->recommended_filename || '';
843 next unless $fname =~ /\.${RE_FILE_EXTENSIONS}$/;
84fb5b46 844
af59614d
MKG
845 $RT::Logger->debug("Found encrypted attachment '$fname'");
846
847 $args{'Skip'}{$part} = 1;
84fb5b46 848 push @res, {
af59614d
MKG
849 Type => 'encrypted',
850 Format => 'Attachment',
851 Data => $part,
84fb5b46
MKG
852 };
853 }
854
af59614d
MKG
855 # inline PGP block
856 foreach my $part ( @parts ) {
857 next if $args{'Skip'}{$part};
858
859 my $type = $self->_CheckIfProtectedInline( $part );
860 next unless $type;
861
862 my $file = ($part->head->recommended_filename||'') =~ /\.${RE_FILE_EXTENSIONS}$/;
863
864 $args{'Skip'}{$part} = 1;
84fb5b46 865 push @res, {
af59614d
MKG
866 Type => $type,
867 Format => !$file || $type eq 'signed'? 'Inline' : 'Attachment',
868 Data => $part,
84fb5b46
MKG
869 };
870 }
871
84fb5b46
MKG
872 return @res;
873}
874
af59614d
MKG
875sub _CheckIfProtectedInline {
876 my $self = shift;
877 my $entity = shift;
878 my $check_for_signature = shift || 0;
84fb5b46 879
af59614d
MKG
880 my $io = $entity->open('r');
881 unless ( $io ) {
882 $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
883 return '';
884 }
885
886 # Deal with "partitioned" PGP mail, which (contrary to common
887 # sense) unnecessarily applies a base64 transfer encoding to PGP
888 # mail (whose content is already base64-encoded).
889 if ( $entity->bodyhandle->is_encoded and $entity->head->mime_encoding ) {
890 my $decoder = MIME::Decoder->new( $entity->head->mime_encoding );
891 if ($decoder) {
892 local $@;
893 eval {
894 my $buf = '';
895 open my $fh, '>', \$buf
896 or die "Couldn't open scalar for writing: $!";
897 binmode $fh, ":raw";
898 $decoder->decode($io, $fh);
899 close $fh or die "Couldn't close scalar: $!";
900
901 open $fh, '<', \$buf
902 or die "Couldn't re-open scalar for reading: $!";
903 binmode $fh, ":raw";
904 $io = $fh;
905 1;
906 } or do {
907 $RT::Logger->error("Couldn't decode body: $@");
908 }
909 }
910 }
911
912 while ( defined($_ = $io->getline) ) {
913 if ( /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) {
914 return $1? 'signed': 'encrypted';
915 }
916 elsif ( $check_for_signature && !/^-----BEGIN PGP SIGNATURE-----/ ) {
917 return 'signature';
918 }
919 }
920 $io->close;
921 return '';
922}
84fb5b46
MKG
923
924sub VerifyDecrypt {
af59614d 925 my $self = shift;
84fb5b46 926 my %args = (
af59614d 927 Info => undef,
84fb5b46
MKG
928 @_
929 );
af59614d
MKG
930
931 my %res;
932
933 my $item = $args{'Info'};
934 my $status_on;
935 if ( $item->{'Type'} eq 'signed' ) {
84fb5b46 936 if ( $item->{'Format'} eq 'RFC3156' ) {
af59614d 937 %res = $self->VerifyRFC3156( %$item );
84fb5b46
MKG
938 $status_on = $item->{'Top'};
939 } elsif ( $item->{'Format'} eq 'Inline' ) {
af59614d 940 %res = $self->VerifyInline( %$item );
84fb5b46
MKG
941 $status_on = $item->{'Data'};
942 } elsif ( $item->{'Format'} eq 'Attachment' ) {
af59614d 943 %res = $self->VerifyAttachment( %$item );
84fb5b46 944 $status_on = $item->{'Data'};
af59614d
MKG
945 } else {
946 die "Unknown format '".$item->{'Format'} . "' of GnuPG signed part";
84fb5b46 947 }
af59614d 948 } elsif ( $item->{'Type'} eq 'encrypted' ) {
84fb5b46 949 if ( $item->{'Format'} eq 'RFC3156' ) {
af59614d 950 %res = $self->DecryptRFC3156( %$item );
84fb5b46
MKG
951 $status_on = $item->{'Top'};
952 } elsif ( $item->{'Format'} eq 'Inline' ) {
af59614d 953 %res = $self->DecryptInline( %$item );
84fb5b46
MKG
954 $status_on = $item->{'Data'};
955 } elsif ( $item->{'Format'} eq 'Attachment' ) {
af59614d 956 %res = $self->DecryptAttachment( %$item );
84fb5b46 957 $status_on = $item->{'Data'};
af59614d
MKG
958 } else {
959 die "Unknown format '".$item->{'Format'} . "' of GnuPG encrypted part";
84fb5b46 960 }
af59614d
MKG
961 } else {
962 die "Unknown type '".$item->{'Type'} . "' of protected item";
84fb5b46 963 }
af59614d
MKG
964
965 return (%res, status_on => $status_on);
84fb5b46
MKG
966}
967
af59614d 968sub VerifyInline { return (shift)->DecryptInline( @_ ) }
84fb5b46
MKG
969
970sub VerifyAttachment {
af59614d
MKG
971 my $self = shift;
972 my %args = ( Data => undef, Signature => undef, @_ );
84fb5b46
MKG
973
974 foreach ( $args{'Data'}, $args{'Signature'} ) {
975 next unless $_->bodyhandle->is_encoded;
976
977 require RT::EmailParser;
978 RT::EmailParser->_DecodeBody($_);
979 }
980
981 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
982 binmode $tmp_fh, ':raw';
983 $args{'Data'}->bodyhandle->print( $tmp_fh );
984 $tmp_fh->flush;
985
af59614d
MKG
986 my %res = $self->CallGnuPG(
987 Command => "verify",
988 CommandArgs => [ '-', $tmp_fn ],
989 Passphrase => $args{'Passphrase'},
990 Content => $args{'Signature'}->bodyhandle,
991 );
992
993 $args{'Top'}->parts( [
994 grep "$_" ne $args{'Signature'}, $args{'Top'}->parts
995 ] );
996 $args{'Top'}->make_singlepart;
84fb5b46 997
84fb5b46
MKG
998 return %res;
999}
1000
1001sub VerifyRFC3156 {
af59614d
MKG
1002 my $self = shift;
1003 my %args = ( Data => undef, Signature => undef, @_ );
84fb5b46
MKG
1004
1005 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1006 binmode $tmp_fh, ':raw:eol(CRLF?)';
1007 $args{'Data'}->print( $tmp_fh );
1008 $tmp_fh->flush;
1009
af59614d
MKG
1010 my %res = $self->CallGnuPG(
1011 Command => "verify",
1012 CommandArgs => [ '-', $tmp_fn ],
1013 Passphrase => $args{'Passphrase'},
1014 Content => $args{'Signature'}->bodyhandle,
1015 );
1016
1017 $args{'Top'}->parts( [ $args{'Data'} ] );
1018 $args{'Top'}->make_singlepart;
84fb5b46 1019
84fb5b46
MKG
1020 return %res;
1021}
1022
1023sub DecryptRFC3156 {
af59614d 1024 my $self = shift;
84fb5b46
MKG
1025 my %args = (
1026 Data => undef,
1027 Info => undef,
1028 Top => undef,
1029 Passphrase => undef,
1030 @_
1031 );
1032
84fb5b46
MKG
1033 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1034 require RT::EmailParser;
1035 RT::EmailParser->_DecodeBody($args{'Data'});
1036 }
1037
84fb5b46
MKG
1038 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1039 binmode $tmp_fh, ':raw';
1040
af59614d
MKG
1041 my %res = $self->CallGnuPG(
1042 Command => "decrypt",
1043 Handles => { stdout => $tmp_fh },
1044 Passphrase => $args{'Passphrase'},
1045 Content => $args{'Data'}->bodyhandle,
1046 );
84fb5b46
MKG
1047
1048 # if the decryption is fine but the signature is bad, then without this
1049 # status check we lose the decrypted text
1050 # XXX: add argument to the function to control this check
af59614d
MKG
1051 delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
1052
1053 return %res if $res{message};
84fb5b46
MKG
1054
1055 seek $tmp_fh, 0, 0;
1056 my $parser = RT::EmailParser->new();
1057 my $decrypted = $parser->ParseMIMEEntityFromFileHandle( $tmp_fh, 0 );
1058 $decrypted->{'__store_link_to_object_to_avoid_early_cleanup'} = $parser;
af59614d
MKG
1059
1060 $args{'Top'}->parts( [$decrypted] );
84fb5b46 1061 $args{'Top'}->make_singlepart;
af59614d 1062
84fb5b46
MKG
1063 return %res;
1064}
1065
1066sub DecryptInline {
af59614d 1067 my $self = shift;
84fb5b46
MKG
1068 my %args = (
1069 Data => undef,
1070 Passphrase => undef,
1071 @_
1072 );
1073
84fb5b46
MKG
1074 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1075 require RT::EmailParser;
1076 RT::EmailParser->_DecodeBody($args{'Data'});
1077 }
1078
84fb5b46
MKG
1079 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1080 binmode $tmp_fh, ':raw';
1081
1082 my $io = $args{'Data'}->open('r');
1083 unless ( $io ) {
1084 die "Entity has no body, never should happen";
1085 }
1086
1087 my %res;
1088
1089 my ($had_literal, $in_block) = ('', 0);
1090 my ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1091 binmode $block_fh, ':raw';
1092
1093 while ( defined(my $str = $io->getline) ) {
1094 if ( $in_block && $str =~ /^-----END PGP (?:MESSAGE|SIGNATURE)-----/ ) {
1095 print $block_fh $str;
1096 $in_block--;
1097 next if $in_block > 0;
1098
1099 seek $block_fh, 0, 0;
1100
1101 my ($res_fh, $res_fn);
af59614d 1102 ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
84fb5b46 1103 %args,
84fb5b46
MKG
1104 BlockHandle => $block_fh,
1105 );
1106 return %res unless $res_fh;
1107
1108 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1109 while (my $buf = <$res_fh> ) {
1110 print $tmp_fh $buf;
1111 }
1112 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1113
1114 ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1115 binmode $block_fh, ':raw';
1116 $in_block = 0;
1117 }
1118 elsif ( $str =~ /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) {
1119 $in_block++;
1120 print $block_fh $str;
1121 }
1122 elsif ( $in_block ) {
1123 print $block_fh $str;
1124 }
1125 else {
1126 print $tmp_fh $str;
1127 $had_literal = 1 if /\S/s;
1128 }
1129 }
1130 $io->close;
1131
1132 if ( $in_block ) {
1133 # we're still in a block, this not bad not good. let's try to
1134 # decrypt what we have, it can be just missing -----END PGP...
1135 seek $block_fh, 0, 0;
1136
1137 my ($res_fh, $res_fn);
af59614d 1138 ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
84fb5b46 1139 %args,
84fb5b46
MKG
1140 BlockHandle => $block_fh,
1141 );
1142 return %res unless $res_fh;
1143
1144 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1145 while (my $buf = <$res_fh> ) {
1146 print $tmp_fh $buf;
1147 }
1148 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1149 }
1150
1151 seek $tmp_fh, 0, 0;
1152 $args{'Data'}->bodyhandle(MIME::Body::File->new( $tmp_fn ));
1153 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
1154 return %res;
1155}
1156
1157sub _DecryptInlineBlock {
af59614d 1158 my $self = shift;
84fb5b46 1159 my %args = (
84fb5b46
MKG
1160 BlockHandle => undef,
1161 Passphrase => undef,
1162 @_
1163 );
84fb5b46
MKG
1164
1165 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1166 binmode $tmp_fh, ':raw';
1167
af59614d
MKG
1168 my %res = $self->CallGnuPG(
1169 Command => "decrypt",
1170 Handles => { stdout => $tmp_fh, stdin => $args{'BlockHandle'} },
1171 Passphrase => $args{'Passphrase'},
1172 );
84fb5b46
MKG
1173
1174 # if the decryption is fine but the signature is bad, then without this
1175 # status check we lose the decrypted text
1176 # XXX: add argument to the function to control this check
af59614d
MKG
1177 delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
1178
1179 return (undef, undef, %res) if $res{message};
84fb5b46
MKG
1180
1181 seek $tmp_fh, 0, 0;
1182 return ($tmp_fh, $tmp_fn, %res);
1183}
1184
1185sub DecryptAttachment {
af59614d 1186 my $self = shift;
84fb5b46 1187 my %args = (
84fb5b46
MKG
1188 Data => undef,
1189 Passphrase => undef,
1190 @_
1191 );
1192
84fb5b46
MKG
1193 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1194 require RT::EmailParser;
1195 RT::EmailParser->_DecodeBody($args{'Data'});
1196 }
1197
84fb5b46
MKG
1198 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1199 binmode $tmp_fh, ':raw';
1200 $args{'Data'}->bodyhandle->print( $tmp_fh );
1201 seek $tmp_fh, 0, 0;
1202
af59614d 1203 my ($res_fh, $res_fn, %res) = $self->_DecryptInlineBlock(
84fb5b46 1204 %args,
84fb5b46
MKG
1205 BlockHandle => $tmp_fh,
1206 );
1207 return %res unless $res_fh;
1208
1209 $args{'Data'}->bodyhandle(MIME::Body::File->new($res_fn) );
1210 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $res_fh;
1211
1212 my $head = $args{'Data'}->head;
1213
1214 # we can not trust original content type
1215 # TODO: and don't have way to detect, so we just use octet-stream
1216 # some clients may send .asc files (encryped) as text/plain
1217 $head->mime_attr( "Content-Type" => 'application/octet-stream' );
1218
1219 my $filename = $head->recommended_filename;
1220 $filename =~ s/\.${RE_FILE_EXTENSIONS}$//i;
1221 $head->mime_attr( $_ => $filename )
1222 foreach (qw(Content-Type.name Content-Disposition.filename));
1223
1224 return %res;
1225}
1226
1227sub DecryptContent {
af59614d 1228 my $self = shift;
84fb5b46
MKG
1229 my %args = (
1230 Content => undef,
1231 Passphrase => undef,
1232 @_
1233 );
1234
84fb5b46
MKG
1235 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1236 binmode $tmp_fh, ':raw';
1237
af59614d
MKG
1238 my %res = $self->CallGnuPG(
1239 Command => "decrypt",
1240 Handles => { stdout => $tmp_fh },
1241 Passphrase => $args{'Passphrase'},
1242 Content => $args{'Content'},
1243 );
84fb5b46
MKG
1244
1245 # if the decryption is fine but the signature is bad, then without this
1246 # status check we lose the decrypted text
1247 # XXX: add argument to the function to control this check
af59614d
MKG
1248 delete $res{'message'} if $res{'status'} =~ /DECRYPTION_OKAY/;
1249
1250 return %res if $res{'message'};
84fb5b46
MKG
1251
1252 ${ $args{'Content'} } = '';
1253 seek $tmp_fh, 0, 0;
1254 while (1) {
1255 my $status = read $tmp_fh, my $buf, 4*1024;
1256 unless ( defined $status ) {
1257 $RT::Logger->crit( "couldn't read message: $!" );
1258 } elsif ( !$status ) {
1259 last;
1260 }
1261 ${ $args{'Content'} } .= $buf;
1262 }
1263
1264 return %res;
1265}
1266
84fb5b46
MKG
1267my %REASON_CODE_TO_TEXT = (
1268 NODATA => {
1269 1 => "No armored data",
1270 2 => "Expected a packet, but did not found one",
1271 3 => "Invalid packet found",
1272 4 => "Signature expected, but not found",
1273 },
1274 INV_RECP => {
1275 0 => "No specific reason given",
1276 1 => "Not Found",
1277 2 => "Ambigious specification",
1278 3 => "Wrong key usage",
1279 4 => "Key revoked",
1280 5 => "Key expired",
1281 6 => "No CRL known",
1282 7 => "CRL too old",
1283 8 => "Policy mismatch",
1284 9 => "Not a secret key",
1285 10 => "Key not trusted",
1286 },
1287 ERRSIG => {
1288 0 => 'not specified',
1289 4 => 'unknown algorithm',
1290 9 => 'missing public key',
1291 },
1292);
1293
1294sub ReasonCodeToText {
1295 my $keyword = shift;
1296 my $code = shift;
1297 return $REASON_CODE_TO_TEXT{ $keyword }{ $code }
1298 if exists $REASON_CODE_TO_TEXT{ $keyword }{ $code };
1299 return 'unknown';
1300}
1301
1302my %simple_keyword = (
1303 NO_RECP => {
1304 Operation => 'RecipientsCheck',
1305 Status => 'ERROR',
1306 Message => 'No recipients',
1307 },
1308 UNEXPECTED => {
1309 Operation => 'Data',
1310 Status => 'ERROR',
1311 Message => 'Unexpected data has been encountered',
1312 },
1313 BADARMOR => {
1314 Operation => 'Data',
1315 Status => 'ERROR',
1316 Message => 'The ASCII armor is corrupted',
1317 },
1318);
1319
1320# keywords we parse
1321my %parse_keyword = map { $_ => 1 } qw(
1322 USERID_HINT
1323 SIG_CREATED GOODSIG BADSIG ERRSIG
1324 END_ENCRYPTION
1325 DECRYPTION_FAILED DECRYPTION_OKAY
1326 BAD_PASSPHRASE GOOD_PASSPHRASE
1327 NO_SECKEY NO_PUBKEY
1328 NO_RECP INV_RECP NODATA UNEXPECTED
1329);
1330
1331# keywords we ignore without any messages as we parse them using other
1332# keywords as starting point or just ignore as they are useless for us
1333my %ignore_keyword = map { $_ => 1 } qw(
1334 NEED_PASSPHRASE MISSING_PASSPHRASE BEGIN_SIGNING PLAINTEXT PLAINTEXT_LENGTH
1335 BEGIN_ENCRYPTION SIG_ID VALIDSIG
1336 ENC_TO BEGIN_DECRYPTION END_DECRYPTION GOODMDC
1337 TRUST_UNDEFINED TRUST_NEVER TRUST_MARGINAL TRUST_FULLY TRUST_ULTIMATE
dab09ea8 1338 DECRYPTION_INFO
84fb5b46
MKG
1339);
1340
1341sub ParseStatus {
af59614d 1342 my $self = shift;
84fb5b46
MKG
1343 my $status = shift;
1344 return () unless $status;
1345
1346 my @status;
1347 while ( $status =~ /\[GNUPG:\]\s*(.*?)(?=\[GNUPG:\]|\z)/igms ) {
1348 push @status, $1; $status[-1] =~ s/\s+/ /g; $status[-1] =~ s/\s+$//;
1349 }
1350 $status = join "\n", @status;
1351 study $status;
1352
1353 my @res;
1354 my (%user_hint, $latest_user_main_key);
1355 for ( my $i = 0; $i < @status; $i++ ) {
1356 my $line = $status[$i];
1357 my ($keyword, $args) = ($line =~ /^(\S+)\s*(.*)$/s);
1358 if ( $simple_keyword{ $keyword } ) {
1359 push @res, $simple_keyword{ $keyword };
1360 $res[-1]->{'Keyword'} = $keyword;
1361 next;
1362 }
1363 unless ( $parse_keyword{ $keyword } ) {
1364 $RT::Logger->warning("Skipped $keyword") unless $ignore_keyword{ $keyword };
1365 next;
1366 }
1367
1368 if ( $keyword eq 'USERID_HINT' ) {
1369 my %tmp = _ParseUserHint($status, $line);
1370 $latest_user_main_key = $tmp{'MainKey'};
1371 if ( $user_hint{ $tmp{'MainKey'} } ) {
1372 while ( my ($k, $v) = each %tmp ) {
1373 $user_hint{ $tmp{'MainKey'} }->{$k} = $v;
1374 }
1375 } else {
1376 $user_hint{ $tmp{'MainKey'} } = \%tmp;
1377 }
1378 next;
1379 }
1380 elsif ( $keyword eq 'BAD_PASSPHRASE' || $keyword eq 'GOOD_PASSPHRASE' ) {
1381 my $key_id = $args;
1382 my %res = (
1383 Operation => 'PassphraseCheck',
1384 Status => $keyword eq 'BAD_PASSPHRASE'? 'BAD' : 'DONE',
1385 Key => $key_id,
1386 );
1387 $res{'Status'} = 'MISSING' if $status[ $i - 1 ] =~ /^MISSING_PASSPHRASE/;
1388 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1389 next unless $line =~ /^NEED_PASSPHRASE\s+(\S+)\s+(\S+)\s+(\S+)/;
1390 next if $key_id && $2 ne $key_id;
1391 @res{'MainKey', 'Key', 'KeyType'} = ($1, $2, $3);
1392 last;
1393 }
1394 $res{'Message'} = ucfirst( lc( $res{'Status'} eq 'DONE'? 'GOOD': $res{'Status'} ) ) .' passphrase';
1395 $res{'User'} = ( $user_hint{ $res{'MainKey'} } ||= {} ) if $res{'MainKey'};
1396 if ( exists $res{'User'}->{'EmailAddress'} ) {
1397 $res{'Message'} .= ' for '. $res{'User'}->{'EmailAddress'};
1398 } else {
1399 $res{'Message'} .= " for '0x$key_id'";
1400 }
1401 push @res, \%res;
1402 }
1403 elsif ( $keyword eq 'END_ENCRYPTION' ) {
1404 my %res = (
1405 Operation => 'Encrypt',
1406 Status => 'DONE',
1407 Message => 'Data has been encrypted',
1408 );
1409 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1410 next unless $line =~ /^BEGIN_ENCRYPTION\s+(\S+)\s+(\S+)/;
1411 @res{'MdcMethod', 'SymAlgo'} = ($1, $2);
1412 last;
1413 }
1414 push @res, \%res;
1415 }
1416 elsif ( $keyword eq 'DECRYPTION_FAILED' || $keyword eq 'DECRYPTION_OKAY' ) {
1417 my %res = ( Operation => 'Decrypt' );
1418 @res{'Status', 'Message'} =
1419 $keyword eq 'DECRYPTION_FAILED'
1420 ? ('ERROR', 'Decryption failed')
1421 : ('DONE', 'Decryption process succeeded');
1422
1423 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1424 next unless $line =~ /^ENC_TO\s+(\S+)\s+(\S+)\s+(\S+)/;
1425 my ($key, $alg, $key_length) = ($1, $2, $3);
1426
1427 my %encrypted_to = (
1428 Message => "The message is encrypted to '0x$key'",
1429 User => ( $user_hint{ $key } ||= {} ),
1430 Key => $key,
1431 KeyLength => $key_length,
1432 Algorithm => $alg,
1433 );
1434
1435 push @{ $res{'EncryptedTo'} ||= [] }, \%encrypted_to;
1436 }
1437
1438 push @res, \%res;
1439 }
1440 elsif ( $keyword eq 'NO_SECKEY' || $keyword eq 'NO_PUBKEY' ) {
1441 my ($key) = split /\s+/, $args;
1442 my $type = $keyword eq 'NO_SECKEY'? 'secret': 'public';
1443 my %res = (
1444 Operation => 'KeyCheck',
1445 Status => 'MISSING',
1446 Message => ucfirst( $type ) ." key '0x$key' is not available",
1447 Key => $key,
1448 KeyType => $type,
1449 );
1450 $res{'User'} = ( $user_hint{ $key } ||= {} );
1451 $res{'User'}{ ucfirst( $type ). 'KeyMissing' } = 1;
1452 push @res, \%res;
1453 }
1454 # GOODSIG, BADSIG, VALIDSIG, TRUST_*
1455 elsif ( $keyword eq 'GOODSIG' ) {
1456 my %res = (
1457 Operation => 'Verify',
1458 Status => 'DONE',
1459 Message => 'The signature is good',
1460 );
1461 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1462 $res{'Message'} .= ', signed by '. $res{'UserString'};
1463
1464 foreach my $line ( @status[ $i .. $#status ] ) {
1465 next unless $line =~ /^TRUST_(\S+)/;
1466 $res{'Trust'} = $1;
1467 last;
1468 }
1469 $res{'Message'} .= ', trust level is '. lc( $res{'Trust'} || 'unknown');
1470
1471 foreach my $line ( @status[ $i .. $#status ] ) {
1472 next unless $line =~ /^VALIDSIG\s+(.*)/;
1473 @res{ qw(
1474 Fingerprint
1475 CreationDate
1476 Timestamp
1477 ExpireTimestamp
1478 Version
1479 Reserved
1480 PubkeyAlgo
1481 HashAlgo
1482 Class
1483 PKFingerprint
1484 Other
1485 ) } = split /\s+/, $1, 10;
1486 last;
1487 }
1488 push @res, \%res;
1489 }
1490 elsif ( $keyword eq 'BADSIG' ) {
1491 my %res = (
1492 Operation => 'Verify',
1493 Status => 'BAD',
1494 Message => 'The signature has not been verified okay',
1495 );
1496 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1497 push @res, \%res;
1498 }
1499 elsif ( $keyword eq 'ERRSIG' ) {
1500 my %res = (
1501 Operation => 'Verify',
1502 Status => 'ERROR',
1503 Message => 'Not possible to check the signature',
1504 );
1505 @res{qw(Key PubkeyAlgo HashAlgo Class Timestamp ReasonCode Other)}
1506 = split /\s+/, $args, 7;
1507
1508 $res{'Reason'} = ReasonCodeToText( $keyword, $res{'ReasonCode'} );
1509 $res{'Message'} .= ", the reason is ". $res{'Reason'};
1510
1511 push @res, \%res;
1512 }
1513 elsif ( $keyword eq 'SIG_CREATED' ) {
1514 # SIG_CREATED <type> <pubkey algo> <hash algo> <class> <timestamp> <key fpr>
1515 my @props = split /\s+/, $args;
1516 push @res, {
1517 Operation => 'Sign',
1518 Status => 'DONE',
1519 Message => "Signed message",
1520 Type => $props[0],
1521 PubKeyAlgo => $props[1],
1522 HashKeyAlgo => $props[2],
1523 Class => $props[3],
1524 Timestamp => $props[4],
1525 KeyFingerprint => $props[5],
1526 User => $user_hint{ $latest_user_main_key },
1527 };
1528 $res[-1]->{Message} .= ' by '. $user_hint{ $latest_user_main_key }->{'EmailAddress'}
1529 if $user_hint{ $latest_user_main_key };
1530 }
1531 elsif ( $keyword eq 'INV_RECP' ) {
1532 my ($rcode, $recipient) = split /\s+/, $args, 2;
1533 my $reason = ReasonCodeToText( $keyword, $rcode );
1534 push @res, {
1535 Operation => 'RecipientsCheck',
1536 Status => 'ERROR',
1537 Message => "Recipient '$recipient' is unusable, the reason is '$reason'",
1538 Recipient => $recipient,
1539 ReasonCode => $rcode,
1540 Reason => $reason,
1541 };
1542 }
1543 elsif ( $keyword eq 'NODATA' ) {
1544 my $rcode = (split /\s+/, $args)[0];
1545 my $reason = ReasonCodeToText( $keyword, $rcode );
1546 push @res, {
1547 Operation => 'Data',
1548 Status => 'ERROR',
1549 Message => "No data has been found. The reason is '$reason'",
1550 ReasonCode => $rcode,
1551 Reason => $reason,
1552 };
1553 }
1554 else {
1555 $RT::Logger->warning("Keyword $keyword is unknown");
1556 next;
1557 }
1558 $res[-1]{'Keyword'} = $keyword if @res && !$res[-1]{'Keyword'};
1559 }
1560 return @res;
1561}
1562
1563sub _ParseUserHint {
1564 my ($status, $hint) = (@_);
1565 my ($main_key_id, $user_str) = ($hint =~ /^USERID_HINT\s+(\S+)\s+(.*)$/);
1566 return () unless $main_key_id;
1567 return (
1568 MainKey => $main_key_id,
1569 String => $user_str,
1570 EmailAddress => (map $_->address, Email::Address->parse( $user_str ))[0],
1571 );
1572}
1573
1574sub _PrepareGnuPGOptions {
1575 my %opt = @_;
1576 my %res = map { lc $_ => $opt{ $_ } } grep $supported_opt{ lc $_ }, keys %opt;
1577 $res{'extra_args'} ||= [];
1578 foreach my $o ( grep !$supported_opt{ lc $_ }, keys %opt ) {
1579 push @{ $res{'extra_args'} }, '--'. lc $o;
1580 push @{ $res{'extra_args'} }, $opt{ $o }
1581 if defined $opt{ $o };
1582 }
1583 return %res;
1584}
1585
84fb5b46 1586sub GetKeysForEncryption {
af59614d
MKG
1587 my $self = shift;
1588 my %args = (Recipient => undef, @_);
1589 my %res = $self->GetKeysInfo( Key => delete $args{'Recipient'}, %args, Type => 'public' );
84fb5b46
MKG
1590 return %res if $res{'exit_code'};
1591 return %res unless $res{'info'};
1592
1593 foreach my $key ( splice @{ $res{'info'} } ) {
1594 # skip disabled keys
1595 next if $key->{'Capabilities'} =~ /D/;
1596 # skip keys not suitable for encryption
1597 next unless $key->{'Capabilities'} =~ /e/i;
af59614d 1598 # skip disabled, expired, revoked and keys with no trust,
84fb5b46
MKG
1599 # but leave keys with unknown trust level
1600 next if $key->{'TrustLevel'} < 0;
1601
1602 push @{ $res{'info'} }, $key;
1603 }
1604 delete $res{'info'} unless @{ $res{'info'} };
1605 return %res;
1606}
1607
1608sub GetKeysForSigning {
af59614d
MKG
1609 my $self = shift;
1610 my %args = (Signer => undef, @_);
1611 return $self->GetKeysInfo( Key => delete $args{'Signer'}, %args, Type => 'private' );
84fb5b46
MKG
1612}
1613
1614sub GetKeysInfo {
af59614d
MKG
1615 my $self = shift;
1616 my %args = (
1617 Key => undef,
1618 Type => 'public',
1619 Force => 0,
1620 @_
1621 );
84fb5b46 1622
af59614d
MKG
1623 my $email = $args{'Key'};
1624 my $type = $args{'Type'};
84fb5b46 1625 unless ( $email ) {
af59614d
MKG
1626 return (exit_code => 0) unless $args{'Force'};
1627 }
1628
1629 my @info;
1630 my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
1631 my %res = $self->CallGnuPG(
1632 Options => {
1633 'with-colons' => undef, # parseable format
1634 'fingerprint' => undef, # show fingerprint
1635 'fixed-list-mode' => undef, # don't merge uid with keys
1636 },
1637 Command => $method,
1638 ( $email ? (CommandArgs => ['--', $email]) : () ),
1639 Output => \@info,
84fb5b46
MKG
1640 );
1641
af59614d
MKG
1642 # Asking for a non-existent key is not an error
1643 if ($res{message} and $res{logger} =~ /(secret key not available|public key not found)/) {
1644 delete $res{exit_code};
1645 delete $res{message};
84fb5b46
MKG
1646 }
1647
af59614d
MKG
1648 return %res if $res{'message'};
1649
1650 @info = $self->ParseKeysInfo( @info );
84fb5b46
MKG
1651 $res{'info'} = \@info;
1652 return %res;
1653}
1654
1655sub ParseKeysInfo {
af59614d 1656 my $self = shift;
84fb5b46
MKG
1657 my @lines = @_;
1658
1659 my %gpg_opt = RT->Config->Get('GnuPGOptions');
1660
1661 my @res = ();
1662 foreach my $line( @lines ) {
1663 chomp $line;
1664 my $tag;
1665 ($tag, $line) = split /:/, $line, 2;
1666 if ( $tag eq 'pub' ) {
1667 my %info;
1668 @info{ qw(
1669 TrustChar KeyLength Algorithm Key
1670 Created Expire Empty OwnerTrustChar
1671 Empty Empty Capabilities Other
1672 ) } = split /:/, $line, 12;
1673
1674 # workaround gnupg's wierd behaviour, --list-keys command report calculated trust levels
1675 # for any model except 'always', so you can change models and see changes, but not for 'always'
1676 # we try to handle it in a simple way - we set ultimate trust for any key with trust
1677 # level >= 0 if trust model is 'always'
1678 my $always_trust;
1679 $always_trust = 1 if exists $gpg_opt{'always-trust'};
1680 $always_trust = 1 if exists $gpg_opt{'trust-model'} && $gpg_opt{'trust-model'} eq 'always';
1681 @info{qw(Trust TrustTerse TrustLevel)} =
1682 _ConvertTrustChar( $info{'TrustChar'} );
1683 if ( $always_trust && $info{'TrustLevel'} >= 0 ) {
1684 @info{qw(Trust TrustTerse TrustLevel)} =
1685 _ConvertTrustChar( 'u' );
1686 }
1687
1688 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
1689 _ConvertTrustChar( $info{'OwnerTrustChar'} );
af59614d 1690 $info{ $_ } = $self->ParseDate( $info{ $_ } )
84fb5b46
MKG
1691 foreach qw(Created Expire);
1692 push @res, \%info;
1693 }
1694 elsif ( $tag eq 'sec' ) {
1695 my %info;
1696 @info{ qw(
1697 Empty KeyLength Algorithm Key
1698 Created Expire Empty OwnerTrustChar
1699 Empty Empty Capabilities Other
1700 ) } = split /:/, $line, 12;
1701 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
1702 _ConvertTrustChar( $info{'OwnerTrustChar'} );
af59614d 1703 $info{ $_ } = $self->ParseDate( $info{ $_ } )
84fb5b46
MKG
1704 foreach qw(Created Expire);
1705 push @res, \%info;
1706 }
1707 elsif ( $tag eq 'uid' ) {
1708 my %info;
1709 @info{ qw(Trust Created Expire String) }
1710 = (split /:/, $line)[0,4,5,8];
af59614d 1711 $info{ $_ } = $self->ParseDate( $info{ $_ } )
84fb5b46
MKG
1712 foreach qw(Created Expire);
1713 push @{ $res[-1]{'User'} ||= [] }, \%info;
1714 }
1715 elsif ( $tag eq 'fpr' ) {
1716 $res[-1]{'Fingerprint'} = (split /:/, $line, 10)[8];
1717 }
1718 }
1719 return @res;
1720}
1721
1722{
1723 my %verbose = (
1724 # deprecated
1725 d => [
1726 "The key has been disabled", #loc
1727 "key disabled", #loc
1728 "-2"
1729 ],
1730
1731 r => [
1732 "The key has been revoked", #loc
1733 "key revoked", #loc
1734 -3,
1735 ],
1736
1737 e => [ "The key has expired", #loc
1738 "key expired", #loc
1739 '-4',
1740 ],
1741
1742 n => [ "Don't trust this key at all", #loc
1743 'none', #loc
1744 -1,
1745 ],
1746
1747 #gpupg docs says that '-' and 'q' may safely be treated as the same value
1748 '-' => [
1749 'Unknown (no trust value assigned)', #loc
1750 'not set',
1751 0,
1752 ],
1753 q => [
1754 'Unknown (no trust value assigned)', #loc
1755 'not set',
1756 0,
1757 ],
1758 o => [
1759 'Unknown (this value is new to the system)', #loc
1760 'unknown',
1761 0,
1762 ],
1763
1764 m => [
1765 "There is marginal trust in this key", #loc
1766 'marginal', #loc
1767 1,
1768 ],
1769 f => [
1770 "The key is fully trusted", #loc
1771 'full', #loc
1772 2,
1773 ],
1774 u => [
1775 "The key is ultimately trusted", #loc
1776 'ultimate', #loc
1777 3,
1778 ],
1779 );
1780
1781 sub _ConvertTrustChar {
1782 my $value = shift;
1783 return @{ $verbose{'-'} } unless $value;
1784 $value = substr $value, 0, 1;
1785 return @{ $verbose{ $value } || $verbose{'o'} };
1786 }
1787}
1788
84fb5b46 1789sub DeleteKey {
af59614d 1790 my $self = shift;
84fb5b46
MKG
1791 my $key = shift;
1792
af59614d
MKG
1793 return $self->CallGnuPG(
1794 Command => "--delete-secret-and-public-key",
1795 CommandArgs => ["--", $key],
1796 Callback => sub {
1797 my %handle = @_;
1798 while ( my $str = readline $handle{'status'} ) {
1799 if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) {
1800 print { $handle{'command'} } "y\n";
1801 }
84fb5b46 1802 }
af59614d
MKG
1803 },
1804 );
84fb5b46
MKG
1805}
1806
1807sub ImportKey {
af59614d 1808 my $self = shift;
84fb5b46
MKG
1809 my $key = shift;
1810
af59614d
MKG
1811 return $self->CallGnuPG(
1812 Command => "import_keys",
1813 Content => $key,
84fb5b46 1814 );
84fb5b46
MKG
1815}
1816
af59614d
MKG
1817sub GnuPGPath {
1818 state $cache = RT->Config->Get('GnuPG')->{'GnuPG'};
1819 $cache = $_[1] if @_ > 1;
1820 return $cache;
84fb5b46
MKG
1821}
1822
af59614d
MKG
1823sub Probe {
1824 my $self = shift;
1825 my $gnupg = GnuPG::Interface->new;
1826
1827 my $bin = $self->GnuPGPath();
1828 unless ($bin) {
1829 $RT::Logger->warning(
1830 "No gpg path set; GnuPG support has been disabled. ".
1831 "Check the 'GnuPG' configuration in %GnuPG");
1832 return 0;
1833 }
84fb5b46 1834
af59614d
MKG
1835 if ($bin =~ m{^/}) {
1836 unless (-f $bin and -x _) {
1837 $RT::Logger->warning(
1838 "Invalid gpg path $bin; GnuPG support has been disabled. ".
1839 "Check the 'GnuPG' configuration in %GnuPG");
1840 return 0;
1841 }
1842 } else {
1843 my $path = File::Which::which( $bin );
1844 unless ($path) {
1845 $RT::Logger->warning(
1846 "Can't find gpg binary '$bin' in PATH; GnuPG support has been disabled. ".
1847 "Check the 'GnuPG' configuration in %GnuPG");
1848 return 0;
1849 }
1850 $self->GnuPGPath( $bin = $path );
1851 }
84fb5b46 1852
af59614d 1853 $gnupg->call( $bin );
84fb5b46 1854 $gnupg->options->hash_init(
af59614d 1855 _PrepareGnuPGOptions( RT->Config->Get('GnuPGOptions') )
84fb5b46 1856 );
af59614d 1857 $gnupg->options->meta_interactive( 0 );
84fb5b46
MKG
1858
1859 my ($handles, $handle_list) = _make_gpg_handles();
1860 my %handle = %$handle_list;
1861
af59614d 1862 local $@ = undef;
84fb5b46
MKG
1863 eval {
1864 local $SIG{'CHLD'} = 'DEFAULT';
af59614d
MKG
1865 my $pid = safe_run_child {
1866 $gnupg->wrap_call(
1867 commands => ['--version' ],
1868 handles => $handles
1869 )
1870 };
1871 close $handle{'stdin'} or die "Can't close gnupg input handle: $!";
84fb5b46
MKG
1872 waitpid $pid, 0;
1873 };
1874 if ( $@ ) {
af59614d
MKG
1875 $RT::Logger->warning(
1876 "RT's GnuPG libraries couldn't successfully execute gpg.".
1877 " GnuPG support has been disabled");
84fb5b46
MKG
1878 $RT::Logger->debug(
1879 "Probe for GPG failed."
1880 ." Couldn't run `gpg --version`: ". $@
1881 );
1882 return 0;
1883 }
1884
1885# on some systems gpg exits with code 2, but still 100% functional,
1886# it's general error system error or incorrect command, command is correct,
1887# but there is no way to get actuall error
1888 if ( $? && ($? >> 8) != 2 ) {
1889 my $msg = "Probe for GPG failed."
af59614d 1890 ." Process exited with code ". ($? >> 8)
84fb5b46
MKG
1891 . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '')
1892 . ".";
1893 foreach ( qw(stderr logger status) ) {
af59614d 1894 my $tmp = do { local $/ = undef; readline $handle{$_} };
84fb5b46 1895 next unless $tmp && $tmp =~ /\S/s;
af59614d 1896 close $handle{$_} or $tmp .= "\nFailed to close: $!";
84fb5b46
MKG
1897 $msg .= "\n$_:\n$tmp\n";
1898 }
af59614d
MKG
1899 $RT::Logger->warning(
1900 "RT's GnuPG libraries couldn't successfully execute gpg.".
1901 " GnuPG support has been disabled");
84fb5b46
MKG
1902 $RT::Logger->debug( $msg );
1903 return 0;
1904 }
1905 return 1;
1906}
1907
1908
1909sub _make_gpg_handles {
1910 my %handle_map = (@_);
1911 $handle_map{$_} = IO::Handle->new
1912 foreach grep !defined $handle_map{$_},
1913 qw(stdin stdout stderr logger status command);
1914
1915 my $handles = GnuPG::Handles->new(%handle_map);
1916 return ($handles, \%handle_map);
1917}
1918
1919RT::Base->_ImportOverlays();
1920
84fb5b46 19211;