rt/lib/RT/Crypt/GnuPG.pm

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