rt/lib/RT/Crypt/GnuPG.pm

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