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