rt/lib/RT/Crypt/GnuPG.pm

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