]> 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
Upgrade to 4.0.10.
[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;
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 }
dab09ea8
MKG		 903
904 # Deal with "partitioned" PGP mail, which (contrary to common
905 # sense) unnecessarily applies a base64 transfer encoding to PGP
906 # mail (whose content is already base64-encoded).
907 if ( $entity->bodyhandle->is_encoded and $entity->head->mime_encoding ) {
dab09ea8
MKG		 908 my $decoder = MIME::Decoder->new( $entity->head->mime_encoding );
909 if ($decoder) {
403d7b0b
MKG		 910 local $@;
911 eval {
912 my $buf = '';
913 open my $fh, '>', \$buf
914 or die "Couldn't open scalar for writing: $!";
915 binmode $fh, ":raw";
916 $decoder->decode($io, $fh);
917 close $fh or die "Couldn't close scalar: $!";
918
919 open $fh, '<', \$buf
920 or die "Couldn't re-open scalar for reading: $!";
921 binmode $fh, ":raw";
922 $io = $fh;
923 1;
924 } or do {
925 $RT::Logger->error("Couldn't decode body: $@");
926 }
dab09ea8
MKG		 927 }
928 }
929
84fb5b46
MKG		 930 while ( defined($_ = $io->getline) ) {
931 next unless /^-----BEGIN PGP (SIGNED )?MESSAGE-----/;
932 my $type = $1? 'signed': 'encrypted';
933 $RT::Logger->debug("Found $type inline part");
934 return {
935 Type => $type,
936 Format => !$file || $type eq 'signed'? 'Inline' : 'Attachment',
937 Data => $entity,
938 };
939 }
940 $io->close;
941 return ();
942 }
943
944 # RFC3156, multipart/{signed,encrypted}
945 if ( ( my $type = $entity->effective_type ) =~ /^multipart\/(?:encrypted|signed)$/ ) {
946 unless ( $entity->parts == 2 ) {
947 $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
948 return ();
949 }
950
951 my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
952 unless ( $protocol ) {
953 $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" );
954 return ();
955 }
956
957 if ( $type eq 'multipart/encrypted' ) {
958 unless ( $protocol eq 'application/pgp-encrypted' ) {
959 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" );
960 return ();
961 }
962 $RT::Logger->debug("Found encrypted according to RFC3156 part");
963 return {
964 Type => 'encrypted',
965 Format => 'RFC3156',
966 Top => $entity,
967 Data => $entity->parts(1),
968 Info => $entity->parts(0),
969 };
970 } else {
971 unless ( $protocol eq 'application/pgp-signature' ) {
972 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
973 return ();
974 }
975 $RT::Logger->debug("Found signed according to RFC3156 part");
976 return {
977 Type => 'signed',
978 Format => 'RFC3156',
979 Top => $entity,
980 Data => $entity->parts(0),
981 Signature => $entity->parts(1),
982 };
983 }
984 }
985
986 # attachments signed with signature in another part
987 my @file_indices;
988 foreach my $i ( 0 .. $entity->parts - 1 ) {
989 my $part = $entity->parts($i);
990
991 # we can not associate a signature within an attachment
992 # without file names
993 my $fname = $part->head->recommended_filename;
994 next unless $fname;
995
996 if ( $part->effective_type eq 'application/pgp-signature' ) {
997 push @file_indices, $i;
998 }
999 elsif ( $fname =~ /\.sig$/i && $part->effective_type eq 'application/octet-stream' ) {
1000 push @file_indices, $i;
1001 }
1002 }
1003
1004 my (@res, %skip);
1005 foreach my $i ( @file_indices ) {
1006 my $sig_part = $entity->parts($i);
1007 $skip{"$sig_part"}++;
1008 my $sig_name = $sig_part->head->recommended_filename;
1009 my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/;
1010
1011 my ($data_part_idx) =
1012 grep $file_name eq ($entity->parts($_)->head->recommended_filename||''),
1013 grep $sig_part ne $entity->parts($_),
1014 0 .. $entity->parts - 1;
1015 unless ( defined $data_part_idx ) {
1016 $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
1017 next;
1018 }
1019 my $data_part_in = $entity->parts($data_part_idx);
1020
1021 $skip{"$data_part_in"}++;
1022 $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
1023 push @res, {
1024 Type => 'signed',
1025 Format => 'Attachment',
1026 Top => $entity,
1027 Data => $data_part_in,
1028 Signature => $sig_part,
1029 };
1030 }
1031
1032 # attachments with inline encryption
1033 my @encrypted_indices =
1034 grep {($entity->parts($_)->head->recommended_filename || '') =~ /\.${RE_FILE_EXTENSIONS}$/}
1035 0 .. $entity->parts - 1;
1036
1037 foreach my $i ( @encrypted_indices ) {
1038 my $part = $entity->parts($i);
1039 $skip{"$part"}++;
1040 $RT::Logger->debug("Found encrypted attachment '". $part->head->recommended_filename ."'");
1041 push @res, {
1042 Type => 'encrypted',
1043 Format => 'Attachment',
1044 Top => $entity,
1045 Data => $part,
1046 };
1047 }
1048
1049 push @res, FindProtectedParts( Entity => $_ )
1050 foreach grep !$skip{"$_"}, $entity->parts;
1051
1052 return @res;
1053}
1054
1055=head2 VerifyDecrypt Entity => undef, [ Detach => 1, Passphrase => undef, SetStatus => 1 ]
1056
1057=cut
1058
1059sub VerifyDecrypt {
1060 my %args = (
1061 Entity => undef,
1062 Detach => 1,
1063 SetStatus => 1,
1064 AddStatus => 0,
1065 @_
1066 );
1067 my @protected = FindProtectedParts( Entity => $args{'Entity'} );
1068 my @res;
1069 # XXX: detaching may brake nested signatures
1070 foreach my $item( grep $_->{'Type'} eq 'signed', @protected ) {
1071 my $status_on;
1072 if ( $item->{'Format'} eq 'RFC3156' ) {
1073 push @res, { VerifyRFC3156( %$item, SetStatus => $args{'SetStatus'} ) };
1074 if ( $args{'Detach'} ) {
1075 $item->{'Top'}->parts( [ $item->{'Data'} ] );
1076 $item->{'Top'}->make_singlepart;
1077 }
1078 $status_on = $item->{'Top'};
1079 } elsif ( $item->{'Format'} eq 'Inline' ) {
1080 push @res, { VerifyInline( %$item ) };
1081 $status_on = $item->{'Data'};
1082 } elsif ( $item->{'Format'} eq 'Attachment' ) {
1083 push @res, { VerifyAttachment( %$item ) };
1084 if ( $args{'Detach'} ) {
1085 $item->{'Top'}->parts( [
1086 grep "$_" ne $item->{'Signature'}, $item->{'Top'}->parts
1087 ] );
1088 $item->{'Top'}->make_singlepart;
1089 }
1090 $status_on = $item->{'Data'};
1091 }
1092 if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
1093 my $method = $args{'AddStatus'} ? 'add' : 'set';
dab09ea8
MKG		 1094 # Let the header be modified so continuations are handled
1095 my $modify = $status_on->head->modify;
1096 $status_on->head->modify(1);
84fb5b46
MKG		 1097 $status_on->head->$method(
1098 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
1099 );
dab09ea8 1100 $status_on->head->modify($modify);
84fb5b46
MKG		 1101 }
1102 }
1103 foreach my $item( grep $_->{'Type'} eq 'encrypted', @protected ) {
1104 my $status_on;
1105 if ( $item->{'Format'} eq 'RFC3156' ) {
1106 push @res, { DecryptRFC3156( %$item ) };
1107 $status_on = $item->{'Top'};
1108 } elsif ( $item->{'Format'} eq 'Inline' ) {
1109 push @res, { DecryptInline( %$item ) };
1110 $status_on = $item->{'Data'};
1111 } elsif ( $item->{'Format'} eq 'Attachment' ) {
1112 push @res, { DecryptAttachment( %$item ) };
1113 $status_on = $item->{'Data'};
1114 }
1115 if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
1116 my $method = $args{'AddStatus'} ? 'add' : 'set';
dab09ea8
MKG		 1117 # Let the header be modified so continuations are handled
1118 my $modify = $status_on->head->modify;
1119 $status_on->head->modify(1);
84fb5b46
MKG		 1120 $status_on->head->$method(
1121 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
1122 );
dab09ea8 1123 $status_on->head->modify($modify);
84fb5b46
MKG		 1124 }
1125 }
1126 return @res;
1127}
1128
1129sub VerifyInline { return DecryptInline( @_ ) }
1130
1131sub VerifyAttachment {
1132 my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
1133
1134 my $gnupg = GnuPG::Interface->new();
1135 my %opt = RT->Config->Get('GnuPGOptions');
1136 $opt{'digest-algo'} ||= 'SHA1';
1137 $gnupg->options->hash_init(
1138 _PrepareGnuPGOptions( %opt ),
1139 meta_interactive => 0,
1140 );
1141
1142 foreach ( $args{'Data'}, $args{'Signature'} ) {
1143 next unless $_->bodyhandle->is_encoded;
1144
1145 require RT::EmailParser;
1146 RT::EmailParser->_DecodeBody($_);
1147 }
1148
1149 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1150 binmode $tmp_fh, ':raw';
1151 $args{'Data'}->bodyhandle->print( $tmp_fh );
1152 $tmp_fh->flush;
1153
1154 my ($handles, $handle_list) = _make_gpg_handles();
1155 my %handle = %$handle_list;
1156
1157 my %res;
1158 eval {
1159 local $SIG{'CHLD'} = 'DEFAULT';
1160 my $pid = safe_run_child { $gnupg->verify(
1161 handles => $handles, command_args => [ '-', $tmp_fn ]
1162 ) };
1163 {
1164 local $SIG{'PIPE'} = 'IGNORE';
1165 $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
1166 close $handle{'stdin'};
1167 }
1168 waitpid $pid, 0;
1169 };
1170 $res{'exit_code'} = $?;
1171 foreach ( qw(stderr logger status) ) {
1172 $res{$_} = do { local $/; readline $handle{$_} };
1173 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1174 close $handle{$_};
1175 }
1176 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1177 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1178 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1179 if ( $@ || $? ) {
1180 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1181 }
1182 return %res;
1183}
1184
1185sub VerifyRFC3156 {
1186 my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
1187
1188 my $gnupg = GnuPG::Interface->new();
1189 my %opt = RT->Config->Get('GnuPGOptions');
1190 $opt{'digest-algo'} ||= 'SHA1';
1191 $gnupg->options->hash_init(
1192 _PrepareGnuPGOptions( %opt ),
1193 meta_interactive => 0,
1194 );
1195
1196 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1197 binmode $tmp_fh, ':raw:eol(CRLF?)';
1198 $args{'Data'}->print( $tmp_fh );
1199 $tmp_fh->flush;
1200
1201 my ($handles, $handle_list) = _make_gpg_handles();
1202 my %handle = %$handle_list;
1203
1204 my %res;
1205 eval {
1206 local $SIG{'CHLD'} = 'DEFAULT';
1207 my $pid = safe_run_child { $gnupg->verify(
1208 handles => $handles, command_args => [ '-', $tmp_fn ]
1209 ) };
1210 {
1211 local $SIG{'PIPE'} = 'IGNORE';
1212 $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
1213 close $handle{'stdin'};
1214 }
1215 waitpid $pid, 0;
1216 };
1217 $res{'exit_code'} = $?;
1218 foreach ( qw(stderr logger status) ) {
1219 $res{$_} = do { local $/; readline $handle{$_} };
1220 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1221 close $handle{$_};
1222 }
1223 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1224 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1225 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1226 if ( $@ || $? ) {
1227 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1228 }
1229 return %res;
1230}
1231
1232sub DecryptRFC3156 {
1233 my %args = (
1234 Data => undef,
1235 Info => undef,
1236 Top => undef,
1237 Passphrase => undef,
1238 @_
1239 );
1240
1241 my $gnupg = GnuPG::Interface->new();
1242 my %opt = RT->Config->Get('GnuPGOptions');
1243
1244 # handling passphrase in GnupGOptions
1245 $args{'Passphrase'} = delete $opt{'passphrase'}
1246 if !defined($args{'Passphrase'});
1247
1248 $opt{'digest-algo'} ||= 'SHA1';
1249 $gnupg->options->hash_init(
1250 _PrepareGnuPGOptions( %opt ),
1251 meta_interactive => 0,
1252 );
1253
1254 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1255 require RT::EmailParser;
1256 RT::EmailParser->_DecodeBody($args{'Data'});
1257 }
1258
1259 $args{'Passphrase'} = GetPassphrase()
1260 unless defined $args{'Passphrase'};
1261
1262 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1263 binmode $tmp_fh, ':raw';
1264
1265 my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
1266 my %handle = %$handle_list;
1267 $handles->options( 'stdout' )->{'direct'} = 1;
1268
1269 my %res;
1270 eval {
1271 local $SIG{'CHLD'} = 'DEFAULT';
1272 $gnupg->passphrase( $args{'Passphrase'} );
1273 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1274 {
1275 local $SIG{'PIPE'} = 'IGNORE';
1276 $args{'Data'}->bodyhandle->print( $handle{'stdin'} );
1277 close $handle{'stdin'}
1278 }
1279
1280 waitpid $pid, 0;
1281 };
1282 $res{'exit_code'} = $?;
1283 foreach ( qw(stderr logger status) ) {
1284 $res{$_} = do { local $/; readline $handle{$_} };
1285 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1286 close $handle{$_};
1287 }
1288 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1289 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1290 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1291
1292 # if the decryption is fine but the signature is bad, then without this
1293 # status check we lose the decrypted text
1294 # XXX: add argument to the function to control this check
1295 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1296 if ( $@ || $? ) {
1297 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1298 return %res;
1299 }
1300 }
1301
1302 seek $tmp_fh, 0, 0;
1303 my $parser = RT::EmailParser->new();
1304 my $decrypted = $parser->ParseMIMEEntityFromFileHandle( $tmp_fh, 0 );
1305 $decrypted->{'__store_link_to_object_to_avoid_early_cleanup'} = $parser;
1306 $args{'Top'}->parts( [] );
1307 $args{'Top'}->add_part( $decrypted );
1308 $args{'Top'}->make_singlepart;
1309 return %res;
1310}
1311
1312sub DecryptInline {
1313 my %args = (
1314 Data => undef,
1315 Passphrase => undef,
1316 @_
1317 );
1318
1319 my $gnupg = GnuPG::Interface->new();
1320 my %opt = RT->Config->Get('GnuPGOptions');
1321
1322 # handling passphrase in GnuPGOptions
1323 $args{'Passphrase'} = delete $opt{'passphrase'}
1324 if !defined($args{'Passphrase'});
1325
1326 $opt{'digest-algo'} ||= 'SHA1';
1327 $gnupg->options->hash_init(
1328 _PrepareGnuPGOptions( %opt ),
1329 meta_interactive => 0,
1330 );
1331
1332 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1333 require RT::EmailParser;
1334 RT::EmailParser->_DecodeBody($args{'Data'});
1335 }
1336
1337 $args{'Passphrase'} = GetPassphrase()
1338 unless defined $args{'Passphrase'};
1339
1340 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1341 binmode $tmp_fh, ':raw';
1342
1343 my $io = $args{'Data'}->open('r');
1344 unless ( $io ) {
1345 die "Entity has no body, never should happen";
1346 }
1347
1348 my %res;
1349
1350 my ($had_literal, $in_block) = ('', 0);
1351 my ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1352 binmode $block_fh, ':raw';
1353
1354 while ( defined(my $str = $io->getline) ) {
1355 if ( $in_block && $str =~ /^-----END PGP (?:MESSAGE|SIGNATURE)-----/ ) {
1356 print $block_fh $str;
1357 $in_block--;
1358 next if $in_block > 0;
1359
1360 seek $block_fh, 0, 0;
1361
1362 my ($res_fh, $res_fn);
1363 ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1364 %args,
1365 GnuPG => $gnupg,
1366 BlockHandle => $block_fh,
1367 );
1368 return %res unless $res_fh;
1369
1370 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1371 while (my $buf = <$res_fh> ) {
1372 print $tmp_fh $buf;
1373 }
1374 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1375
1376 ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1377 binmode $block_fh, ':raw';
1378 $in_block = 0;
1379 }
1380 elsif ( $str =~ /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) {
1381 $in_block++;
1382 print $block_fh $str;
1383 }
1384 elsif ( $in_block ) {
1385 print $block_fh $str;
1386 }
1387 else {
1388 print $tmp_fh $str;
1389 $had_literal = 1 if /\S/s;
1390 }
1391 }
1392 $io->close;
1393
1394 if ( $in_block ) {
1395 # we're still in a block, this not bad not good. let's try to
1396 # decrypt what we have, it can be just missing -----END PGP...
1397 seek $block_fh, 0, 0;
1398
1399 my ($res_fh, $res_fn);
1400 ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1401 %args,
1402 GnuPG => $gnupg,
1403 BlockHandle => $block_fh,
1404 );
1405 return %res unless $res_fh;
1406
1407 print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1408 while (my $buf = <$res_fh> ) {
1409 print $tmp_fh $buf;
1410 }
1411 print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1412 }
1413
1414 seek $tmp_fh, 0, 0;
1415 $args{'Data'}->bodyhandle(MIME::Body::File->new( $tmp_fn ));
1416 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
1417 return %res;
1418}
1419
1420sub _DecryptInlineBlock {
1421 my %args = (
1422 GnuPG => undef,
1423 BlockHandle => undef,
1424 Passphrase => undef,
1425 @_
1426 );
1427 my $gnupg = $args{'GnuPG'};
1428
1429 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1430 binmode $tmp_fh, ':raw';
1431
1432 my ($handles, $handle_list) = _make_gpg_handles(
1433 stdin => $args{'BlockHandle'},
1434 stdout => $tmp_fh);
1435 my %handle = %$handle_list;
1436 $handles->options( 'stdout' )->{'direct'} = 1;
1437 $handles->options( 'stdin' )->{'direct'} = 1;
1438
1439 my %res;
1440 eval {
1441 local $SIG{'CHLD'} = 'DEFAULT';
1442 $gnupg->passphrase( $args{'Passphrase'} );
1443 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1444 waitpid $pid, 0;
1445 };
1446 $res{'exit_code'} = $?;
1447 foreach ( qw(stderr logger status) ) {
1448 $res{$_} = do { local $/; readline $handle{$_} };
1449 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1450 close $handle{$_};
1451 }
1452 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1453 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1454 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1455
1456 # if the decryption is fine but the signature is bad, then without this
1457 # status check we lose the decrypted text
1458 # XXX: add argument to the function to control this check
1459 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1460 if ( $@ || $? ) {
1461 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1462 return (undef, undef, %res);
1463 }
1464 }
1465
1466 seek $tmp_fh, 0, 0;
1467 return ($tmp_fh, $tmp_fn, %res);
1468}
1469
1470sub DecryptAttachment {
1471 my %args = (
1472 Top => undef,
1473 Data => undef,
1474 Passphrase => undef,
1475 @_
1476 );
1477
1478 my $gnupg = GnuPG::Interface->new();
1479 my %opt = RT->Config->Get('GnuPGOptions');
1480
1481 # handling passphrase in GnuPGOptions
1482 $args{'Passphrase'} = delete $opt{'passphrase'}
1483 if !defined($args{'Passphrase'});
1484
1485 $opt{'digest-algo'} ||= 'SHA1';
1486 $gnupg->options->hash_init(
1487 _PrepareGnuPGOptions( %opt ),
1488 meta_interactive => 0,
1489 );
1490
1491 if ( $args{'Data'}->bodyhandle->is_encoded ) {
1492 require RT::EmailParser;
1493 RT::EmailParser->_DecodeBody($args{'Data'});
1494 }
1495
1496 $args{'Passphrase'} = GetPassphrase()
1497 unless defined $args{'Passphrase'};
1498
1499 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1500 binmode $tmp_fh, ':raw';
1501 $args{'Data'}->bodyhandle->print( $tmp_fh );
1502 seek $tmp_fh, 0, 0;
1503
1504 my ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1505 %args,
1506 GnuPG => $gnupg,
1507 BlockHandle => $tmp_fh,
1508 );
1509 return %res unless $res_fh;
1510
1511 $args{'Data'}->bodyhandle(MIME::Body::File->new($res_fn) );
1512 $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $res_fh;
1513
1514 my $head = $args{'Data'}->head;
1515
1516 # we can not trust original content type
1517 # TODO: and don't have way to detect, so we just use octet-stream
1518 # some clients may send .asc files (encryped) as text/plain
1519 $head->mime_attr( "Content-Type" => 'application/octet-stream' );
1520
1521 my $filename = $head->recommended_filename;
1522 $filename =~ s/\.${RE_FILE_EXTENSIONS}$//i;
1523 $head->mime_attr( $_ => $filename )
1524 foreach (qw(Content-Type.name Content-Disposition.filename));
1525
1526 return %res;
1527}
1528
1529sub DecryptContent {
1530 my %args = (
1531 Content => undef,
1532 Passphrase => undef,
1533 @_
1534 );
1535
1536 my $gnupg = GnuPG::Interface->new();
1537 my %opt = RT->Config->Get('GnuPGOptions');
1538
1539 # handling passphrase in GnupGOptions
1540 $args{'Passphrase'} = delete $opt{'passphrase'}
1541 if !defined($args{'Passphrase'});
1542
1543 $opt{'digest-algo'} ||= 'SHA1';
1544 $gnupg->options->hash_init(
1545 _PrepareGnuPGOptions( %opt ),
1546 meta_interactive => 0,
1547 );
1548
1549 $args{'Passphrase'} = GetPassphrase()
1550 unless defined $args{'Passphrase'};
1551
1552 my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1553 binmode $tmp_fh, ':raw';
1554
1555 my ($handles, $handle_list) = _make_gpg_handles(
1556 stdout => $tmp_fh);
1557 my %handle = %$handle_list;
1558 $handles->options( 'stdout' )->{'direct'} = 1;
1559
1560 my %res;
1561 eval {
1562 local $SIG{'CHLD'} = 'DEFAULT';
1563 $gnupg->passphrase( $args{'Passphrase'} );
1564 my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1565 {
1566 local $SIG{'PIPE'} = 'IGNORE';
1567 print { $handle{'stdin'} } ${ $args{'Content'} };
1568 close $handle{'stdin'};
1569 }
1570
1571 waitpid $pid, 0;
1572 };
1573 $res{'exit_code'} = $?;
1574 foreach ( qw(stderr logger status) ) {
1575 $res{$_} = do { local $/; readline $handle{$_} };
1576 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1577 close $handle{$_};
1578 }
1579 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1580 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1581 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1582
1583 # if the decryption is fine but the signature is bad, then without this
1584 # status check we lose the decrypted text
1585 # XXX: add argument to the function to control this check
1586 if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1587 if ( $@ || $? ) {
1588 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1589 return %res;
1590 }
1591 }
1592
1593 ${ $args{'Content'} } = '';
1594 seek $tmp_fh, 0, 0;
1595 while (1) {
1596 my $status = read $tmp_fh, my $buf, 4*1024;
1597 unless ( defined $status ) {
1598 $RT::Logger->crit( "couldn't read message: $!" );
1599 } elsif ( !$status ) {
1600 last;
1601 }
1602 ${ $args{'Content'} } .= $buf;
1603 }
1604
1605 return %res;
1606}
1607
1608=head2 GetPassphrase [ Address => undef ]
1609
1610Returns passphrase, called whenever it's required with Address as a named argument.
1611
1612=cut
1613
1614sub GetPassphrase {
1615 my %args = ( Address => undef, @_ );
1616 return 'test';
1617}
1618
1619=head2 ParseStatus
1620
1621Takes a string containing output of gnupg status stream. Parses it and returns
1622array of hashes. Each element of array is a hash ref and represents line or
1623group of lines in the status message.
1624
1625All hashes have Operation, Status and Message elements.
1626
1627=over
1628
1629=item Operation
1630
1631Classification of operations gnupg performs. Now we have support
1632for Sign, Encrypt, Decrypt, Verify, PassphraseCheck, RecipientsCheck and Data
1633values.
1634
1635=item Status
1636
1637Informs about success. Value is 'DONE' on success, other values means that
1638an operation failed, for example 'ERROR', 'BAD', 'MISSING' and may be other.
1639
1640=item Message
1641
1642User friendly message.
1643
1644=back
1645
1646This parser is based on information from GnuPG distribution.
1647
1648=cut
1649
1650my %REASON_CODE_TO_TEXT = (
1651 NODATA => {
1652 1 => "No armored data",
1653 2 => "Expected a packet, but did not found one",
1654 3 => "Invalid packet found",
1655 4 => "Signature expected, but not found",
1656 },
1657 INV_RECP => {
1658 0 => "No specific reason given",
1659 1 => "Not Found",
1660 2 => "Ambigious specification",
1661 3 => "Wrong key usage",
1662 4 => "Key revoked",
1663 5 => "Key expired",
1664 6 => "No CRL known",
1665 7 => "CRL too old",
1666 8 => "Policy mismatch",
1667 9 => "Not a secret key",
1668 10 => "Key not trusted",
1669 },
1670 ERRSIG => {
1671 0 => 'not specified',
1672 4 => 'unknown algorithm',
1673 9 => 'missing public key',
1674 },
1675);
1676
1677sub ReasonCodeToText {
1678 my $keyword = shift;
1679 my $code = shift;
1680 return $REASON_CODE_TO_TEXT{ $keyword }{ $code }
1681 if exists $REASON_CODE_TO_TEXT{ $keyword }{ $code };
1682 return 'unknown';
1683}
1684
1685my %simple_keyword = (
1686 NO_RECP => {
1687 Operation => 'RecipientsCheck',
1688 Status => 'ERROR',
1689 Message => 'No recipients',
1690 },
1691 UNEXPECTED => {
1692 Operation => 'Data',
1693 Status => 'ERROR',
1694 Message => 'Unexpected data has been encountered',
1695 },
1696 BADARMOR => {
1697 Operation => 'Data',
1698 Status => 'ERROR',
1699 Message => 'The ASCII armor is corrupted',
1700 },
1701);
1702
1703# keywords we parse
1704my %parse_keyword = map { $_ => 1 } qw(
1705 USERID_HINT
1706 SIG_CREATED GOODSIG BADSIG ERRSIG
1707 END_ENCRYPTION
1708 DECRYPTION_FAILED DECRYPTION_OKAY
1709 BAD_PASSPHRASE GOOD_PASSPHRASE
1710 NO_SECKEY NO_PUBKEY
1711 NO_RECP INV_RECP NODATA UNEXPECTED
1712);
1713
1714# keywords we ignore without any messages as we parse them using other
1715# keywords as starting point or just ignore as they are useless for us
1716my %ignore_keyword = map { $_ => 1 } qw(
1717 NEED_PASSPHRASE MISSING_PASSPHRASE BEGIN_SIGNING PLAINTEXT PLAINTEXT_LENGTH
1718 BEGIN_ENCRYPTION SIG_ID VALIDSIG
1719 ENC_TO BEGIN_DECRYPTION END_DECRYPTION GOODMDC
1720 TRUST_UNDEFINED TRUST_NEVER TRUST_MARGINAL TRUST_FULLY TRUST_ULTIMATE
dab09ea8 1721 DECRYPTION_INFO
84fb5b46
MKG		 1722);
1723
1724sub ParseStatus {
1725 my $status = shift;
1726 return () unless $status;
1727
1728 my @status;
1729 while ( $status =~ /\[GNUPG:\]\s*(.*?)(?=\[GNUPG:\]|\z)/igms ) {
1730 push @status, $1; $status[-1] =~ s/\s+/ /g; $status[-1] =~ s/\s+$//;
1731 }
1732 $status = join "\n", @status;
1733 study $status;
1734
1735 my @res;
1736 my (%user_hint, $latest_user_main_key);
1737 for ( my $i = 0; $i < @status; $i++ ) {
1738 my $line = $status[$i];
1739 my ($keyword, $args) = ($line =~ /^(\S+)\s*(.*)$/s);
1740 if ( $simple_keyword{ $keyword } ) {
1741 push @res, $simple_keyword{ $keyword };
1742 $res[-1]->{'Keyword'} = $keyword;
1743 next;
1744 }
1745 unless ( $parse_keyword{ $keyword } ) {
1746 $RT::Logger->warning("Skipped $keyword") unless $ignore_keyword{ $keyword };
1747 next;
1748 }
1749
1750 if ( $keyword eq 'USERID_HINT' ) {
1751 my %tmp = _ParseUserHint($status, $line);
1752 $latest_user_main_key = $tmp{'MainKey'};
1753 if ( $user_hint{ $tmp{'MainKey'} } ) {
1754 while ( my ($k, $v) = each %tmp ) {
1755 $user_hint{ $tmp{'MainKey'} }->{$k} = $v;
1756 }
1757 } else {
1758 $user_hint{ $tmp{'MainKey'} } = \%tmp;
1759 }
1760 next;
1761 }
1762 elsif ( $keyword eq 'BAD_PASSPHRASE' || $keyword eq 'GOOD_PASSPHRASE' ) {
1763 my $key_id = $args;
1764 my %res = (
1765 Operation => 'PassphraseCheck',
1766 Status => $keyword eq 'BAD_PASSPHRASE'? 'BAD' : 'DONE',
1767 Key => $key_id,
1768 );
1769 $res{'Status'} = 'MISSING' if $status[ $i - 1 ] =~ /^MISSING_PASSPHRASE/;
1770 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1771 next unless $line =~ /^NEED_PASSPHRASE\s+(\S+)\s+(\S+)\s+(\S+)/;
1772 next if $key_id && $2 ne $key_id;
1773 @res{'MainKey', 'Key', 'KeyType'} = ($1, $2, $3);
1774 last;
1775 }
1776 $res{'Message'} = ucfirst( lc( $res{'Status'} eq 'DONE'? 'GOOD': $res{'Status'} ) ) .' passphrase';
1777 $res{'User'} = ( $user_hint{ $res{'MainKey'} } ||= {} ) if $res{'MainKey'};
1778 if ( exists $res{'User'}->{'EmailAddress'} ) {
1779 $res{'Message'} .= ' for '. $res{'User'}->{'EmailAddress'};
1780 } else {
1781 $res{'Message'} .= " for '0x$key_id'";
1782 }
1783 push @res, \%res;
1784 }
1785 elsif ( $keyword eq 'END_ENCRYPTION' ) {
1786 my %res = (
1787 Operation => 'Encrypt',
1788 Status => 'DONE',
1789 Message => 'Data has been encrypted',
1790 );
1791 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1792 next unless $line =~ /^BEGIN_ENCRYPTION\s+(\S+)\s+(\S+)/;
1793 @res{'MdcMethod', 'SymAlgo'} = ($1, $2);
1794 last;
1795 }
1796 push @res, \%res;
1797 }
1798 elsif ( $keyword eq 'DECRYPTION_FAILED' || $keyword eq 'DECRYPTION_OKAY' ) {
1799 my %res = ( Operation => 'Decrypt' );
1800 @res{'Status', 'Message'} =
1801 $keyword eq 'DECRYPTION_FAILED'
1802 ? ('ERROR', 'Decryption failed')
1803 : ('DONE', 'Decryption process succeeded');
1804
1805 foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1806 next unless $line =~ /^ENC_TO\s+(\S+)\s+(\S+)\s+(\S+)/;
1807 my ($key, $alg, $key_length) = ($1, $2, $3);
1808
1809 my %encrypted_to = (
1810 Message => "The message is encrypted to '0x$key'",
1811 User => ( $user_hint{ $key } ||= {} ),
1812 Key => $key,
1813 KeyLength => $key_length,
1814 Algorithm => $alg,
1815 );
1816
1817 push @{ $res{'EncryptedTo'} ||= [] }, \%encrypted_to;
1818 }
1819
1820 push @res, \%res;
1821 }
1822 elsif ( $keyword eq 'NO_SECKEY' || $keyword eq 'NO_PUBKEY' ) {
1823 my ($key) = split /\s+/, $args;
1824 my $type = $keyword eq 'NO_SECKEY'? 'secret': 'public';
1825 my %res = (
1826 Operation => 'KeyCheck',
1827 Status => 'MISSING',
1828 Message => ucfirst( $type ) ." key '0x$key' is not available",
1829 Key => $key,
1830 KeyType => $type,
1831 );
1832 $res{'User'} = ( $user_hint{ $key } ||= {} );
1833 $res{'User'}{ ucfirst( $type ). 'KeyMissing' } = 1;
1834 push @res, \%res;
1835 }
1836 # GOODSIG, BADSIG, VALIDSIG, TRUST_*
1837 elsif ( $keyword eq 'GOODSIG' ) {
1838 my %res = (
1839 Operation => 'Verify',
1840 Status => 'DONE',
1841 Message => 'The signature is good',
1842 );
1843 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1844 $res{'Message'} .= ', signed by '. $res{'UserString'};
1845
1846 foreach my $line ( @status[ $i .. $#status ] ) {
1847 next unless $line =~ /^TRUST_(\S+)/;
1848 $res{'Trust'} = $1;
1849 last;
1850 }
1851 $res{'Message'} .= ', trust level is '. lc( $res{'Trust'} || 'unknown');
1852
1853 foreach my $line ( @status[ $i .. $#status ] ) {
1854 next unless $line =~ /^VALIDSIG\s+(.*)/;
1855 @res{ qw(
1856 Fingerprint
1857 CreationDate
1858 Timestamp
1859 ExpireTimestamp
1860 Version
1861 Reserved
1862 PubkeyAlgo
1863 HashAlgo
1864 Class
1865 PKFingerprint
1866 Other
1867 ) } = split /\s+/, $1, 10;
1868 last;
1869 }
1870 push @res, \%res;
1871 }
1872 elsif ( $keyword eq 'BADSIG' ) {
1873 my %res = (
1874 Operation => 'Verify',
1875 Status => 'BAD',
1876 Message => 'The signature has not been verified okay',
1877 );
1878 @res{qw(Key UserString)} = split /\s+/, $args, 2;
1879 push @res, \%res;
1880 }
1881 elsif ( $keyword eq 'ERRSIG' ) {
1882 my %res = (
1883 Operation => 'Verify',
1884 Status => 'ERROR',
1885 Message => 'Not possible to check the signature',
1886 );
1887 @res{qw(Key PubkeyAlgo HashAlgo Class Timestamp ReasonCode Other)}
1888 = split /\s+/, $args, 7;
1889
1890 $res{'Reason'} = ReasonCodeToText( $keyword, $res{'ReasonCode'} );
1891 $res{'Message'} .= ", the reason is ". $res{'Reason'};
1892
1893 push @res, \%res;
1894 }
1895 elsif ( $keyword eq 'SIG_CREATED' ) {
1896 # SIG_CREATED <type> <pubkey algo> <hash algo> <class> <timestamp> <key fpr>
1897 my @props = split /\s+/, $args;
1898 push @res, {
1899 Operation => 'Sign',
1900 Status => 'DONE',
1901 Message => "Signed message",
1902 Type => $props[0],
1903 PubKeyAlgo => $props[1],
1904 HashKeyAlgo => $props[2],
1905 Class => $props[3],
1906 Timestamp => $props[4],
1907 KeyFingerprint => $props[5],
1908 User => $user_hint{ $latest_user_main_key },
1909 };
1910 $res[-1]->{Message} .= ' by '. $user_hint{ $latest_user_main_key }->{'EmailAddress'}
1911 if $user_hint{ $latest_user_main_key };
1912 }
1913 elsif ( $keyword eq 'INV_RECP' ) {
1914 my ($rcode, $recipient) = split /\s+/, $args, 2;
1915 my $reason = ReasonCodeToText( $keyword, $rcode );
1916 push @res, {
1917 Operation => 'RecipientsCheck',
1918 Status => 'ERROR',
1919 Message => "Recipient '$recipient' is unusable, the reason is '$reason'",
1920 Recipient => $recipient,
1921 ReasonCode => $rcode,
1922 Reason => $reason,
1923 };
1924 }
1925 elsif ( $keyword eq 'NODATA' ) {
1926 my $rcode = (split /\s+/, $args)[0];
1927 my $reason = ReasonCodeToText( $keyword, $rcode );
1928 push @res, {
1929 Operation => 'Data',
1930 Status => 'ERROR',
1931 Message => "No data has been found. The reason is '$reason'",
1932 ReasonCode => $rcode,
1933 Reason => $reason,
1934 };
1935 }
1936 else {
1937 $RT::Logger->warning("Keyword $keyword is unknown");
1938 next;
1939 }
1940 $res[-1]{'Keyword'} = $keyword if @res && !$res[-1]{'Keyword'};
1941 }
1942 return @res;
1943}
1944
1945sub _ParseUserHint {
1946 my ($status, $hint) = (@_);
1947 my ($main_key_id, $user_str) = ($hint =~ /^USERID_HINT\s+(\S+)\s+(.*)$/);
1948 return () unless $main_key_id;
1949 return (
1950 MainKey => $main_key_id,
1951 String => $user_str,
1952 EmailAddress => (map $_->address, Email::Address->parse( $user_str ))[0],
1953 );
1954}
1955
1956sub _PrepareGnuPGOptions {
1957 my %opt = @_;
1958 my %res = map { lc $_ => $opt{ $_ } } grep $supported_opt{ lc $_ }, keys %opt;
1959 $res{'extra_args'} ||= [];
1960 foreach my $o ( grep !$supported_opt{ lc $_ }, keys %opt ) {
1961 push @{ $res{'extra_args'} }, '--'. lc $o;
1962 push @{ $res{'extra_args'} }, $opt{ $o }
1963 if defined $opt{ $o };
1964 }
1965 return %res;
1966}
1967
1968{ my %key;
1969# no args -> clear
1970# one arg -> return preferred key
1971# many -> set
1972sub UseKeyForEncryption {
1973 unless ( @_ ) {
1974 %key = ();
1975 } elsif ( @_ > 1 ) {
1976 %key = (%key, @_);
1977 $key{ lc($_) } = delete $key{ $_ } foreach grep lc ne $_, keys %key;
1978 } else {
1979 return $key{ $_[0] };
1980 }
1981 return ();
1982} }
1983
1984=head2 UseKeyForSigning
1985
1986Returns or sets identifier of the key that should be used for signing.
1987
1988Returns the current value when called without arguments.
1989
1990Sets new value when called with one argument and unsets if it's undef.
1991
1992=cut
1993
1994{ my $key;
1995sub UseKeyForSigning {
1996 if ( @_ ) {
1997 $key = $_[0];
1998 }
1999 return $key;
2000} }
2001
2002=head2 GetKeysForEncryption
2003
2004Takes identifier and returns keys suitable for encryption.
2005
2006B<Note> that keys for which trust level is not set are
2007also listed.
2008
2009=cut
2010
2011sub GetKeysForEncryption {
2012 my $key_id = shift;
2013 my %res = GetKeysInfo( $key_id, 'public', @_ );
2014 return %res if $res{'exit_code'};
2015 return %res unless $res{'info'};
2016
2017 foreach my $key ( splice @{ $res{'info'} } ) {
2018 # skip disabled keys
2019 next if $key->{'Capabilities'} =~ /D/;
2020 # skip keys not suitable for encryption
2021 next unless $key->{'Capabilities'} =~ /e/i;
2022 # skip disabled, expired, revoke and keys with no trust,
2023 # but leave keys with unknown trust level
2024 next if $key->{'TrustLevel'} < 0;
2025
2026 push @{ $res{'info'} }, $key;
2027 }
2028 delete $res{'info'} unless @{ $res{'info'} };
2029 return %res;
2030}
2031
2032sub GetKeysForSigning {
2033 my $key_id = shift;
2034 return GetKeysInfo( $key_id, 'private', @_ );
2035}
2036
2037sub CheckRecipients {
2038 my @recipients = (@_);
2039
2040 my ($status, @issues) = (1, ());
2041
2042 my %seen;
2043 foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) {
2044 my %res = GetKeysForEncryption( $address );
2045 if ( $res{'info'} && @{ $res{'info'} } == 1 && $res{'info'}[0]{'TrustLevel'} > 0 ) {
2046 # good, one suitable and trusted key
2047 next;
2048 }
2049 my $user = RT::User->new( RT->SystemUser );
2050 $user->LoadByEmail( $address );
2051 # it's possible that we have no User record with the email
2052 $user = undef unless $user->id;
2053
2054 if ( my $fpr = UseKeyForEncryption( $address ) ) {
2055 if ( $res{'info'} && @{ $res{'info'} } ) {
2056 next if
2057 grep lc $_->{'Fingerprint'} eq lc $fpr,
2058 grep $_->{'TrustLevel'} > 0,
2059 @{ $res{'info'} };
2060 }
2061
2062 $status = 0;
2063 my %issue = (
2064 EmailAddress => $address,
2065 $user? (User => $user) : (),
2066 Keys => undef,
2067 );
2068 $issue{'Message'} = "Selected key either is not trusted or doesn't exist anymore."; #loc
2069 push @issues, \%issue;
2070 next;
2071 }
2072
2073 my $prefered_key;
2074 $prefered_key = $user->PreferredKey if $user;
2075 #XXX: prefered key is not yet implemented...
2076
2077 # classify errors
2078 $status = 0;
2079 my %issue = (
2080 EmailAddress => $address,
2081 $user? (User => $user) : (),
2082 Keys => undef,
2083 );
2084
2085 unless ( $res{'info'} && @{ $res{'info'} } ) {
2086 # no key
2087 $issue{'Message'} = "There is no key suitable for encryption."; #loc
2088 }
2089 elsif ( @{ $res{'info'} } == 1 && !$res{'info'}[0]{'TrustLevel'} ) {
2090 # trust is not set
2091 $issue{'Message'} = "There is one suitable key, but trust level is not set."; #loc
2092 }
2093 else {
2094 # multiple keys
2095 $issue{'Message'} = "There are several keys suitable for encryption."; #loc
2096 }
2097 push @issues, \%issue;
2098 }
2099 return ($status, @issues);
2100}
2101
2102sub GetPublicKeyInfo {
2103 return GetKeyInfo( shift, 'public', @_ );
2104}
2105
2106sub GetPrivateKeyInfo {
2107 return GetKeyInfo( shift, 'private', @_ );
2108}
2109
2110sub GetKeyInfo {
2111 my %res = GetKeysInfo(@_);
2112 $res{'info'} = $res{'info'}->[0];
2113 return %res;
2114}
2115
2116sub GetKeysInfo {
2117 my $email = shift;
2118 my $type = shift || 'public';
2119 my $force = shift;
2120
2121 unless ( $email ) {
2122 return (exit_code => 0) unless $force;
2123 }
2124
2125 my $gnupg = GnuPG::Interface->new();
2126 my %opt = RT->Config->Get('GnuPGOptions');
2127 $opt{'digest-algo'} ||= 'SHA1';
2128 $opt{'with-colons'} = undef; # parseable format
2129 $opt{'fingerprint'} = undef; # show fingerprint
2130 $opt{'fixed-list-mode'} = undef; # don't merge uid with keys
2131 $gnupg->options->hash_init(
2132 _PrepareGnuPGOptions( %opt ),
2133 armor => 1,
2134 meta_interactive => 0,
2135 );
2136
2137 my %res;
2138
2139 my ($handles, $handle_list) = _make_gpg_handles();
2140 my %handle = %$handle_list;
2141
2142 eval {
2143 local $SIG{'CHLD'} = 'DEFAULT';
2144 my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
dab09ea8
MKG		 2145 my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email
2146 ? (command_args => [ "--", $email])
2147 : () ) };
84fb5b46
MKG		 2148 close $handle{'stdin'};
2149 waitpid $pid, 0;
2150 };
2151
2152 my @info = readline $handle{'stdout'};
2153 close $handle{'stdout'};
2154
2155 $res{'exit_code'} = $?;
2156 foreach ( qw(stderr logger status) ) {
2157 $res{$_} = do { local $/; readline $handle{$_} };
2158 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2159 close $handle{$_};
2160 }
2161 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2162 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2163 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2164 if ( $@ || $? ) {
2165 $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
2166 return %res;
2167 }
2168
2169 @info = ParseKeysInfo( @info );
2170 $res{'info'} = \@info;
2171 return %res;
2172}
2173
2174sub ParseKeysInfo {
2175 my @lines = @_;
2176
2177 my %gpg_opt = RT->Config->Get('GnuPGOptions');
2178
2179 my @res = ();
2180 foreach my $line( @lines ) {
2181 chomp $line;
2182 my $tag;
2183 ($tag, $line) = split /:/, $line, 2;
2184 if ( $tag eq 'pub' ) {
2185 my %info;
2186 @info{ qw(
2187 TrustChar KeyLength Algorithm Key
2188 Created Expire Empty OwnerTrustChar
2189 Empty Empty Capabilities Other
2190 ) } = split /:/, $line, 12;
2191
2192 # workaround gnupg's wierd behaviour, --list-keys command report calculated trust levels
2193 # for any model except 'always', so you can change models and see changes, but not for 'always'
2194 # we try to handle it in a simple way - we set ultimate trust for any key with trust
2195 # level >= 0 if trust model is 'always'
2196 my $always_trust;
2197 $always_trust = 1 if exists $gpg_opt{'always-trust'};
2198 $always_trust = 1 if exists $gpg_opt{'trust-model'} && $gpg_opt{'trust-model'} eq 'always';
2199 @info{qw(Trust TrustTerse TrustLevel)} =
2200 _ConvertTrustChar( $info{'TrustChar'} );
2201 if ( $always_trust && $info{'TrustLevel'} >= 0 ) {
2202 @info{qw(Trust TrustTerse TrustLevel)} =
2203 _ConvertTrustChar( 'u' );
2204 }
2205
2206 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
2207 _ConvertTrustChar( $info{'OwnerTrustChar'} );
2208 $info{ $_ } = _ParseDate( $info{ $_ } )
2209 foreach qw(Created Expire);
2210 push @res, \%info;
2211 }
2212 elsif ( $tag eq 'sec' ) {
2213 my %info;
2214 @info{ qw(
2215 Empty KeyLength Algorithm Key
2216 Created Expire Empty OwnerTrustChar
2217 Empty Empty Capabilities Other
2218 ) } = split /:/, $line, 12;
2219 @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
2220 _ConvertTrustChar( $info{'OwnerTrustChar'} );
2221 $info{ $_ } = _ParseDate( $info{ $_ } )
2222 foreach qw(Created Expire);
2223 push @res, \%info;
2224 }
2225 elsif ( $tag eq 'uid' ) {
2226 my %info;
2227 @info{ qw(Trust Created Expire String) }
2228 = (split /:/, $line)[0,4,5,8];
2229 $info{ $_ } = _ParseDate( $info{ $_ } )
2230 foreach qw(Created Expire);
2231 push @{ $res[-1]{'User'} ||= [] }, \%info;
2232 }
2233 elsif ( $tag eq 'fpr' ) {
2234 $res[-1]{'Fingerprint'} = (split /:/, $line, 10)[8];
2235 }
2236 }
2237 return @res;
2238}
2239
2240{
2241 my %verbose = (
2242 # deprecated
2243 d => [
2244 "The key has been disabled", #loc
2245 "key disabled", #loc
2246 "-2"
2247 ],
2248
2249 r => [
2250 "The key has been revoked", #loc
2251 "key revoked", #loc
2252 -3,
2253 ],
2254
2255 e => [ "The key has expired", #loc
2256 "key expired", #loc
2257 '-4',
2258 ],
2259
2260 n => [ "Don't trust this key at all", #loc
2261 'none', #loc
2262 -1,
2263 ],
2264
2265 #gpupg docs says that '-' and 'q' may safely be treated as the same value
2266 '-' => [
2267 'Unknown (no trust value assigned)', #loc
2268 'not set',
2269 0,
2270 ],
2271 q => [
2272 'Unknown (no trust value assigned)', #loc
2273 'not set',
2274 0,
2275 ],
2276 o => [
2277 'Unknown (this value is new to the system)', #loc
2278 'unknown',
2279 0,
2280 ],
2281
2282 m => [
2283 "There is marginal trust in this key", #loc
2284 'marginal', #loc
2285 1,
2286 ],
2287 f => [
2288 "The key is fully trusted", #loc
2289 'full', #loc
2290 2,
2291 ],
2292 u => [
2293 "The key is ultimately trusted", #loc
2294 'ultimate', #loc
2295 3,
2296 ],
2297 );
2298
2299 sub _ConvertTrustChar {
2300 my $value = shift;
2301 return @{ $verbose{'-'} } unless $value;
2302 $value = substr $value, 0, 1;
2303 return @{ $verbose{ $value } || $verbose{'o'} };
2304 }
2305}
2306
2307sub _ParseDate {
2308 my $value = shift;
2309 # never
2310 return $value unless $value;
2311
2312 require RT::Date;
2313 my $obj = RT::Date->new( RT->SystemUser );
2314 # unix time
2315 if ( $value =~ /^\d+$/ ) {
2316 $obj->Set( Value => $value );
2317 } else {
2318 $obj->Set( Format => 'unknown', Value => $value, Timezone => 'utc' );
2319 }
2320 return $obj;
2321}
2322
2323sub DeleteKey {
2324 my $key = shift;
2325
2326 my $gnupg = GnuPG::Interface->new();
2327 my %opt = RT->Config->Get('GnuPGOptions');
2328 $gnupg->options->hash_init(
2329 _PrepareGnuPGOptions( %opt ),
2330 meta_interactive => 0,
2331 );
2332
2333 my ($handles, $handle_list) = _make_gpg_handles();
2334 my %handle = %$handle_list;
2335
2336 eval {
2337 local $SIG{'CHLD'} = 'DEFAULT';
2338 my $pid = safe_run_child { $gnupg->wrap_call(
2339 handles => $handles,
2340 commands => ['--delete-secret-and-public-key'],
dab09ea8 2341 command_args => ["--", $key],
84fb5b46
MKG		 2342 ) };
2343 close $handle{'stdin'};
2344 while ( my $str = readline $handle{'status'} ) {
2345 if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) {
2346 print { $handle{'command'} } "y\n";
2347 }
2348 }
2349 waitpid $pid, 0;
2350 };
2351 my $err = $@;
2352 close $handle{'stdout'};
2353
2354 my %res;
2355 $res{'exit_code'} = $?;
2356 foreach ( qw(stderr logger status) ) {
2357 $res{$_} = do { local $/; readline $handle{$_} };
2358 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2359 close $handle{$_};
2360 }
2361 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2362 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2363 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2364 if ( $err || $res{'exit_code'} ) {
2365 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
2366 }
2367 return %res;
2368}
2369
2370sub ImportKey {
2371 my $key = shift;
2372
2373 my $gnupg = GnuPG::Interface->new();
2374 my %opt = RT->Config->Get('GnuPGOptions');
2375 $gnupg->options->hash_init(
2376 _PrepareGnuPGOptions( %opt ),
2377 meta_interactive => 0,
2378 );
2379
2380 my ($handles, $handle_list) = _make_gpg_handles();
2381 my %handle = %$handle_list;
2382
2383 eval {
2384 local $SIG{'CHLD'} = 'DEFAULT';
2385 my $pid = safe_run_child { $gnupg->wrap_call(
2386 handles => $handles,
2387 commands => ['--import'],
2388 ) };
2389 print { $handle{'stdin'} } $key;
2390 close $handle{'stdin'};
2391 waitpid $pid, 0;
2392 };
2393 my $err = $@;
2394 close $handle{'stdout'};
2395
2396 my %res;
2397 $res{'exit_code'} = $?;
2398 foreach ( qw(stderr logger status) ) {
2399 $res{$_} = do { local $/; readline $handle{$_} };
2400 delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2401 close $handle{$_};
2402 }
2403 $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2404 $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2405 $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2406 if ( $err || $res{'exit_code'} ) {
2407 $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
2408 }
2409 return %res;
2410}
2411
2412=head2 KEY
2413
2414Signs a small message with the key, to make sure the key exists and
2415we have a useable passphrase. The first argument MUST be a key identifier
2416of the signer: either email address, key id or finger print.
2417
2418Returns a true value if all went well.
2419
2420=cut
2421
2422sub DrySign {
2423 my $from = shift;
2424
2425 my $mime = MIME::Entity->build(
2426 Type => "text/plain",
2427 From => 'nobody@localhost',
2428 To => 'nobody@localhost',
2429 Subject => "dry sign",
2430 Data => ['t'],
2431 );
2432
2433 my %res = SignEncrypt(
2434 Sign => 1,
2435 Encrypt => 0,
2436 Entity => $mime,
2437 Signer => $from,
2438 );
2439
2440 return $res{exit_code} == 0;
2441}
2442
24431;
2444
2445=head2 Probe
2446
2447This routine returns true if RT's GnuPG support is configured and working
2448properly (and false otherwise).
2449
2450
2451=cut
2452
2453
2454sub Probe {
2455 my $gnupg = GnuPG::Interface->new();
2456 my %opt = RT->Config->Get('GnuPGOptions');
2457 $gnupg->options->hash_init(
2458 _PrepareGnuPGOptions( %opt ),
2459 armor => 1,
2460 meta_interactive => 0,
2461 );
2462
2463 my ($handles, $handle_list) = _make_gpg_handles();
2464 my %handle = %$handle_list;
2465
2466 local $@;
2467 eval {
2468 local $SIG{'CHLD'} = 'DEFAULT';
2469 my $pid = safe_run_child { $gnupg->wrap_call( commands => ['--version' ], handles => $handles ) };
2470 close $handle{'stdin'};
2471 waitpid $pid, 0;
2472 };
2473 if ( $@ ) {
2474 $RT::Logger->debug(
2475 "Probe for GPG failed."
2476 ." Couldn't run `gpg --version`: ". $@
2477 );
2478 return 0;
2479 }
2480
2481# on some systems gpg exits with code 2, but still 100% functional,
2482# it's general error system error or incorrect command, command is correct,
2483# but there is no way to get actuall error
2484 if ( $? && ($? >> 8) != 2 ) {
2485 my $msg = "Probe for GPG failed."
2486 ." Process exitted with code ". ($? >> 8)
2487 . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '')
2488 . ".";
2489 foreach ( qw(stderr logger status) ) {
2490 my $tmp = do { local $/; readline $handle{$_} };
2491 next unless $tmp && $tmp =~ /\S/s;
2492 close $handle{$_};
2493 $msg .= "\n$_:\n$tmp\n";
2494 }
2495 $RT::Logger->debug( $msg );
2496 return 0;
2497 }
2498 return 1;
2499}
2500
2501
2502sub _make_gpg_handles {
2503 my %handle_map = (@_);
2504 $handle_map{$_} = IO::Handle->new
2505 foreach grep !defined $handle_map{$_},
2506 qw(stdin stdout stderr logger status command);
2507
2508 my $handles = GnuPG::Handles->new(%handle_map);
2509 return ($handles, \%handle_map);
2510}
2511
2512RT::Base->_ImportOverlays();
2513
2514# helper package to avoid using temp file
2515package IO::Handle::CRLF;
2516
2517use base qw(IO::Handle);
2518
2519sub print {
2520 my ($self, @args) = (@_);
2521 s/\r*\n/\x0D\x0A/g foreach @args;
2522 return $self->SUPER::print( @args );
2523}
2524
25251;
USIT - Request tracker