rt/lib/RT/Crypt/GnuPG.pm

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