]> git.uio.no Git - usit-rt.git/blame - lib/RT/Crypt/GnuPG.pm
git://git.uio.no / usit-rt.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial commit 4.0.5-3
[usit-rt.git] / lib / RT / Crypt / GnuPG.pm
CommitLineData
84fb5b46
MKG		 1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
5# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
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;
51
52package RT::Crypt::GnuPG;
53
54use IO::Handle;
55use GnuPG::Interface;
56use RT::EmailParser ();
57use RT::Util 'safe_run_child', 'mime_recommended_filename';
58
59=head1 NAME
60
61RT::Crypt::GnuPG - encrypt/decrypt and sign/verify email messages with the GNU Privacy Guard (GPG)
62
63=head1 DESCRIPTION
64
65This module provides support for encryption and signing of outgoing messages,
66as well as the decryption and verification of incoming email.
67
68=head1 CONFIGURATION
69
70You can control the configuration of this subsystem from RT's configuration file.
71Some options are available via the web interface, but to enable this functionality, you
72MUST start in the configuration file.
73
74There are two hashes, GnuPG and GnuPGOptions in the configuration file. The
75first one controls RT specific options. It enables you to enable/disable facility
76or change the format of messages. The second one is a hash with options for the
77'gnupg' utility. You can use it to define a keyserver, enable auto-retrieval keys
78and set almost any option 'gnupg' supports on your system.
79
80=head2 %GnuPG
81
82=head3 Enabling GnuPG
83
84Set to true value to enable this subsystem:
85
86 Set( %GnuPG,
87 Enable => 1,
88 ... other options ...
89 );
90
91However, note that you B<must> add the 'Auth::GnuPG' email filter to enable
92the handling of incoming encrypted/signed messages.
93
94=head3 Format of outgoing messages
95
96Format of outgoing messages can be controlled using the 'OutgoingMessagesFormat'
97option in the RT config:
98
99 Set( %GnuPG,
100 ... other options ...
101 OutgoingMessagesFormat => 'RFC',
102 ... other options ...
103 );
104
105or
106
107 Set( %GnuPG,
108 ... other options ...
109 OutgoingMessagesFormat => 'Inline',
110 ... other options ...
111 );
112
113This framework implements two formats of signing and encrypting of email messages:
114
115=over
116
117=item RFC
118
119This format is also known as GPG/MIME and described in RFC3156 and RFC1847.
120Technique described in these RFCs is well supported by many mail user
121agents (MUA), but some MUAs support only inline signatures and encryption,
122so it's possible to use inline format (see below).
123
124=item Inline
125
126This format doesn't take advantage of MIME, but some mail clients do
127not support GPG/MIME.
128
129We sign text parts using clear signatures. For each attachments another
130attachment with a signature is added with '.sig' extension.
131
132Encryption of text parts is implemented using inline format, other parts
133are replaced with attachments with the filename extension '.pgp'.
134
135This format is discouraged because modern mail clients typically don't support
136it well.
137
138=back
139
140=head3 Encrypting data in the database
141
142You can allow users to encrypt data in the database using
143option C<AllowEncryptDataInDB>. By default it's disabled.
144Users must have rights to see and modify tickets to use
145this feature.
146
147=head2 %GnuPGOptions
148
149Use this hash to set options of the 'gnupg' program. You can define almost any
150option you want which gnupg supports, but never try to set options which
151change output format or gnupg's commands, such as --sign (command),
152--list-options (option) and other.
153
154Some GnuPG options take arguments while others take none. (Such as --use-agent).
155For options without specific value use C<undef> as hash value.
156To disable these option just comment them out or delete them from the hash
157
158 Set(%GnuPGOptions,
159 'option-with-value' => 'value',
160 'enabled-option-without-value' => undef,
161 # 'commented-option' => 'value or undef',
162 );
163
164B<NOTE> that options may contain '-' character and such options B<MUST> be
165quoted, otherwise you can see quite cryptic error 'gpg: Invalid option "--0"'.
166
167=over
168
169=item --homedir
170
171The GnuPG home directory, by default it is set to F</opt/rt4/var/data/gpg>.
172
173You can manage this data with the 'gpg' commandline utility
174using the GNUPGHOME environment variable or --homedir option.
175Other utilities may be used as well.
176
177In a standard installation, access to this directory should be granted to
178the web server user which is running RT's web interface, but if you're running
179cronjobs or other utilities that access RT directly via API and may generate
180encrypted/signed notifications then the users you execute these scripts under
181must have access too.
182
183However, granting access to the dir to many users makes your setup less secure,
184some features, such as auto-import of keys, may not be available if you do not.
185To enable this features and suppress warnings about permissions on
186the dir use --no-permission-warning.
187
188=item --digest-algo
189
190This option is required in advance when RFC format for outgoing messages is
191used. We can not get default algorithm from gpg program so RT uses 'SHA1' by
192default. You may want to override it. You can use MD5, SHA1, RIPEMD160,
193SHA256 or other, however use `gpg --version` command to get information about
194supported algorithms by your gpg. These algorithms are listed as hash-functions.
195
196=item --use-agent
197
198This option lets you use GPG Agent to cache the passphrase of RT's key. See
199L<http://www.gnupg.org/documentation/manuals/gnupg/Invoking-GPG_002dAGENT.html>
200for information about GPG Agent.
201
202=item --passphrase
203
204This option lets you set the passphrase of RT's key directly. This option is
205special in that it isn't passed directly to GPG, but is put into a file that
206GPG then reads (which is more secure). The downside is that anyone who has read
207access to your RT_SiteConfig.pm file can see the passphrase, thus we recommend
208the --use-agent option instead.
209
210=item other
211
212Read `man gpg` to get list of all options this program support.
213
214=back
215
216=head2 Per-queue options
217
218Using the web interface it's possible to enable signing and/or encrypting by
219default. As an administrative user of RT, open 'Configuration' then 'Queues',
220and select a queue. On the page you can see information about the queue's keys
221at the bottom and two checkboxes to choose default actions.
222
223As well, encryption is enabled for autoreplies and other notifications when
224an encypted message enters system via mailgate interface even if queue's
225option is disabled.
226
227=head2 Handling incoming messages
228
229To enable handling of encrypted and signed message in the RT you should add
230'Auth::GnuPG' mail plugin.
231
232 Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...);
233
234See also `perldoc lib/RT/Interface/Email/Auth/GnuPG.pm`.
235
236=head2 Errors handling
237
238There are several global templates created in the database by default. RT
239uses these templates to send error messages to users or RT's owner. These
240templates have 'Error:' or 'Error to RT owner:' prefix in the name. You can
241adjust the text of the messages using the web interface.
242
243Note that C<$TicketObj>, C<$TransactionObj> and other variable usually available
244in RT's templates are not available in these templates, but each template
245used for errors reporting has set of available data structures you can use to
246build better messages. See default templates and descriptions below.
247
248As well, you can disable particular notification by deleting content of
249a template. You can delete a template too, but in this case you'll see
250error messages in the logs when RT can not load template you've deleted.
251
252=head3 Problems with public keys
253
254Template 'Error: public key' is used to inform the user that RT has problems with
255his public key and won't be able to send him encrypted content. There are several
256reasons why RT can't use a key. However, the actual reason is not sent to the user,
257but sent to RT owner using 'Error to RT owner: public key'.
258
259The possible reasons: "Not Found", "Ambiguous specification", "Wrong
260key usage", "Key revoked", "Key expired", "No CRL known", "CRL too
261old", "Policy mismatch", "Not a secret key", "Key not trusted" or
262"No specific reason given".
263
264Due to limitations of GnuPG, it's impossible to encrypt to an untrusted key,
265unless 'always trust' mode is enabled.
266
267In the 'Error: public key' template there are a few additional variables available:
268
269=over 4
270
271=item $Message - user friendly error message
272
273=item $Reason - short reason as listed above
274
275=item $Recipient - recipient's identification
276
277=item $AddressObj - L<Email::Address> object containing recipient's email address
278
279=back
280
281A message can have several invalid recipients, to avoid sending many emails
282to the RT owner the system sends one message to the owner, grouped by
283recipient. In the 'Error to RT owner: public key' template a C<@BadRecipients>
284array is available where each element is a hash reference that describes one
285recipient using the same fields as described above. So it's something like:
286
287 @BadRecipients = (
288 { Message => '...', Reason => '...', Recipient => '...', ...},
289 { Message => '...', Reason => '...', Recipient => '...', ...},
290 ...
291 )
292
293=head3 Private key doesn't exist
294
295Template 'Error: no private key' is used to inform the user that
296he sent an encrypted email, but we have no private key to decrypt
297it.
298
299In this template C<$Message> object of L<MIME::Entity> class
300available. It's the message RT received.
301
302=head3 Invalid data
303
304Template 'Error: bad GnuPG data' used to inform the user that a
305message he sent has invalid data and can not be handled.
306
307There are several reasons for this error, but most of them are data
308corruption or absence of expected information.
309
310In this template C<@Messages> array is available and contains list
311of error messages.
312
313=head1 FOR DEVELOPERS
314
315=head2 Documentation and references
316
317* RFC1847 - Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted.
318Describes generic MIME security framework, "mulitpart/signed" and "multipart/encrypted"
319MIME types.
320
321* RFC3156 - MIME Security with Pretty Good Privacy (PGP),
322updates RFC2015.
323
324=cut
325
326# gnupg options supported by GnuPG::Interface
327# other otions should be handled via extra_args argument
328my %supported_opt = map { $_ => 1 } qw(
329 always_trust
330 armor
331 batch
332 comment
333 compress_algo
334 default_key
335 encrypt_to
336 extra_args
337 force_v3_sigs
338 homedir
339 logger_fd
340 no_greeting
341 no_options
342 no_verbose
343 openpgp
344 options
345 passphrase_fd
346 quiet
347 recipients
348 rfc1991
349 status_fd
350 textmode
351 verbose
352);
353
354our $RE_FILE_EXTENSIONS = qr/pgp|asc/i;
355
356# DEV WARNING: always pass all STD* handles to GnuPG interface even if we don't
357# need them, just pass 'IO::Handle->new()' and then close it after safe_run_child.
358# we don't want to leak anything into FCGI/Apache/MP handles, this break things.
359# So code should look like:
360# my $handles = GnuPG::Handles->new(
361# stdin => ($handle{'stdin'} = IO::Handle->new()),
362# stdout => ($handle{'stdout'} = IO::Handle->new()),
363# stderr => ($handle{'stderr'} = IO::Handle->new()),
364# ...
365# );
366
367=head2 SignEncrypt Entity => MIME::Entity, [ Encrypt => 1, Sign => 1, ... ]
368
369Signs and/or encrypts an email message with GnuPG utility.
370
371=over
372
373=item Signing
374
375During signing you can pass C<Signer> argument to set key we sign with this option
376overrides gnupg's C<default-key> option. If C<Signer> argument is not provided
377then address of a message sender is used.
378
379As well you can pass C<Passphrase>, but if value is undefined then L</GetPassphrase>
380called to get it.
381
382=item Encrypting
383
384During encryption you can pass a C<Recipients> array, otherwise C<To>, C<Cc> and
385C<Bcc> fields of the message are used to fetch the list.
386
387=back
388
389Returns a hash with the following keys:
390
391* exit_code
392* error
393* logger
394* status
395* message
396
397=cut
398
399sub SignEncrypt {
400 my %args = (@_);
401
402 my $entity = $args{'Entity'};
403 if ( $args{'Sign'} && !defined $args{'Signer'} ) {
404 $args{'Signer'} = UseKeyForSigning()
405 || (Email::Address->parse( $entity->head->get( 'From' ) ))[0]->address;
406 }
407 if ( $args{'Encrypt'} && !$args{'Recipients'} ) {
408 my %seen;
409 $args{'Recipients'} = [
410 grep $_ && !$seen{ $_ }++, map $_->address,
411 map Email::Address->parse( $entity->head->get( $_ ) ),
412 qw(To Cc Bcc)
413 ];
414 }
415
416 my $format = lc RT->Config->Get('GnuPG')->{'OutgoingMessagesFormat'} || 'RFC';
417 if ( $format eq 'inline' ) {
418 return SignEncryptInline( %args );
419 } else {
420 return SignEncryptRFC3156( %args );
421 }
422}
423
424sub SignEncryptRFC3156 {
425 my %args = (
426 Entity => undef,
427
428 Sign => 1,
429 Signer => undef,
430 Passphrase => undef,
431
432 Encrypt => 1,
433 Recipients => undef,
434
435 @_
436 );
437
438 my $gnupg = GnuPG::Interface->new();
439 my %opt = RT->Config->Get('GnuPGOptions');
440
441 # handling passphrase in GnuPGOptions
442 $args{'Passphrase'} = delete $opt{'passphrase'}
443 if !defined $args{'Passphrase'};
444
445 $opt{'digest-algo'} ||= 'SHA1';
446 $opt{'default_key'} = $args{'Signer'}
447 if $args{'Sign'} && $args{'Signer'};
448 $gnupg->options->hash_init(
449 _PrepareGnuPGOptions( %opt ),
450 armor => 1,
451 meta_interactive => 0,
452 );
453
454 my $entity = $args{'Entity'};
455
456 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
457 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
458 }
459
460 my %res;
461 if ( $args{'Sign'} && !$args{'Encrypt'} ) {
462 # required by RFC3156(Ch. 5) and RFC1847(Ch. 2.1)
463 foreach ( grep !$_->is_multipart, $entity->parts_DFS ) {
464 my $tenc = $_->head->mime_encoding;
465 unless ( $tenc =~ m/^(?:7bit|quoted-printable|base64)$/i ) {
466 $_->head->mime_attr( 'Content-Transfer-Encoding'
467 => $_->effective_type =~ m{^text/}? 'quoted-printable': 'base64'
468 );
469 }
470 }
471
472 my ($handles, $handle_list) = _make_gpg_handles(stdin =>IO::Handle::CRLF->new );
473 my %handle = %$handle_list;
474
475 $gnupg->passphrase( $args{'Passphrase'} );
476
477 eval {
478 local $SIG{'CHLD'} = 'DEFAULT';
479 my $pid = safe_run_child { $gnupg->detach_sign( handles => $handles ) };
480 $entity->make_multipart( 'mixed', Force => 1 );
481 {
482 local $SIG{'PIPE'} = 'IGNORE';
483 $entity->parts(0)->print( $handle{'stdin'} );
484 close $handle{'stdin'};
485 }
486 waitpid $pid, 0;
487 };
488 my $err = $@;
489 my @signature = readline $handle{'stdout'};
490 close $handle{'stdout'};
491
492 $res{'exit_code'} = $?;
493 foreach ( qw(stderr logger status) ) {
494 $res{$_} = do { local $/; readline $handle{$_} };
495 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
496 close $handle{$_};
497 }
498 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
499 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
500 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
501 if ( $err || $res{'exit_code'} ) {
502 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
503 return %res;
504 }
505
506 # setup RFC1847(Ch.2.1) requirements
507 my $protocol = 'application/pgp-signature';
508 $entity->head->mime_attr( 'Content-Type' => 'multipart/signed' );
509 $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
510 $entity->head->mime_attr( 'Content-Type.micalg' => 'pgp-'. lc $opt{'digest-algo'} );
511 $entity->attach(
512 Type => $protocol,
513 Disposition => 'inline',
514 Data => \@signature,
515 Encoding => '7bit',
516 );
517 }
518 if ( $args{'Encrypt'} ) {
519 my %seen;
520 $gnupg->options->push_recipients( $_ ) foreach
521 map UseKeyForEncryption($_) || $_,
522 grep !$seen{ $_ }++, map $_->address,
523 map Email::Address->parse( $entity->head->get( $_ ) ),
524 qw(To Cc Bcc);
525
526 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
527 binmode $tmp_fh, ':raw';
528
529 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
530 my %handle = %$handle_list;
531 $handles->options( 'stdout' )->{'direct'} = 1;
532 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
533
534 eval {
535 local $SIG{'CHLD'} = 'DEFAULT';
536 my $pid = safe_run_child { $args{'Sign'}
537 ? $gnupg->sign_and_encrypt( handles => $handles )
538 : $gnupg->encrypt( handles => $handles ) };
539 $entity->make_multipart( 'mixed', Force => 1 );
540 {
541 local $SIG{'PIPE'} = 'IGNORE';
542 $entity->parts(0)->print( $handle{'stdin'} );
543 close $handle{'stdin'};
544 }
545 waitpid $pid, 0;
546 };
547
548 $res{'exit_code'} = $?;
549 foreach ( qw(stderr logger status) ) {
550 $res{$_} = do { local $/; readline $handle{$_} };
551 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
552 close $handle{$_};
553 }
554 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
555 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
556 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
557 if ( $@ || $? ) {
558 $res{'message'} = $@? $@: "gpg exited with error code ". ($? >> 8);
559 return %res;
560 }
561
562 my $protocol = 'application/pgp-encrypted';
563 $entity->parts([]);
564 $entity->head->mime_attr( 'Content-Type' => 'multipart/encrypted' );
565 $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
566 $entity->attach(
567 Type => $protocol,
568 Disposition => 'inline',
569 Data => ['Version: 1',''],
570 Encoding => '7bit',
571 );
572 $entity->attach(
573 Type => 'application/octet-stream',
574 Disposition => 'inline',
575 Path => $tmp_fn,
576 Filename => '',
577 Encoding => '7bit',
578 );
579 $entity->parts(-1)->bodyhandle->{'_dirty_hack_to_save_a_ref_tmp_fh'} = $tmp_fh;
580 }
581 return %res;
582}
583
584sub SignEncryptInline {
585 my %args = ( @_ );
586
587 my $entity = $args{'Entity'};
588
589 my %res;
590 $entity->make_singlepart;
591 if ( $entity->is_multipart ) {
592 foreach ( $entity->parts ) {
593 %res = SignEncryptInline( @_, Entity => $_ );
594 return %res if $res{'exit_code'};
595 }
596 return %res;
597 }
598
599 return _SignEncryptTextInline( @_ )
600 if $entity->effective_type =~ /^text\//i;
601
602 return _SignEncryptAttachmentInline( @_ );
603}
604
605sub _SignEncryptTextInline {
606 my %args = (
607 Entity => undef,
608
609 Sign => 1,
610 Signer => undef,
611 Passphrase => undef,
612
613 Encrypt => 1,
614 Recipients => undef,
615
616 @_
617 );
618 return unless $args{'Sign'} || $args{'Encrypt'};
619
620 my $gnupg = GnuPG::Interface->new();
621 my %opt = RT->Config->Get('GnuPGOptions');
622
623 # handling passphrase in GnupGOptions
624 $args{'Passphrase'} = delete $opt{'passphrase'}
625 if !defined($args{'Passphrase'});
626
627 $opt{'digest-algo'} ||= 'SHA1';
628 $opt{'default_key'} = $args{'Signer'}
629 if $args{'Sign'} && $args{'Signer'};
630 $gnupg->options->hash_init(
631 _PrepareGnuPGOptions( %opt ),
632 armor => 1,
633 meta_interactive => 0,
634 );
635
636 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
637 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
638 }
639
640 if ( $args{'Encrypt'} ) {
641 $gnupg->options->push_recipients( $_ ) foreach
642 map UseKeyForEncryption($_) || $_,
643 @{ $args{'Recipients'} || [] };
644 }
645
646 my %res;
647
648 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
649 binmode $tmp_fh, ':raw';
650
651 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
652 my %handle = %$handle_list;
653
654 $handles->options( 'stdout' )->{'direct'} = 1;
655 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
656
657 my $entity = $args{'Entity'};
658 eval {
659 local $SIG{'CHLD'} = 'DEFAULT';
660 my $method = $args{'Sign'} && $args{'Encrypt'}
661 ? 'sign_and_encrypt'
662 : ($args{'Sign'}? 'clearsign': 'encrypt');
663 my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
664 {
665 local $SIG{'PIPE'} = 'IGNORE';
666 $entity->bodyhandle->print( $handle{'stdin'} );
667 close $handle{'stdin'};
668 }
669 waitpid $pid, 0;
670 };
671 $res{'exit_code'} = $?;
672 my $err = $@;
673
674 foreach ( qw(stderr logger status) ) {
675 $res{$_} = do { local $/; readline $handle{$_} };
676 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
677 close $handle{$_};
678 }
679 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
680 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
681 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
682 if ( $err || $res{'exit_code'} ) {
683 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
684 return %res;
685 }
686
687 $entity->bodyhandle( MIME::Body::File->new( $tmp_fn) );
688 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
689
690 return %res;
691}
692
693sub _SignEncryptAttachmentInline {
694 my %args = (
695 Entity => undef,
696
697 Sign => 1,
698 Signer => undef,
699 Passphrase => undef,
700
701 Encrypt => 1,
702 Recipients => undef,
703
704 @_
705 );
706 return unless $args{'Sign'} || $args{'Encrypt'};
707
708 my $gnupg = GnuPG::Interface->new();
709 my %opt = RT->Config->Get('GnuPGOptions');
710
711 # handling passphrase in GnupGOptions
712 $args{'Passphrase'} = delete $opt{'passphrase'}
713 if !defined($args{'Passphrase'});
714
715 $opt{'digest-algo'} ||= 'SHA1';
716 $opt{'default_key'} = $args{'Signer'}
717 if $args{'Sign'} && $args{'Signer'};
718 $gnupg->options->hash_init(
719 _PrepareGnuPGOptions( %opt ),
720 armor => 1,
721 meta_interactive => 0,
722 );
723
724 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
725 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
726 }
727
728 my $entity = $args{'Entity'};
729 if ( $args{'Encrypt'} ) {
730 $gnupg->options->push_recipients( $_ ) foreach
731 map UseKeyForEncryption($_) || $_,
732 @{ $args{'Recipients'} || [] };
733 }
734
735 my %res;
736
737 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
738 binmode $tmp_fh, ':raw';
739
740 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
741 my %handle = %$handle_list;
742 $handles->options( 'stdout' )->{'direct'} = 1;
743 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
744
745 eval {
746 local $SIG{'CHLD'} = 'DEFAULT';
747 my $method = $args{'Sign'} && $args{'Encrypt'}
748 ? 'sign_and_encrypt'
749 : ($args{'Sign'}? 'detach_sign': 'encrypt');
750 my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
751 {
752 local $SIG{'PIPE'} = 'IGNORE';
753 $entity->bodyhandle->print( $handle{'stdin'} );
754 close $handle{'stdin'};
755 }
756 waitpid $pid, 0;
757 };
758 $res{'exit_code'} = $?;
759 my $err = $@;
760
761 foreach ( qw(stderr logger status) ) {
762 $res{$_} = do { local $/; readline $handle{$_} };
763 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
764 close $handle{$_};
765 }
766 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
767 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
768 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
769 if ( $err || $res{'exit_code'} ) {
770 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
771 return %res;
772 }
773
774 my $filename = mime_recommended_filename( $entity ) || 'no_name';
775 if ( $args{'Sign'} && !$args{'Encrypt'} ) {
776 $entity->make_multipart;
777 $entity->attach(
778 Type => 'application/octet-stream',
779 Path => $tmp_fn,
780 Filename => "$filename.sig",
781 Disposition => 'attachment',
782 );
783 } else {
784 $entity->bodyhandle(MIME::Body::File->new( $tmp_fn) );
785 $entity->effective_type('application/octet-stream');
786 $entity->head->mime_attr( $_ => "$filename.pgp" )
787 foreach (qw(Content-Type.name Content-Disposition.filename));
788
789 }
790 $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
791
792 return %res;
793}
794
795sub SignEncryptContent {
796 my %args = (
797 Content => undef,
798
799 Sign => 1,
800 Signer => undef,
801 Passphrase => undef,
802
803 Encrypt => 1,
804 Recipients => undef,
805
806 @_
807 );
808 return unless $args{'Sign'} || $args{'Encrypt'};
809
810 my $gnupg = GnuPG::Interface->new();
811 my %opt = RT->Config->Get('GnuPGOptions');
812
813 # handling passphrase in GnupGOptions
814 $args{'Passphrase'} = delete $opt{'passphrase'}
815 if !defined($args{'Passphrase'});
816
817 $opt{'digest-algo'} ||= 'SHA1';
818 $opt{'default_key'} = $args{'Signer'}
819 if $args{'Sign'} && $args{'Signer'};
820 $gnupg->options->hash_init(
821 _PrepareGnuPGOptions( %opt ),
822 armor => 1,
823 meta_interactive => 0,
824 );
825
826 if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
827 $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
828 }
829
830 if ( $args{'Encrypt'} ) {
831 $gnupg->options->push_recipients( $_ ) foreach
832 map UseKeyForEncryption($_) || $_,
833 @{ $args{'Recipients'} || [] };
834 }
835
836 my %res;
837
838 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
839 binmode $tmp_fh, ':raw';
840
841 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
842 my %handle = %$handle_list;
843 $handles->options( 'stdout' )->{'direct'} = 1;
844 $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};
845
846 eval {
847 local $SIG{'CHLD'} = 'DEFAULT';
848 my $method = $args{'Sign'} && $args{'Encrypt'}
849 ? 'sign_and_encrypt'
850 : ($args{'Sign'}? 'clearsign': 'encrypt');
851 my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
852 {
853 local $SIG{'PIPE'} = 'IGNORE';
854 $handle{'stdin'}->print( ${ $args{'Content'} } );
855 close $handle{'stdin'};
856 }
857 waitpid $pid, 0;
858 };
859 $res{'exit_code'} = $?;
860 my $err = $@;
861
862 foreach ( qw(stderr logger status) ) {
863 $res{$_} = do { local $/; readline $handle{$_} };
864 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
865 close $handle{$_};
866 }
867 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
868 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
869 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
870 if ( $err || $res{'exit_code'} ) {
871 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
872 return %res;
873 }
874
875 ${ $args{'Content'} } = '';
876 seek $tmp_fh, 0, 0;
877 while (1) {
878 my $status = read $tmp_fh, my $buf, 4*1024;
879 unless ( defined $status ) {
880 $RT::Logger->crit( "couldn't read message: $!" );
881 } elsif ( !$status ) {
882 last;
883 }
884 ${ $args{'Content'} } .= $buf;
885 }
886
887 return %res;
888}
889
890sub FindProtectedParts {
891 my %args = ( Entity => undef, CheckBody => 1, @_ );
892 my $entity = $args{'Entity'};
893
894 # inline PGP block, only in singlepart
895 unless ( $entity->is_multipart ) {
896 my $file = ($entity->head->recommended_filename||'') =~ /\.${RE_FILE_EXTENSIONS}$/;
897
898 my $io = $entity->open('r');
899 unless ( $io ) {
900 $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
901 return ();
902 }
903 while ( defined($_ = $io->getline) ) {
904 next unless /^-----BEGIN PGP (SIGNED )?MESSAGE-----/;
905 my $type = $1? 'signed': 'encrypted';
906 $RT::Logger->debug("Found $type inline part");
907 return {
908 Type => $type,
909 Format => !$file || $type eq 'signed'? 'Inline' : 'Attachment',
910 Data => $entity,
911 };
912 }
913 $io->close;
914 return ();
915 }
916
917 # RFC3156, multipart/{signed,encrypted}
918 if ( ( my $type = $entity->effective_type ) =~ /^multipart\/(?:encrypted|signed)$/ ) {
919 unless ( $entity->parts == 2 ) {
920 $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
921 return ();
922 }
923
924 my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
925 unless ( $protocol ) {
926 $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" );
927 return ();
928 }
929
930 if ( $type eq 'multipart/encrypted' ) {
931 unless ( $protocol eq 'application/pgp-encrypted' ) {
932 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" );
933 return ();
934 }
935 $RT::Logger->debug("Found encrypted according to RFC3156 part");
936 return {
937 Type => 'encrypted',
938 Format => 'RFC3156',
939 Top => $entity,
940 Data => $entity->parts(1),
941 Info => $entity->parts(0),
942 };
943 } else {
944 unless ( $protocol eq 'application/pgp-signature' ) {
945 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
946 return ();
947 }
948 $RT::Logger->debug("Found signed according to RFC3156 part");
949 return {
950 Type => 'signed',
951 Format => 'RFC3156',
952 Top => $entity,
953 Data => $entity->parts(0),
954 Signature => $entity->parts(1),
955 };
956 }
957 }
958
959 # attachments signed with signature in another part
960 my @file_indices;
961 foreach my $i ( 0 .. $entity->parts - 1 ) {
962 my $part = $entity->parts($i);
963
964 # we can not associate a signature within an attachment
965 # without file names
966 my $fname = $part->head->recommended_filename;
967 next unless $fname;
968
969 if ( $part->effective_type eq 'application/pgp-signature' ) {
970 push @file_indices, $i;
971 }
972 elsif ( $fname =~ /\.sig$/i && $part->effective_type eq 'application/octet-stream' ) {
973 push @file_indices, $i;
974 }
975 }
976
977 my (@res, %skip);
978 foreach my $i ( @file_indices ) {
979 my $sig_part = $entity->parts($i);
980 $skip{"$sig_part"}++;
981 my $sig_name = $sig_part->head->recommended_filename;
982 my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/;
983
984 my ($data_part_idx) =
985 grep $file_name eq ($entity->parts($_)->head->recommended_filename||''),
986 grep $sig_part ne $entity->parts($_),
987 0 .. $entity->parts - 1;
988 unless ( defined $data_part_idx ) {
989 $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
990 next;
991 }
992 my $data_part_in = $entity->parts($data_part_idx);
993
994 $skip{"$data_part_in"}++;
995 $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
996 push @res, {
997 Type => 'signed',
998 Format => 'Attachment',
999 Top => $entity,
1000 Data => $data_part_in,
1001 Signature => $sig_part,
1002 };
1003 }
1004
1005 # attachments with inline encryption
1006 my @encrypted_indices =
1007 grep {($entity->parts($_)->head->recommended_filename || '') =~ /\.${RE_FILE_EXTENSIONS}$/}
1008 0 .. $entity->parts - 1;
1009
1010 foreach my $i ( @encrypted_indices ) {
1011 my $part = $entity->parts($i);
1012 $skip{"$part"}++;
1013 $RT::Logger->debug("Found encrypted attachment '". $part->head->recommended_filename ."'");
1014 push @res, {
1015 Type => 'encrypted',
1016 Format => 'Attachment',
1017 Top => $entity,
1018 Data => $part,
1019 };
1020 }
1021
1022 push @res, FindProtectedParts( Entity => $_ )
1023 foreach grep !$skip{"$_"}, $entity->parts;
1024
1025 return @res;
1026}
1027
1028=head2 VerifyDecrypt Entity => undef, [ Detach => 1, Passphrase => undef, SetStatus => 1 ]
1029
1030=cut
1031
1032sub VerifyDecrypt {
1033 my %args = (
1034 Entity => undef,
1035 Detach => 1,
1036 SetStatus => 1,
1037 AddStatus => 0,
1038 @_
1039 );
1040 my @protected = FindProtectedParts( Entity => $args{'Entity'} );
1041 my @res;
1042 # XXX: detaching may brake nested signatures
1043 foreach my $item( grep $_->{'Type'} eq 'signed', @protected ) {
1044 my $status_on;
1045 if ( $item->{'Format'} eq 'RFC3156' ) {
1046 push @res, { VerifyRFC3156( %$item, SetStatus => $args{'SetStatus'} ) };
1047 if ( $args{'Detach'} ) {
1048 $item->{'Top'}->parts( [ $item->{'Data'} ] );
1049 $item->{'Top'}->make_singlepart;
1050 }
1051 $status_on = $item->{'Top'};
1052 } elsif ( $item->{'Format'} eq 'Inline' ) {
1053 push @res, { VerifyInline( %$item ) };
1054 $status_on = $item->{'Data'};
1055 } elsif ( $item->{'Format'} eq 'Attachment' ) {
1056 push @res, { VerifyAttachment( %$item ) };
1057 if ( $args{'Detach'} ) {
1058 $item->{'Top'}->parts( [
1059 grep "$_" ne $item->{'Signature'}, $item->{'Top'}->parts
1060 ] );
1061 $item->{'Top'}->make_singlepart;
1062 }
1063 $status_on = $item->{'Data'};
1064 }
1065 if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
1066 my $method = $args{'AddStatus'} ? 'add' : 'set';
1067 $status_on->head->$method(
1068 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
1069 );
1070 }
1071 }
1072 foreach my $item( grep $_->{'Type'} eq 'encrypted', @protected ) {
1073 my $status_on;
1074 if ( $item->{'Format'} eq 'RFC3156' ) {
1075 push @res, { DecryptRFC3156( %$item ) };
1076 $status_on = $item->{'Top'};
1077 } elsif ( $item->{'Format'} eq 'Inline' ) {
1078 push @res, { DecryptInline( %$item ) };
1079 $status_on = $item->{'Data'};
1080 } elsif ( $item->{'Format'} eq 'Attachment' ) {
1081 push @res, { DecryptAttachment( %$item ) };
1082 $status_on = $item->{'Data'};
1083 }
1084 if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
1085 my $method = $args{'AddStatus'} ? 'add' : 'set';
1086 $status_on->head->$method(
1087 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
1088 );
1089 }
1090 }
1091 return @res;
1092}
1093
1094sub VerifyInline { return DecryptInline( @_ ) }
1095
1096sub VerifyAttachment {
1097 my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
1098
1099 my $gnupg = GnuPG::Interface->new();
1100 my %opt = RT->Config->Get('GnuPGOptions');
1101 $opt{'digest-algo'} ||= 'SHA1';
1102 $gnupg->options->hash_init(
1103 _PrepareGnuPGOptions( %opt ),
1104 meta_interactive => 0,
1105 );
1106
1107 foreach ( $args{'Data'}, $args{'Signature'} ) {
1108 next unless $_->bodyhandle->is_encoded;
1109
1110 require RT::EmailParser;
1111 RT::EmailParser->_DecodeBody($_);
1112 }
1113
1114 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1115 binmode $tmp_fh, ':raw';
1116 $args{'Data'}->bodyhandle->print( $tmp_fh );
1117 $tmp_fh->flush;
1118
1119 my ($handles, $handle_list) = _make_gpg_handles();
1120 my %handle = %$handle_list;
1121
1122 my %res;
1123 eval {
1124 local $SIG{'CHLD'} = 'DEFAULT';
1125 my $pid = safe_run_child { $gnupg->verify(
1126 handles => $handles, command_args => [ '-', $tmp_fn ]
1127 ) };
1128 {
1129 local $SIG{'PIPE'} = 'IGNORE';
1130 $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
1131 close $handle{'stdin'};
1132 }
1133 waitpid $pid, 0;
1134 };
1135 $res{'exit_code'} = $?;
1136 foreach ( qw(stderr logger status) ) {
1137 $res{$_} = do { local $/; readline $handle{$_} };
1138 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1139 close $handle{$_};
1140 }
1141 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1142 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1143 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1144 if ( $@ || $? ) {
1145 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1146 }
1147 return %res;
1148}
1149
1150sub VerifyRFC3156 {
1151 my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
1152
1153 my $gnupg = GnuPG::Interface->new();
1154 my %opt = RT->Config->Get('GnuPGOptions');
1155 $opt{'digest-algo'} ||= 'SHA1';
1156 $gnupg->options->hash_init(
1157 _PrepareGnuPGOptions( %opt ),
1158 meta_interactive => 0,
1159 );
1160
1161 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1162 binmode $tmp_fh, ':raw:eol(CRLF?)';
1163 $args{'Data'}->print( $tmp_fh );
1164 $tmp_fh->flush;
1165
1166 my ($handles, $handle_list) = _make_gpg_handles();
1167 my %handle = %$handle_list;
1168
1169 my %res;
1170 eval {
1171 local $SIG{'CHLD'} = 'DEFAULT';
1172 my $pid = safe_run_child { $gnupg->verify(
1173 handles => $handles, command_args => [ '-', $tmp_fn ]
1174 ) };
1175 {
1176 local $SIG{'PIPE'} = 'IGNORE';
1177 $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
1178 close $handle{'stdin'};
1179 }
1180 waitpid $pid, 0;
1181 };
1182 $res{'exit_code'} = $?;
1183 foreach ( qw(stderr logger status) ) {
1184 $res{$_} = do { local $/; readline $handle{$_} };
1185 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1186 close $handle{$_};
1187 }
1188 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1189 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1190 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1191 if ( $@ || $? ) {
1192 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1193 }
1194 return %res;
1195}
1196
1197sub DecryptRFC3156 {
1198 my %args = (
1199 Data => undef,
1200 Info => undef,
1201 Top => undef,
1202 Passphrase => undef,
1203 @_
1204 );
1205
1206 my $gnupg = GnuPG::Interface->new();
1207 my %opt = RT->Config->Get('GnuPGOptions');
1208
1209 # handling passphrase in GnupGOptions
1210 $args{'Passphrase'} = delete $opt{'passphrase'}
1211 if !defined($args{'Passphrase'});
1212
1213 $opt{'digest-algo'} ||= 'SHA1';
1214 $gnupg->options->hash_init(
1215 _PrepareGnuPGOptions( %opt ),
1216 meta_interactive => 0,
1217 );
1218
1219 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1220 require RT::EmailParser;
1221 RT::EmailParser->_DecodeBody($args{'Data'});
1222 }
1223
1224 $args{'Passphrase'} = GetPassphrase()
1225 unless defined $args{'Passphrase'};
1226
1227 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1228 binmode $tmp_fh, ':raw';
1229
1230 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
1231 my %handle = %$handle_list;
1232 $handles->options( 'stdout' )->{'direct'} = 1;
1233
1234 my %res;
1235 eval {
1236 local $SIG{'CHLD'} = 'DEFAULT';
1237 $gnupg->passphrase( $args{'Passphrase'} );
1238 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1239 {
1240 local $SIG{'PIPE'} = 'IGNORE';
1241 $args{'Data'}->bodyhandle->print( $handle{'stdin'} );
1242 close $handle{'stdin'}
1243 }
1244
1245 waitpid $pid, 0;
1246 };
1247 $res{'exit_code'} = $?;
1248 foreach ( qw(stderr logger status) ) {
1249 $res{$_} = do { local $/; readline $handle{$_} };
1250 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1251 close $handle{$_};
1252 }
1253 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1254 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1255 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1256
1257 # if the decryption is fine but the signature is bad, then without this
1258 # status check we lose the decrypted text
1259 # XXX: add argument to the function to control this check
1260 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1261 if ( $@ || $? ) {
1262 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1263 return %res;
1264 }
1265 }
1266
1267 seek $tmp_fh, 0, 0;
1268 my $parser = RT::EmailParser->new();
1269 my $decrypted = $parser->ParseMIMEEntityFromFileHandle( $tmp_fh, 0 );
1270 $decrypted->{'__store_link_to_object_to_avoid_early_cleanup'} = $parser;
1271 $args{'Top'}->parts( [] );
1272 $args{'Top'}->add_part( $decrypted );
1273 $args{'Top'}->make_singlepart;
1274 return %res;
1275}
1276
1277sub DecryptInline {
1278 my %args = (
1279 Data => undef,
1280 Passphrase => undef,
1281 @_
1282 );
1283
1284 my $gnupg = GnuPG::Interface->new();
1285 my %opt = RT->Config->Get('GnuPGOptions');
1286
1287 # handling passphrase in GnuPGOptions
1288 $args{'Passphrase'} = delete $opt{'passphrase'}
1289 if !defined($args{'Passphrase'});
1290
1291 $opt{'digest-algo'} ||= 'SHA1';
1292 $gnupg->options->hash_init(
1293 _PrepareGnuPGOptions( %opt ),
1294 meta_interactive => 0,
1295 );
1296
1297 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1298 require RT::EmailParser;
1299 RT::EmailParser->_DecodeBody($args{'Data'});
1300 }
1301
1302 $args{'Passphrase'} = GetPassphrase()
1303 unless defined $args{'Passphrase'};
1304
1305 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1306 binmode $tmp_fh, ':raw';
1307
1308 my $io = $args{'Data'}->open('r');
1309 unless ( $io ) {
1310 die "Entity has no body, never should happen";
1311 }
1312
1313 my %res;
1314
1315 my ($had_literal, $in_block) = ('', 0);
1316 my ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1317 binmode $block_fh, ':raw';
1318
1319 while ( defined(my $str = $io->getline) ) {
1320 if ( $in_block && $str =~ /^-----END PGP (?:MESSAGE|SIGNATURE)-----/ ) {
1321 print $block_fh $str;
1322 $in_block--;
1323 next if $in_block > 0;
1324
1325 seek $block_fh, 0, 0;
1326
1327 my ($res_fh, $res_fn);
1328 ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1329 %args,
1330 GnuPG => $gnupg,
1331 BlockHandle => $block_fh,
1332 );
1333 return %res unless $res_fh;
1334
1335 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1336 while (my $buf = <$res_fh> ) {
1337 print $tmp_fh $buf;
1338 }
1339 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1340
1341 ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1342 binmode $block_fh, ':raw';
1343 $in_block = 0;
1344 }
1345 elsif ( $str =~ /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) {
1346 $in_block++;
1347 print $block_fh $str;
1348 }
1349 elsif ( $in_block ) {
1350 print $block_fh $str;
1351 }
1352 else {
1353 print $tmp_fh $str;
1354 $had_literal = 1 if /\S/s;
1355 }
1356 }
1357 $io->close;
1358
1359 if ( $in_block ) {
1360 # we're still in a block, this not bad not good. let's try to
1361 # decrypt what we have, it can be just missing -----END PGP...
1362 seek $block_fh, 0, 0;
1363
1364 my ($res_fh, $res_fn);
1365 ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1366 %args,
1367 GnuPG => $gnupg,
1368 BlockHandle => $block_fh,
1369 );
1370 return %res unless $res_fh;
1371
1372 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1373 while (my $buf = <$res_fh> ) {
1374 print $tmp_fh $buf;
1375 }
1376 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1377 }
1378
1379 seek $tmp_fh, 0, 0;
1380 $args{'Data'}->bodyhandle(MIME::Body::File->new( $tmp_fn ));
1381 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
1382 return %res;
1383}
1384
1385sub _DecryptInlineBlock {
1386 my %args = (
1387 GnuPG => undef,
1388 BlockHandle => undef,
1389 Passphrase => undef,
1390 @_
1391 );
1392 my $gnupg = $args{'GnuPG'};
1393
1394 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1395 binmode $tmp_fh, ':raw';
1396
1397 my ($handles, $handle_list) = _make_gpg_handles(
1398 stdin => $args{'BlockHandle'},
1399 stdout => $tmp_fh);
1400 my %handle = %$handle_list;
1401 $handles->options( 'stdout' )->{'direct'} = 1;
1402 $handles->options( 'stdin' )->{'direct'} = 1;
1403
1404 my %res;
1405 eval {
1406 local $SIG{'CHLD'} = 'DEFAULT';
1407 $gnupg->passphrase( $args{'Passphrase'} );
1408 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1409 waitpid $pid, 0;
1410 };
1411 $res{'exit_code'} = $?;
1412 foreach ( qw(stderr logger status) ) {
1413 $res{$_} = do { local $/; readline $handle{$_} };
1414 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1415 close $handle{$_};
1416 }
1417 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1418 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1419 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1420
1421 # if the decryption is fine but the signature is bad, then without this
1422 # status check we lose the decrypted text
1423 # XXX: add argument to the function to control this check
1424 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1425 if ( $@ || $? ) {
1426 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1427 return (undef, undef, %res);
1428 }
1429 }
1430
1431 seek $tmp_fh, 0, 0;
1432 return ($tmp_fh, $tmp_fn, %res);
1433}
1434
1435sub DecryptAttachment {
1436 my %args = (
1437 Top => undef,
1438 Data => undef,
1439 Passphrase => undef,
1440 @_
1441 );
1442
1443 my $gnupg = GnuPG::Interface->new();
1444 my %opt = RT->Config->Get('GnuPGOptions');
1445
1446 # handling passphrase in GnuPGOptions
1447 $args{'Passphrase'} = delete $opt{'passphrase'}
1448 if !defined($args{'Passphrase'});
1449
1450 $opt{'digest-algo'} ||= 'SHA1';
1451 $gnupg->options->hash_init(
1452 _PrepareGnuPGOptions( %opt ),
1453 meta_interactive => 0,
1454 );
1455
1456 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1457 require RT::EmailParser;
1458 RT::EmailParser->_DecodeBody($args{'Data'});
1459 }
1460
1461 $args{'Passphrase'} = GetPassphrase()
1462 unless defined $args{'Passphrase'};
1463
1464 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1465 binmode $tmp_fh, ':raw';
1466 $args{'Data'}->bodyhandle->print( $tmp_fh );
1467 seek $tmp_fh, 0, 0;
1468
1469 my ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1470 %args,
1471 GnuPG => $gnupg,
1472 BlockHandle => $tmp_fh,
1473 );
1474 return %res unless $res_fh;
1475
1476 $args{'Data'}->bodyhandle(MIME::Body::File->new($res_fn) );
1477 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $res_fh;
1478
1479 my $head = $args{'Data'}->head;
1480
1481 # we can not trust original content type
1482 # TODO: and don't have way to detect, so we just use octet-stream
1483 # some clients may send .asc files (encryped) as text/plain
1484 $head->mime_attr( "Content-Type" => 'application/octet-stream' );
1485
1486 my $filename = $head->recommended_filename;
1487 $filename =~ s/\.${RE_FILE_EXTENSIONS}$//i;
1488 $head->mime_attr( $_ => $filename )
1489 foreach (qw(Content-Type.name Content-Disposition.filename));
1490
1491 return %res;
1492}
1493
1494sub DecryptContent {
1495 my %args = (
1496 Content => undef,
1497 Passphrase => undef,
1498 @_
1499 );
1500
1501 my $gnupg = GnuPG::Interface->new();
1502 my %opt = RT->Config->Get('GnuPGOptions');
1503
1504 # handling passphrase in GnupGOptions
1505 $args{'Passphrase'} = delete $opt{'passphrase'}
1506 if !defined($args{'Passphrase'});
1507
1508 $opt{'digest-algo'} ||= 'SHA1';
1509 $gnupg->options->hash_init(
1510 _PrepareGnuPGOptions( %opt ),
1511 meta_interactive => 0,
1512 );
1513
1514 $args{'Passphrase'} = GetPassphrase()
1515 unless defined $args{'Passphrase'};
1516
1517 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1518 binmode $tmp_fh, ':raw';
1519
1520 my ($handles, $handle_list) = _make_gpg_handles(
1521 stdout => $tmp_fh);
1522 my %handle = %$handle_list;
1523 $handles->options( 'stdout' )->{'direct'} = 1;
1524
1525 my %res;
1526 eval {
1527 local $SIG{'CHLD'} = 'DEFAULT';
1528 $gnupg->passphrase( $args{'Passphrase'} );
1529 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1530 {
1531 local $SIG{'PIPE'} = 'IGNORE';
1532 print { $handle{'stdin'} } ${ $args{'Content'} };
1533 close $handle{'stdin'};
1534 }
1535
1536 waitpid $pid, 0;
1537 };
1538 $res{'exit_code'} = $?;
1539 foreach ( qw(stderr logger status) ) {
1540 $res{$_} = do { local $/; readline $handle{$_} };
1541 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1542 close $handle{$_};
1543 }
1544 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1545 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1546 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1547
1548 # if the decryption is fine but the signature is bad, then without this
1549 # status check we lose the decrypted text
1550 # XXX: add argument to the function to control this check
1551 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1552 if ( $@ || $? ) {
1553 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1554 return %res;
1555 }
1556 }
1557
1558 ${ $args{'Content'} } = '';
1559 seek $tmp_fh, 0, 0;
1560 while (1) {
1561 my $status = read $tmp_fh, my $buf, 4*1024;
1562 unless ( defined $status ) {
1563 $RT::Logger->crit( "couldn't read message: $!" );
1564 } elsif ( !$status ) {
1565 last;
1566 }
1567 ${ $args{'Content'} } .= $buf;
1568 }
1569
1570 return %res;
1571}
1572
1573=head2 GetPassphrase [ Address => undef ]
1574
1575Returns passphrase, called whenever it's required with Address as a named argument.
1576
1577=cut
1578
1579sub GetPassphrase {
1580 my %args = ( Address => undef, @_ );
1581 return 'test';
1582}
1583
1584=head2 ParseStatus
1585
1586Takes a string containing output of gnupg status stream. Parses it and returns
1587array of hashes. Each element of array is a hash ref and represents line or
1588group of lines in the status message.
1589
1590All hashes have Operation, Status and Message elements.
1591
1592=over
1593
1594=item Operation
1595
1596Classification of operations gnupg performs. Now we have support
1597for Sign, Encrypt, Decrypt, Verify, PassphraseCheck, RecipientsCheck and Data
1598values.
1599
1600=item Status
1601
1602Informs about success. Value is 'DONE' on success, other values means that
1603an operation failed, for example 'ERROR', 'BAD', 'MISSING' and may be other.
1604
1605=item Message
1606
1607User friendly message.
1608
1609=back
1610
1611This parser is based on information from GnuPG distribution.
1612
1613=cut
1614
1615my %REASON_CODE_TO_TEXT = (
1616 NODATA => {
1617 1 => "No armored data",
1618 2 => "Expected a packet, but did not found one",
1619 3 => "Invalid packet found",
1620 4 => "Signature expected, but not found",
1621 },
1622 INV_RECP => {
1623 0 => "No specific reason given",
1624 1 => "Not Found",
1625 2 => "Ambigious specification",
1626 3 => "Wrong key usage",
1627 4 => "Key revoked",
1628 5 => "Key expired",
1629 6 => "No CRL known",
1630 7 => "CRL too old",
1631 8 => "Policy mismatch",
1632 9 => "Not a secret key",
1633 10 => "Key not trusted",
1634 },
1635 ERRSIG => {
1636 0 => 'not specified',
1637 4 => 'unknown algorithm',
1638 9 => 'missing public key',
1639 },
1640);
1641
1642sub ReasonCodeToText {
1643 my $keyword = shift;
1644 my $code = shift;
1645 return $REASON_CODE_TO_TEXT{ $keyword }{ $code }
1646 if exists $REASON_CODE_TO_TEXT{ $keyword }{ $code };
1647 return 'unknown';
1648}
1649
1650my %simple_keyword = (
1651 NO_RECP => {
1652 Operation => 'RecipientsCheck',
1653 Status => 'ERROR',
1654 Message => 'No recipients',
1655 },
1656 UNEXPECTED => {
1657 Operation => 'Data',
1658 Status => 'ERROR',
1659 Message => 'Unexpected data has been encountered',
1660 },
1661 BADARMOR => {
1662 Operation => 'Data',
1663 Status => 'ERROR',
1664 Message => 'The ASCII armor is corrupted',
1665 },
1666);
1667
1668# keywords we parse
1669my %parse_keyword = map { $_ => 1 } qw(
1670 USERID_HINT
1671 SIG_CREATED GOODSIG BADSIG ERRSIG
1672 END_ENCRYPTION
1673 DECRYPTION_FAILED DECRYPTION_OKAY
1674 BAD_PASSPHRASE GOOD_PASSPHRASE
1675 NO_SECKEY NO_PUBKEY
1676 NO_RECP INV_RECP NODATA UNEXPECTED
1677);
1678
1679# keywords we ignore without any messages as we parse them using other
1680# keywords as starting point or just ignore as they are useless for us
1681my %ignore_keyword = map { $_ => 1 } qw(
1682 NEED_PASSPHRASE MISSING_PASSPHRASE BEGIN_SIGNING PLAINTEXT PLAINTEXT_LENGTH
1683 BEGIN_ENCRYPTION SIG_ID VALIDSIG
1684 ENC_TO BEGIN_DECRYPTION END_DECRYPTION GOODMDC
1685 TRUST_UNDEFINED TRUST_NEVER TRUST_MARGINAL TRUST_FULLY TRUST_ULTIMATE
1686);
1687
1688sub ParseStatus {
1689 my $status = shift;
1690 return () unless $status;
1691
1692 my @status;
1693 while ( $status =~ /\[GNUPG:\]\s*(.*?)(?=\[GNUPG:\]|\z)/igms ) {
1694 push @status, $1; $status[-1] =~ s/\s+/ /g; $status[-1] =~ s/\s+$//;
1695 }
1696 $status = join "\n", @status;
1697 study $status;
1698
1699 my @res;
1700 my (%user_hint, $latest_user_main_key);
1701 for ( my $i = 0; $i < @status; $i++ ) {
1702 my $line = $status[$i];
1703 my ($keyword, $args) = ($line =~ /^(\S+)\s*(.*)$/s);
1704 if ( $simple_keyword{ $keyword } ) {
1705 push @res, $simple_keyword{ $keyword };
1706 $res[-1]->{'Keyword'} = $keyword;
1707 next;
1708 }
1709 unless ( $parse_keyword{ $keyword } ) {
1710 $RT::Logger->warning("Skipped $keyword") unless $ignore_keyword{ $keyword };
1711 next;
1712 }
1713
1714 if ( $keyword eq 'USERID_HINT' ) {
1715 my %tmp = _ParseUserHint($status, $line);
1716 $latest_user_main_key = $tmp{'MainKey'};
1717 if ( $user_hint{ $tmp{'MainKey'} } ) {
1718 while ( my ($k, $v) = each %tmp ) {
1719 $user_hint{ $tmp{'MainKey'} }->{$k} = $v;
1720 }
1721 } else {
1722 $user_hint{ $tmp{'MainKey'} } = \%tmp;
1723 }
1724 next;
1725 }
1726 elsif ( $keyword eq 'BAD_PASSPHRASE' || $keyword eq 'GOOD_PASSPHRASE' ) {
1727 my $key_id = $args;
1728 my %res = (
1729 Operation => 'PassphraseCheck',
1730 Status => $keyword eq 'BAD_PASSPHRASE'? 'BAD' : 'DONE',
1731 Key => $key_id,
1732 );
1733 $res{'Status'} = 'MISSING' if $status[ $i - 1 ] =~ /^MISSING_PASSPHRASE/;
1734 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1735 next unless $line =~ /^NEED_PASSPHRASE\s+(\S+)\s+(\S+)\s+(\S+)/;
1736 next if $key_id && $2 ne $key_id;
1737 @res{'MainKey', 'Key', 'KeyType'} = ($1, $2, $3);
1738 last;
1739 }
1740 $res{'Message'} = ucfirst( lc( $res{'Status'} eq 'DONE'? 'GOOD': $res{'Status'} ) ) .' passphrase';
1741 $res{'User'} = ( $user_hint{ $res{'MainKey'} } ||= {} ) if $res{'MainKey'};
1742 if ( exists $res{'User'}->{'EmailAddress'} ) {
1743 $res{'Message'} .= ' for '. $res{'User'}->{'EmailAddress'};
1744 } else {
1745 $res{'Message'} .= " for '0x$key_id'";
1746 }
1747 push @res, \%res;
1748 }
1749 elsif ( $keyword eq 'END_ENCRYPTION' ) {
1750 my %res = (
1751 Operation => 'Encrypt',
1752 Status => 'DONE',
1753 Message => 'Data has been encrypted',
1754 );
1755 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1756 next unless $line =~ /^BEGIN_ENCRYPTION\s+(\S+)\s+(\S+)/;
1757 @res{'MdcMethod', 'SymAlgo'} = ($1, $2);
1758 last;
1759 }
1760 push @res, \%res;
1761 }
1762 elsif ( $keyword eq 'DECRYPTION_FAILED' || $keyword eq 'DECRYPTION_OKAY' ) {
1763 my %res = ( Operation => 'Decrypt' );
1764 @res{'Status', 'Message'} =
1765 $keyword eq 'DECRYPTION_FAILED'
1766 ? ('ERROR', 'Decryption failed')
1767 : ('DONE', 'Decryption process succeeded');
1768
1769 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1770 next unless $line =~ /^ENC_TO\s+(\S+)\s+(\S+)\s+(\S+)/;
1771 my ($key, $alg, $key_length) = ($1, $2, $3);
1772
1773 my %encrypted_to = (
1774 Message => "The message is encrypted to '0x$key'",
1775 User => ( $user_hint{ $key } ||= {} ),
1776 Key => $key,
1777 KeyLength => $key_length,
1778 Algorithm => $alg,
1779 );
1780
1781 push @{ $res{'EncryptedTo'} ||= [] }, \%encrypted_to;
1782 }
1783
1784 push @res, \%res;
1785 }
1786 elsif ( $keyword eq 'NO_SECKEY' || $keyword eq 'NO_PUBKEY' ) {
1787 my ($key) = split /\s+/, $args;
1788 my $type = $keyword eq 'NO_SECKEY'? 'secret': 'public';
1789 my %res = (
1790 Operation => 'KeyCheck',
1791 Status => 'MISSING',
1792 Message => ucfirst( $type ) ." key '0x$key' is not available",
1793 Key => $key,
1794 KeyType => $type,
1795 );
1796 $res{'User'} = ( $user_hint{ $key } ||= {} );
1797 $res{'User'}{ ucfirst( $type ). 'KeyMissing' } = 1;
1798 push @res, \%res;
1799 }
1800 # GOODSIG, BADSIG, VALIDSIG, TRUST_*
1801 elsif ( $keyword eq 'GOODSIG' ) {
1802 my %res = (
1803 Operation => 'Verify',
1804 Status => 'DONE',
1805 Message => 'The signature is good',
1806 );
1807 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1808 $res{'Message'} .= ', signed by '. $res{'UserString'};
1809
1810 foreach my $line ( @status[ $i .. $#status ] ) {
1811 next unless $line =~ /^TRUST_(\S+)/;
1812 $res{'Trust'} = $1;
1813 last;
1814 }
1815 $res{'Message'} .= ', trust level is '. lc( $res{'Trust'} || 'unknown');
1816
1817 foreach my $line ( @status[ $i .. $#status ] ) {
1818 next unless $line =~ /^VALIDSIG\s+(.*)/;
1819 @res{ qw(
1820 Fingerprint
1821 CreationDate
1822 Timestamp
1823 ExpireTimestamp
1824 Version
1825 Reserved
1826 PubkeyAlgo
1827 HashAlgo
1828 Class
1829 PKFingerprint
1830 Other
1831 ) } = split /\s+/, $1, 10;
1832 last;
1833 }
1834 push @res, \%res;
1835 }
1836 elsif ( $keyword eq 'BADSIG' ) {
1837 my %res = (
1838 Operation => 'Verify',
1839 Status => 'BAD',
1840 Message => 'The signature has not been verified okay',
1841 );
1842 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1843 push @res, \%res;
1844 }
1845 elsif ( $keyword eq 'ERRSIG' ) {
1846 my %res = (
1847 Operation => 'Verify',
1848 Status => 'ERROR',
1849 Message => 'Not possible to check the signature',
1850 );
1851 @res{qw(Key PubkeyAlgo HashAlgo Class Timestamp ReasonCode Other)}
1852 = split /\s+/, $args, 7;
1853
1854 $res{'Reason'} = ReasonCodeToText( $keyword, $res{'ReasonCode'} );
1855 $res{'Message'} .= ", the reason is ". $res{'Reason'};
1856
1857 push @res, \%res;
1858 }
1859 elsif ( $keyword eq 'SIG_CREATED' ) {
1860 # SIG_CREATED <type> <pubkey algo> <hash algo> <class> <timestamp> <key fpr>
1861 my @props = split /\s+/, $args;
1862 push @res, {
1863 Operation => 'Sign',
1864 Status => 'DONE',
1865 Message => "Signed message",
1866 Type => $props[0],
1867 PubKeyAlgo => $props[1],
1868 HashKeyAlgo => $props[2],
1869 Class => $props[3],
1870 Timestamp => $props[4],
1871 KeyFingerprint => $props[5],
1872 User => $user_hint{ $latest_user_main_key },
1873 };
1874 $res[-1]->{Message} .= ' by '. $user_hint{ $latest_user_main_key }->{'EmailAddress'}
1875 if $user_hint{ $latest_user_main_key };
1876 }
1877 elsif ( $keyword eq 'INV_RECP' ) {
1878 my ($rcode, $recipient) = split /\s+/, $args, 2;
1879 my $reason = ReasonCodeToText( $keyword, $rcode );
1880 push @res, {
1881 Operation => 'RecipientsCheck',
1882 Status => 'ERROR',
1883 Message => "Recipient '$recipient' is unusable, the reason is '$reason'",
1884 Recipient => $recipient,
1885 ReasonCode => $rcode,
1886 Reason => $reason,
1887 };
1888 }
1889 elsif ( $keyword eq 'NODATA' ) {
1890 my $rcode = (split /\s+/, $args)[0];
1891 my $reason = ReasonCodeToText( $keyword, $rcode );
1892 push @res, {
1893 Operation => 'Data',
1894 Status => 'ERROR',
1895 Message => "No data has been found. The reason is '$reason'",
1896 ReasonCode => $rcode,
1897 Reason => $reason,
1898 };
1899 }
1900 else {
1901 $RT::Logger->warning("Keyword $keyword is unknown");
1902 next;
1903 }
1904 $res[-1]{'Keyword'} = $keyword if @res && !$res[-1]{'Keyword'};
1905 }
1906 return @res;
1907}
1908
1909sub _ParseUserHint {
1910 my ($status, $hint) = (@_);
1911 my ($main_key_id, $user_str) = ($hint =~ /^USERID_HINT\s+(\S+)\s+(.*)$/);
1912 return () unless $main_key_id;
1913 return (
1914 MainKey => $main_key_id,
1915 String => $user_str,
1916 EmailAddress => (map $_->address, Email::Address->parse( $user_str ))[0],
1917 );
1918}
1919
1920sub _PrepareGnuPGOptions {
1921 my %opt = @_;
1922 my %res = map { lc $_ => $opt{ $_ } } grep $supported_opt{ lc $_ }, keys %opt;
1923 $res{'extra_args'} ||= [];
1924 foreach my $o ( grep !$supported_opt{ lc $_ }, keys %opt ) {
1925 push @{ $res{'extra_args'} }, '--'. lc $o;
1926 push @{ $res{'extra_args'} }, $opt{ $o }
1927 if defined $opt{ $o };
1928 }
1929 return %res;
1930}
1931
1932{ my %key;
1933# no args -> clear
1934# one arg -> return preferred key
1935# many -> set
1936sub UseKeyForEncryption {
1937 unless ( @_ ) {
1938 %key = ();
1939 } elsif ( @_ > 1 ) {
1940 %key = (%key, @_);
1941 $key{ lc($_) } = delete $key{ $_ } foreach grep lc ne $_, keys %key;
1942 } else {
1943 return $key{ $_[0] };
1944 }
1945 return ();
1946} }
1947
1948=head2 UseKeyForSigning
1949
1950Returns or sets identifier of the key that should be used for signing.
1951
1952Returns the current value when called without arguments.
1953
1954Sets new value when called with one argument and unsets if it's undef.
1955
1956=cut
1957
1958{ my $key;
1959sub UseKeyForSigning {
1960 if ( @_ ) {
1961 $key = $_[0];
1962 }
1963 return $key;
1964} }
1965
1966=head2 GetKeysForEncryption
1967
1968Takes identifier and returns keys suitable for encryption.
1969
1970B<Note> that keys for which trust level is not set are
1971also listed.
1972
1973=cut
1974
1975sub GetKeysForEncryption {
1976 my $key_id = shift;
1977 my %res = GetKeysInfo( $key_id, 'public', @_ );
1978 return %res if $res{'exit_code'};
1979 return %res unless $res{'info'};
1980
1981 foreach my $key ( splice @{ $res{'info'} } ) {
1982 # skip disabled keys
1983 next if $key->{'Capabilities'} =~ /D/;
1984 # skip keys not suitable for encryption
1985 next unless $key->{'Capabilities'} =~ /e/i;
1986 # skip disabled, expired, revoke and keys with no trust,
1987 # but leave keys with unknown trust level
1988 next if $key->{'TrustLevel'} < 0;
1989
1990 push @{ $res{'info'} }, $key;
1991 }
1992 delete $res{'info'} unless @{ $res{'info'} };
1993 return %res;
1994}
1995
1996sub GetKeysForSigning {
1997 my $key_id = shift;
1998 return GetKeysInfo( $key_id, 'private', @_ );
1999}
2000
2001sub CheckRecipients {
2002 my @recipients = (@_);
2003
2004 my ($status, @issues) = (1, ());
2005
2006 my %seen;
2007 foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) {
2008 my %res = GetKeysForEncryption( $address );
2009 if ( $res{'info'} && @{ $res{'info'} } == 1 && $res{'info'}[0]{'TrustLevel'} > 0 ) {
2010 # good, one suitable and trusted key
2011 next;
2012 }
2013 my $user = RT::User->new( RT->SystemUser );
2014 $user->LoadByEmail( $address );
2015 # it's possible that we have no User record with the email
2016 $user = undef unless $user->id;
2017
2018 if ( my $fpr = UseKeyForEncryption( $address ) ) {
2019 if ( $res{'info'} && @{ $res{'info'} } ) {
2020 next if
2021 grep lc $_->{'Fingerprint'} eq lc $fpr,
2022 grep $_->{'TrustLevel'} > 0,
2023 @{ $res{'info'} };
2024 }
2025
2026 $status = 0;
2027 my %issue = (
2028 EmailAddress => $address,
2029 $user? (User => $user) : (),
2030 Keys => undef,
2031 );
2032 $issue{'Message'} = "Selected key either is not trusted or doesn't exist anymore."; #loc
2033 push @issues, \%issue;
2034 next;
2035 }
2036
2037 my $prefered_key;
2038 $prefered_key = $user->PreferredKey if $user;
2039 #XXX: prefered key is not yet implemented...
2040
2041 # classify errors
2042 $status = 0;
2043 my %issue = (
2044 EmailAddress => $address,
2045 $user? (User => $user) : (),
2046 Keys => undef,
2047 );
2048
2049 unless ( $res{'info'} && @{ $res{'info'} } ) {
2050 # no key
2051 $issue{'Message'} = "There is no key suitable for encryption."; #loc
2052 }
2053 elsif ( @{ $res{'info'} } == 1 && !$res{'info'}[0]{'TrustLevel'} ) {
2054 # trust is not set
2055 $issue{'Message'} = "There is one suitable key, but trust level is not set."; #loc
2056 }
2057 else {
2058 # multiple keys
2059 $issue{'Message'} = "There are several keys suitable for encryption."; #loc
2060 }
2061 push @issues, \%issue;
2062 }
2063 return ($status, @issues);
2064}
2065
2066sub GetPublicKeyInfo {
2067 return GetKeyInfo( shift, 'public', @_ );
2068}
2069
2070sub GetPrivateKeyInfo {
2071 return GetKeyInfo( shift, 'private', @_ );
2072}
2073
2074sub GetKeyInfo {
2075 my %res = GetKeysInfo(@_);
2076 $res{'info'} = $res{'info'}->[0];
2077 return %res;
2078}
2079
2080sub GetKeysInfo {
2081 my $email = shift;
2082 my $type = shift || 'public';
2083 my $force = shift;
2084
2085 unless ( $email ) {
2086 return (exit_code => 0) unless $force;
2087 }
2088
2089 my $gnupg = GnuPG::Interface->new();
2090 my %opt = RT->Config->Get('GnuPGOptions');
2091 $opt{'digest-algo'} ||= 'SHA1';
2092 $opt{'with-colons'} = undef; # parseable format
2093 $opt{'fingerprint'} = undef; # show fingerprint
2094 $opt{'fixed-list-mode'} = undef; # don't merge uid with keys
2095 $gnupg->options->hash_init(
2096 _PrepareGnuPGOptions( %opt ),
2097 armor => 1,
2098 meta_interactive => 0,
2099 );
2100
2101 my %res;
2102
2103 my ($handles, $handle_list) = _make_gpg_handles();
2104 my %handle = %$handle_list;
2105
2106 eval {
2107 local $SIG{'CHLD'} = 'DEFAULT';
2108 my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
2109 my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email? (command_args => $email) : () ) };
2110 close $handle{'stdin'};
2111 waitpid $pid, 0;
2112 };
2113
2114 my @info = readline $handle{'stdout'};
2115 close $handle{'stdout'};
2116
2117 $res{'exit_code'} = $?;
2118 foreach ( qw(stderr logger status) ) {
2119 $res{$_} = do { local $/; readline $handle{$_} };
2120 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2121 close $handle{$_};
2122 }
2123 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2124 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2125 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2126 if ( $@ || $? ) {
2127 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
2128 return %res;
2129 }
2130
2131 @info = ParseKeysInfo( @info );
2132 $res{'info'} = \@info;
2133 return %res;
2134}
2135
2136sub ParseKeysInfo {
2137 my @lines = @_;
2138
2139 my %gpg_opt = RT->Config->Get('GnuPGOptions');
2140
2141 my @res = ();
2142 foreach my $line( @lines ) {
2143 chomp $line;
2144 my $tag;
2145 ($tag, $line) = split /:/, $line, 2;
2146 if ( $tag eq 'pub' ) {
2147 my %info;
2148 @info{ qw(
2149 TrustChar KeyLength Algorithm Key
2150 Created Expire Empty OwnerTrustChar
2151 Empty Empty Capabilities Other
2152 ) } = split /:/, $line, 12;
2153
2154 # workaround gnupg's wierd behaviour, --list-keys command report calculated trust levels
2155 # for any model except 'always', so you can change models and see changes, but not for 'always'
2156 # we try to handle it in a simple way - we set ultimate trust for any key with trust
2157 # level >= 0 if trust model is 'always'
2158 my $always_trust;
2159 $always_trust = 1 if exists $gpg_opt{'always-trust'};
2160 $always_trust = 1 if exists $gpg_opt{'trust-model'} && $gpg_opt{'trust-model'} eq 'always';
2161 @info{qw(Trust TrustTerse TrustLevel)} =
2162 _ConvertTrustChar( $info{'TrustChar'} );
2163 if ( $always_trust && $info{'TrustLevel'} >= 0 ) {
2164 @info{qw(Trust TrustTerse TrustLevel)} =
2165 _ConvertTrustChar( 'u' );
2166 }
2167
2168 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
2169 _ConvertTrustChar( $info{'OwnerTrustChar'} );
2170 $info{ $_ } = _ParseDate( $info{ $_ } )
2171 foreach qw(Created Expire);
2172 push @res, \%info;
2173 }
2174 elsif ( $tag eq 'sec' ) {
2175 my %info;
2176 @info{ qw(
2177 Empty KeyLength Algorithm Key
2178 Created Expire Empty OwnerTrustChar
2179 Empty Empty Capabilities Other
2180 ) } = split /:/, $line, 12;
2181 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
2182 _ConvertTrustChar( $info{'OwnerTrustChar'} );
2183 $info{ $_ } = _ParseDate( $info{ $_ } )
2184 foreach qw(Created Expire);
2185 push @res, \%info;
2186 }
2187 elsif ( $tag eq 'uid' ) {
2188 my %info;
2189 @info{ qw(Trust Created Expire String) }
2190 = (split /:/, $line)[0,4,5,8];
2191 $info{ $_ } = _ParseDate( $info{ $_ } )
2192 foreach qw(Created Expire);
2193 push @{ $res[-1]{'User'} ||= [] }, \%info;
2194 }
2195 elsif ( $tag eq 'fpr' ) {
2196 $res[-1]{'Fingerprint'} = (split /:/, $line, 10)[8];
2197 }
2198 }
2199 return @res;
2200}
2201
2202{
2203 my %verbose = (
2204 # deprecated
2205 d => [
2206 "The key has been disabled", #loc
2207 "key disabled", #loc
2208 "-2"
2209 ],
2210
2211 r => [
2212 "The key has been revoked", #loc
2213 "key revoked", #loc
2214 -3,
2215 ],
2216
2217 e => [ "The key has expired", #loc
2218 "key expired", #loc
2219 '-4',
2220 ],
2221
2222 n => [ "Don't trust this key at all", #loc
2223 'none', #loc
2224 -1,
2225 ],
2226
2227 #gpupg docs says that '-' and 'q' may safely be treated as the same value
2228 '-' => [
2229 'Unknown (no trust value assigned)', #loc
2230 'not set',
2231 0,
2232 ],
2233 q => [
2234 'Unknown (no trust value assigned)', #loc
2235 'not set',
2236 0,
2237 ],
2238 o => [
2239 'Unknown (this value is new to the system)', #loc
2240 'unknown',
2241 0,
2242 ],
2243
2244 m => [
2245 "There is marginal trust in this key", #loc
2246 'marginal', #loc
2247 1,
2248 ],
2249 f => [
2250 "The key is fully trusted", #loc
2251 'full', #loc
2252 2,
2253 ],
2254 u => [
2255 "The key is ultimately trusted", #loc
2256 'ultimate', #loc
2257 3,
2258 ],
2259 );
2260
2261 sub _ConvertTrustChar {
2262 my $value = shift;
2263 return @{ $verbose{'-'} } unless $value;
2264 $value = substr $value, 0, 1;
2265 return @{ $verbose{ $value } || $verbose{'o'} };
2266 }
2267}
2268
2269sub _ParseDate {
2270 my $value = shift;
2271 # never
2272 return $value unless $value;
2273
2274 require RT::Date;
2275 my $obj = RT::Date->new( RT->SystemUser );
2276 # unix time
2277 if ( $value =~ /^\d+$/ ) {
2278 $obj->Set( Value => $value );
2279 } else {
2280 $obj->Set( Format => 'unknown', Value => $value, Timezone => 'utc' );
2281 }
2282 return $obj;
2283}
2284
2285sub DeleteKey {
2286 my $key = shift;
2287
2288 my $gnupg = GnuPG::Interface->new();
2289 my %opt = RT->Config->Get('GnuPGOptions');
2290 $gnupg->options->hash_init(
2291 _PrepareGnuPGOptions( %opt ),
2292 meta_interactive => 0,
2293 );
2294
2295 my ($handles, $handle_list) = _make_gpg_handles();
2296 my %handle = %$handle_list;
2297
2298 eval {
2299 local $SIG{'CHLD'} = 'DEFAULT';
2300 my $pid = safe_run_child { $gnupg->wrap_call(
2301 handles => $handles,
2302 commands => ['--delete-secret-and-public-key'],
2303 command_args => [$key],
2304 ) };
2305 close $handle{'stdin'};
2306 while ( my $str = readline $handle{'status'} ) {
2307 if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) {
2308 print { $handle{'command'} } "y\n";
2309 }
2310 }
2311 waitpid $pid, 0;
2312 };
2313 my $err = $@;
2314 close $handle{'stdout'};
2315
2316 my %res;
2317 $res{'exit_code'} = $?;
2318 foreach ( qw(stderr logger status) ) {
2319 $res{$_} = do { local $/; readline $handle{$_} };
2320 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2321 close $handle{$_};
2322 }
2323 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2324 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2325 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2326 if ( $err || $res{'exit_code'} ) {
2327 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
2328 }
2329 return %res;
2330}
2331
2332sub ImportKey {
2333 my $key = shift;
2334
2335 my $gnupg = GnuPG::Interface->new();
2336 my %opt = RT->Config->Get('GnuPGOptions');
2337 $gnupg->options->hash_init(
2338 _PrepareGnuPGOptions( %opt ),
2339 meta_interactive => 0,
2340 );
2341
2342 my ($handles, $handle_list) = _make_gpg_handles();
2343 my %handle = %$handle_list;
2344
2345 eval {
2346 local $SIG{'CHLD'} = 'DEFAULT';
2347 my $pid = safe_run_child { $gnupg->wrap_call(
2348 handles => $handles,
2349 commands => ['--import'],
2350 ) };
2351 print { $handle{'stdin'} } $key;
2352 close $handle{'stdin'};
2353 waitpid $pid, 0;
2354 };
2355 my $err = $@;
2356 close $handle{'stdout'};
2357
2358 my %res;
2359 $res{'exit_code'} = $?;
2360 foreach ( qw(stderr logger status) ) {
2361 $res{$_} = do { local $/; readline $handle{$_} };
2362 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2363 close $handle{$_};
2364 }
2365 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2366 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2367 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2368 if ( $err || $res{'exit_code'} ) {
2369 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
2370 }
2371 return %res;
2372}
2373
2374=head2 KEY
2375
2376Signs a small message with the key, to make sure the key exists and
2377we have a useable passphrase. The first argument MUST be a key identifier
2378of the signer: either email address, key id or finger print.
2379
2380Returns a true value if all went well.
2381
2382=cut
2383
2384sub DrySign {
2385 my $from = shift;
2386
2387 my $mime = MIME::Entity->build(
2388 Type => "text/plain",
2389 From => 'nobody@localhost',
2390 To => 'nobody@localhost',
2391 Subject => "dry sign",
2392 Data => ['t'],
2393 );
2394
2395 my %res = SignEncrypt(
2396 Sign => 1,
2397 Encrypt => 0,
2398 Entity => $mime,
2399 Signer => $from,
2400 );
2401
2402 return $res{exit_code} == 0;
2403}
2404
24051;
2406
2407=head2 Probe
2408
2409This routine returns true if RT's GnuPG support is configured and working
2410properly (and false otherwise).
2411
2412
2413=cut
2414
2415
2416sub Probe {
2417 my $gnupg = GnuPG::Interface->new();
2418 my %opt = RT->Config->Get('GnuPGOptions');
2419 $gnupg->options->hash_init(
2420 _PrepareGnuPGOptions( %opt ),
2421 armor => 1,
2422 meta_interactive => 0,
2423 );
2424
2425 my ($handles, $handle_list) = _make_gpg_handles();
2426 my %handle = %$handle_list;
2427
2428 local $@;
2429 eval {
2430 local $SIG{'CHLD'} = 'DEFAULT';
2431 my $pid = safe_run_child { $gnupg->wrap_call( commands => ['--version' ], handles => $handles ) };
2432 close $handle{'stdin'};
2433 waitpid $pid, 0;
2434 };
2435 if ( $@ ) {
2436 $RT::Logger->debug(
2437 "Probe for GPG failed."
2438 ." Couldn't run `gpg --version`: ". $@
2439 );
2440 return 0;
2441 }
2442
2443# on some systems gpg exits with code 2, but still 100% functional,
2444# it's general error system error or incorrect command, command is correct,
2445# but there is no way to get actuall error
2446 if ( $? && ($? >> 8) != 2 ) {
2447 my $msg = "Probe for GPG failed."
2448 ." Process exitted with code ". ($? >> 8)
2449 . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '')
2450 . ".";
2451 foreach ( qw(stderr logger status) ) {
2452 my $tmp = do { local $/; readline $handle{$_} };
2453 next unless $tmp && $tmp =~ /\S/s;
2454 close $handle{$_};
2455 $msg .= "\n$_:\n$tmp\n";
2456 }
2457 $RT::Logger->debug( $msg );
2458 return 0;
2459 }
2460 return 1;
2461}
2462
2463
2464sub _make_gpg_handles {
2465 my %handle_map = (@_);
2466 $handle_map{$_} = IO::Handle->new
2467 foreach grep !defined $handle_map{$_},
2468 qw(stdin stdout stderr logger status command);
2469
2470 my $handles = GnuPG::Handles->new(%handle_map);
2471 return ($handles, \%handle_map);
2472}
2473
2474RT::Base->_ImportOverlays();
2475
2476# helper package to avoid using temp file
2477package IO::Handle::CRLF;
2478
2479use base qw(IO::Handle);
2480
2481sub print {
2482 my ($self, @args) = (@_);
2483 s/\r*\n/\x0D\x0A/g foreach @args;
2484 return $self->SUPER::print( @args );
2485}
2486
24871;
USIT - Request tracker