rt/lib/RT/Crypt/GnuPG.pm

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