rt/lib/RT/Crypt/GnuPG.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 use strict;
  50 use warnings;
  51
  52 package RT::Crypt::GnuPG;
  53
  54 use IO::Handle;
  55 use GnuPG::Interface;
  56 use RT::EmailParser ();
  57 use RT::Util 'safe_run_child';
  58
  59 =head1 NAME
  60
  61 RT::Crypt::GnuPG - encrypt/decrypt and sign/verify email messages with the GNU Privacy Guard (GPG)
  62
  63 =head1 DESCRIPTION
  64
  65 This module provides support for encryption and signing of outgoing messages,
  66 as well as the decryption and verification of incoming email.
  67
  68 =head1 CONFIGURATION
  69
  70 You can control the configuration of this subsystem from RT's configuration file.
  71 Some options are available via the web interface, but to enable this functionality, you
  72 MUST start in the configuration file.
  73
  74 There are two hashes, GnuPG and GnuPGOptions in the configuration file. The
  75 first one controls RT specific options. It enables you to enable/disable facility
  76 or change the format of messages. The second one is a hash with options for the
  77 'gnupg' utility. You can use it to define a keyserver, enable auto-retrieval keys
  78 and set almost any option 'gnupg' supports on your system.
  79
  80 =head2 %GnuPG
  81
  82 =head3 Enabling GnuPG
  83
  84 Set to true value to enable this subsystem:
  85
  86     Set( %GnuPG,
  87         Enable => 1,
  88         ... other options ...
  89     );
  90
  91 However, note that you B<must> add the 'Auth::GnuPG' email filter to enable
  92 the handling of incoming encrypted/signed messages.
  93
  94 =head3 Format of outgoing messages
  95
  96 Format of outgoing messages can be controlled using the 'OutgoingMessagesFormat'
  97 option in the RT config:
  98
  99     Set( %GnuPG,
 100         ... other options ...
 101         OutgoingMessagesFormat => 'RFC',
 102         ... other options ...
 103     );
 104
 105 or
 106
 107     Set( %GnuPG,
 108         ... other options ...
 109         OutgoingMessagesFormat => 'Inline',
 110         ... other options ...
 111     );
 112
 113 This framework implements two formats of signing and encrypting of email messages:
 114
 115 =over
 116
 117 =item RFC
 118
 119 This format is also known as GPG/MIME and described in RFC3156 and RFC1847.
 120 Technique described in these RFCs is well supported by many mail user
 121 agents (MUA), but some MUAs support only inline signatures and encryption,
 122 so it's possible to use inline format (see below).
 123
 124 =item Inline
 125
 126 This format doesn't take advantage of MIME, but some mail clients do
 127 not support GPG/MIME.
 128
 129 We sign text parts using clear signatures. For each attachments another
 130 attachment with a signature is added with '.sig' extension.
 131
 132 Encryption of text parts is implemented using inline format, other parts
 133 are replaced with attachments with the filename extension '.pgp'.
 134
 135 This format is discouraged because modern mail clients typically don't support
 136 it well.
 137
 138 =back
 139
 140 =head3 Encrypting data in the database
 141
 142 You can allow users to encrypt data in the database using
 143 option C<AllowEncryptDataInDB>. By default it's disabled.
 144 Users must have rights to see and modify tickets to use
 145 this feature.
 146
 147 =head2 %GnuPGOptions
 148
 149 Use this hash to set options of the 'gnupg' program. You can define almost any
 150 option you want which  gnupg supports, but never try to set options which
 151 change output format or gnupg's commands, such as --sign (command),
 152 --list-options (option) and other.
 153
 154 Some GnuPG options take arguments while others take none. (Such as  --use-agent).
 155 For options without specific value use C<undef> as hash value.
 156 To disable these option just comment them out or delete them from the hash
 157
 158     Set(%GnuPGOptions,
 159         'option-with-value' => 'value',
 160         'enabled-option-without-value' => undef,
 161         # 'commented-option' => 'value or undef',
 162     );
 163
 164 B<NOTE> that options may contain '-' character and such options B<MUST> be
 165 quoted, otherwise you can see quite cryptic error 'gpg: Invalid option "--0"'.
 166
 167 =over
 168
 169 =item --homedir
 170
 171 The GnuPG home directory, by default it is set to F</opt/rt3/var/data/gpg>.
 172
 173 You can manage this data with the 'gpg' commandline utility
 174 using the GNUPGHOME environment variable or --homedir option.
 175 Other utilities may be used as well.
 176
 177 In a standard installation, access to this directory should be granted to
 178 the web server user which is running RT's web interface, but if you're running
 179 cronjobs or other utilities that access RT directly via API and may generate
 180 encrypted/signed notifications then the users you execute these scripts under
 181 must have access too.
 182
 183 However, granting access to the dir to many users makes your setup less secure,
 184 some features, such as auto-import of keys, may not be available if you do not.
 185 To enable this features and suppress warnings about permissions on
 186 the dir use --no-permission-warning.
 187
 188 =item --digest-algo
 189
 190 This option is required in advance when RFC format for outgoing messages is
 191 used. We can not get default algorithm from gpg program so RT uses 'SHA1' by
 192 default. You may want to override it. You can use MD5, SHA1, RIPEMD160,
 193 SHA256 or other, however use `gpg --version` command to get information about
 194 supported algorithms by your gpg. These algorithms are listed as hash-functions.
 195
 196 =item --use-agent
 197
 198 This option lets you use GPG Agent to cache the passphrase of RT's key. See
 199 L<http://www.gnupg.org/documentation/manuals/gnupg/Invoking-GPG_002dAGENT.html>
 200 for information about GPG Agent.
 201
 202 =item --passphrase
 203
 204 This option lets you set the passphrase of RT's key directly. This option is
 205 special in that it isn't passed directly to GPG, but is put into a file that
 206 GPG then reads (which is more secure). The downside is that anyone who has read
 207 access to your RT_SiteConfig.pm file can see the passphrase, thus we recommend
 208 the --use-agent option instead.
 209
 210 =item other
 211
 212 Read `man gpg` to get list of all options this program support.
 213
 214 =back
 215
 216 =head2 Per-queue options
 217
 218 Using the web interface it's possible to enable signing and/or encrypting by
 219 default. As an administrative user of RT, open 'Configuration' then 'Queues',
 220 and select a queue. On the page you can see information about the queue's keys
 221 at the bottom and two checkboxes to choose default actions.
 222
 223 As well, encryption is enabled for autoreplies and other notifications when
 224 an encypted message enters system via mailgate interface even if queue's
 225 option is disabled.
 226
 227 =head2 Handling incoming messages
 228
 229 To enable handling of encrypted and signed message in the RT you should add
 230 'Auth::GnuPG' mail plugin.
 231
 232     Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...);
 233
 234 See also `perldoc lib/RT/Interface/Email/Auth/GnuPG.pm`.
 235
 236 =head2 Errors handling
 237
 238 There are several global templates created in the database by default. RT
 239 uses these templates to send error messages to users or RT's owner. These
 240 templates have 'Error:' or 'Error to RT owner:' prefix in the name. You can
 241 adjust the text of the messages using the web interface.
 242
 243 Note that C<$TicketObj>, C<$TransactionObj> and other variable usually available
 244 in RT's templates are not available in these templates, but each template
 245 used for errors reporting has set of available data structures you can use to
 246 build better messages. See default templates and descriptions below.
 247
 248 As well, you can disable particular notification by deleting content of
 249 a template. You can delete a template too, but in this case you'll see
 250 error messages in the logs when RT can not load template you've deleted.
 251
 252 =head3 Problems with public keys
 253
 254 Template 'Error: public key' is used to inform the user that RT has problems with
 255 his public key and won't be able to send him encrypted content. There are several
 256 reasons why RT can't use a key. However, the actual reason is not sent to the user,
 257 but sent to RT owner using 'Error to RT owner: public key'.
 258
 259 The possible reasons: "Not Found", "Ambiguous specification", "Wrong
 260 key usage", "Key revoked", "Key expired", "No CRL known", "CRL too
 261 old", "Policy mismatch", "Not a secret key", "Key not trusted" or
 262 "No specific reason given".
 263
 264 Due to limitations of GnuPG, it's impossible to encrypt to an untrusted key,
 265 unless 'always trust' mode is enabled.
 266
 267 In the 'Error: public key' template there are a few additional variables available:
 268
 269 =over 4
 270
 271 =item $Message - user friendly error message
 272
 273 =item $Reason - short reason as listed above
 274
 275 =item $Recipient - recipient's identification
 276
 277 =item $AddressObj - L<Email::Address> object containing recipient's email address
 278
 279 =back
 280
 281 A message can have several invalid recipients, to avoid sending many emails
 282 to the RT owner the system sends one message to the owner, grouped by
 283 recipient. In the 'Error to RT owner: public key' template a C<@BadRecipients>
 284 array is available where each element is a hash reference that describes one
 285 recipient using the same fields as described above. So it's something like:
 286
 287     @BadRecipients = (
 288         { Message => '...', Reason => '...', Recipient => '...', ...},
 289         { Message => '...', Reason => '...', Recipient => '...', ...},
 290         ...
 291     )
 292
 293 =head3 Private key doesn't exist
 294
 295 Template 'Error: no private key' is used to inform the user that
 296 he sent an encrypted email, but we have no private key to decrypt
 297 it.
 298
 299 In this template C<$Message> object of L<MIME::Entity> class
 300 available. It's the message RT received.
 301
 302 =head3 Invalid data
 303
 304 Template 'Error: bad GnuPG data' used to inform the user that a
 305 message he sent has invalid data and can not be handled.
 306
 307 There are several reasons for this error, but most of them are data
 308 corruption or absence of expected information.
 309
 310 In this template C<@Messages> array is available and contains list
 311 of error messages.
 312
 313 =head1 FOR DEVELOPERS
 314
 315 =head2 Documentation and references
 316
 317 * RFC1847 - Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted.
 318 Describes generic MIME security framework, "mulitpart/signed" and "multipart/encrypted"
 319 MIME types.
 320
 321 * RFC3156 - MIME Security with Pretty Good Privacy (PGP),
 322 updates RFC2015.
 323
 324 =cut
 325
 326 # gnupg options supported by GnuPG::Interface
 327 # other otions should be handled via extra_args argument
 328 my %supported_opt = map { $_ => 1 } qw(
 329        always_trust
 330        armor
 331        batch
 332        comment
 333        compress_algo
 334        default_key
 335        encrypt_to
 336        extra_args
 337        force_v3_sigs
 338        homedir
 339        logger_fd
 340        no_greeting
 341        no_options
 342        no_verbose
 343        openpgp
 344        options
 345        passphrase_fd
 346        quiet
 347        recipients
 348        rfc1991
 349        status_fd
 350        textmode
 351        verbose
 352 );
 353
 354 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 'new IO::Handle' 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'}  = new IO::Handle),
 362 #            stdout => ($handle{'stdout'} = new IO::Handle),
 363 #            stderr => ($handle{'stderr'}  = new IO::Handle),
 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 = new GnuPG::Interface;
 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 = new GnuPG::Interface;
 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( new MIME::Body::File $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 = new GnuPG::Interface;
 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 = $entity->head->recommended_filename || '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( new MIME::Body::File $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 = new GnuPG::Interface;
 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         while ( defined($_ = $io->getline) ) {
 904             next unless /^-----BEGIN PGP (SIGNED )?MESSAGE-----/;
 905             my $type = $1? 'signed': 'encrypted';
 906             $RT::Logger->debug("Found $type inline part");
 907             return {
 908                 Type    => $type,
 909                 Format  => !$file || $type eq 'signed'? 'Inline' : 'Attachment',
 910                 Data    => $entity,
 911             };
 912         }
 913         $io->close;
 914         return ();
 915     }
 916
 917     # RFC3156, multipart/{signed,encrypted}
 918     if ( ( my $type = $entity->effective_type ) =~ /^multipart\/(?:encrypted|signed)$/ ) {
 919         unless ( $entity->parts == 2 ) {
 920             $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
 921             return ();
 922         }
 923
 924         my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
 925         unless ( $protocol ) {
 926             $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" );
 927             return ();
 928         }
 929
 930         if ( $type eq 'multipart/encrypted' ) {
 931             unless ( $protocol eq 'application/pgp-encrypted' ) {
 932                 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" );
 933                 return ();
 934             }
 935             $RT::Logger->debug("Found encrypted according to RFC3156 part");
 936             return {
 937                 Type    => 'encrypted',
 938                 Format  => 'RFC3156',
 939                 Top   => $entity,
 940                 Data  => $entity->parts(1),
 941                 Info    => $entity->parts(0),
 942             };
 943         } else {
 944             unless ( $protocol eq 'application/pgp-signature' ) {
 945                 $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
 946                 return ();
 947             }
 948             $RT::Logger->debug("Found signed according to RFC3156 part");
 949             return {
 950                 Type      => 'signed',
 951                 Format    => 'RFC3156',
 952                 Top     => $entity,
 953                 Data    => $entity->parts(0),
 954                 Signature => $entity->parts(1),
 955             };
 956         }
 957     }
 958
 959     # attachments signed with signature in another part
 960     my @file_indices;
 961     foreach my $i ( 0 .. $entity->parts - 1 ) {
 962         my $part = $entity->parts($i);
 963
 964         # we can not associate a signature within an attachment
 965         # without file names
 966         my $fname = $part->head->recommended_filename;
 967         next unless $fname;
 968
 969         if ( $part->effective_type eq 'application/pgp-signature' ) {
 970             push @file_indices, $i;
 971         }
 972         elsif ( $fname =~ /\.sig$/i && $part->effective_type eq 'application/octet-stream' ) {
 973             push @file_indices, $i;
 974         }
 975     }
 976
 977     my (@res, %skip);
 978     foreach my $i ( @file_indices ) {
 979         my $sig_part = $entity->parts($i);
 980         $skip{"$sig_part"}++;
 981         my $sig_name = $sig_part->head->recommended_filename;
 982         my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/;
 983
 984         my ($data_part_idx) =
 985             grep $file_name eq ($entity->parts($_)->head->recommended_filename||''),
 986             grep $sig_part  ne  $entity->parts($_),
 987                 0 .. $entity->parts - 1;
 988         unless ( defined $data_part_idx ) {
 989             $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
 990             next;
 991         }
 992         my $data_part_in = $entity->parts($data_part_idx);
 993
 994         $skip{"$data_part_in"}++;
 995         $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
 996         push @res, {
 997             Type      => 'signed',
 998             Format    => 'Attachment',
 999             Top       => $entity,
1000             Data      => $data_part_in,
1001             Signature => $sig_part,
1002         };
1003     }
1004
1005     # attachments with inline encryption
1006     my @encrypted_indices =
1007         grep {($entity->parts($_)->head->recommended_filename || '') =~ /\.${RE_FILE_EXTENSIONS}$/}
1008             0 .. $entity->parts - 1;
1009
1010     foreach my $i ( @encrypted_indices ) {
1011         my $part = $entity->parts($i);
1012         $skip{"$part"}++;
1013         $RT::Logger->debug("Found encrypted attachment '". $part->head->recommended_filename ."'");
1014         push @res, {
1015             Type      => 'encrypted',
1016             Format    => 'Attachment',
1017             Top     => $entity,
1018             Data    => $part,
1019         };
1020     }
1021
1022     push @res, FindProtectedParts( Entity => $_ )
1023         foreach grep !$skip{"$_"}, $entity->parts;
1024
1025     return @res;
1026 }
1027
1028 =head2 VerifyDecrypt Entity => undef, [ Detach => 1, Passphrase => undef, SetStatus => 1 ]
1029
1030 =cut
1031
1032 sub VerifyDecrypt {
1033     my %args = (
1034         Entity    => undef,
1035         Detach    => 1,
1036         SetStatus => 1,
1037         AddStatus => 0,
1038         @_
1039     );
1040     my @protected = FindProtectedParts( Entity => $args{'Entity'} );
1041     my @res;
1042     # XXX: detaching may brake nested signatures
1043     foreach my $item( grep $_->{'Type'} eq 'signed', @protected ) {
1044         my $status_on;
1045         if ( $item->{'Format'} eq 'RFC3156' ) {
1046             push @res, { VerifyRFC3156( %$item, SetStatus => $args{'SetStatus'} ) };
1047             if ( $args{'Detach'} ) {
1048                 $item->{'Top'}->parts( [ $item->{'Data'} ] );
1049                 $item->{'Top'}->make_singlepart;
1050             }
1051             $status_on = $item->{'Top'};
1052         } elsif ( $item->{'Format'} eq 'Inline' ) {
1053             push @res, { VerifyInline( %$item ) };
1054             $status_on = $item->{'Data'};
1055         } elsif ( $item->{'Format'} eq 'Attachment' ) {
1056             push @res, { VerifyAttachment( %$item ) };
1057             if ( $args{'Detach'} ) {
1058                 $item->{'Top'}->parts( [
1059                     grep "$_" ne $item->{'Signature'}, $item->{'Top'}->parts
1060                 ] );
1061                 $item->{'Top'}->make_singlepart;
1062             }
1063             $status_on = $item->{'Data'};
1064         }
1065         if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
1066             my $method = $args{'AddStatus'} ? 'add' : 'set';
1067             $status_on->head->$method(
1068                 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
1069             );
1070         }
1071     }
1072     foreach my $item( grep $_->{'Type'} eq 'encrypted', @protected ) {
1073         my $status_on;
1074         if ( $item->{'Format'} eq 'RFC3156' ) {
1075             push @res, { DecryptRFC3156( %$item ) };
1076             $status_on = $item->{'Top'};
1077         } elsif ( $item->{'Format'} eq 'Inline' ) {
1078             push @res, { DecryptInline( %$item ) };
1079             $status_on = $item->{'Data'};
1080         } elsif ( $item->{'Format'} eq 'Attachment' ) {
1081             push @res, { DecryptAttachment( %$item ) };
1082             $status_on = $item->{'Data'};
1083         }
1084         if ( $args{'SetStatus'} || $args{'AddStatus'} ) {
1085             my $method = $args{'AddStatus'} ? 'add' : 'set';
1086             $status_on->head->$method(
1087                 'X-RT-GnuPG-Status' => $res[-1]->{'status'}
1088             );
1089         }
1090     }
1091     return @res;
1092 }
1093
1094 sub VerifyInline { return DecryptInline( @_ ) }
1095
1096 sub VerifyAttachment {
1097     my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
1098
1099     my $gnupg = new GnuPG::Interface;
1100     my %opt = RT->Config->Get('GnuPGOptions');
1101     $opt{'digest-algo'} ||= 'SHA1';
1102     $gnupg->options->hash_init(
1103         _PrepareGnuPGOptions( %opt ),
1104         meta_interactive => 0,
1105     );
1106
1107     foreach ( $args{'Data'}, $args{'Signature'} ) {
1108         next unless $_->bodyhandle->is_encoded;
1109
1110         require RT::EmailParser;
1111         RT::EmailParser->_DecodeBody($_);
1112     }
1113
1114     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1115     binmode $tmp_fh, ':raw';
1116     $args{'Data'}->bodyhandle->print( $tmp_fh );
1117     $tmp_fh->flush;
1118
1119     my ($handles, $handle_list) = _make_gpg_handles();
1120     my %handle = %$handle_list;
1121
1122     my %res;
1123     eval {
1124         local $SIG{'CHLD'} = 'DEFAULT';
1125         my $pid = safe_run_child { $gnupg->verify(
1126             handles => $handles, command_args => [ '-', $tmp_fn ]
1127         ) };
1128         {
1129             local $SIG{'PIPE'} = 'IGNORE';
1130             $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
1131             close $handle{'stdin'};
1132         }
1133         waitpid $pid, 0;
1134     };
1135     $res{'exit_code'} = $?;
1136     foreach ( qw(stderr logger status) ) {
1137         $res{$_} = do { local $/; readline $handle{$_} };
1138         delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1139         close $handle{$_};
1140     }
1141     $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1142     $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1143     $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1144     if ( $@ || $? ) {
1145         $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1146     }
1147     return %res;
1148 }
1149
1150 sub VerifyRFC3156 {
1151     my %args = ( Data => undef, Signature => undef, Top => undef, @_ );
1152
1153     my $gnupg = new GnuPG::Interface;
1154     my %opt = RT->Config->Get('GnuPGOptions');
1155     $opt{'digest-algo'} ||= 'SHA1';
1156     $gnupg->options->hash_init(
1157         _PrepareGnuPGOptions( %opt ),
1158         meta_interactive => 0,
1159     );
1160
1161     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1162     binmode $tmp_fh, ':raw:eol(CRLF?)';
1163     $args{'Data'}->print( $tmp_fh );
1164     $tmp_fh->flush;
1165
1166     my ($handles, $handle_list) = _make_gpg_handles();
1167     my %handle = %$handle_list;
1168
1169     my %res;
1170     eval {
1171         local $SIG{'CHLD'} = 'DEFAULT';
1172         my $pid = safe_run_child { $gnupg->verify(
1173             handles => $handles, command_args => [ '-', $tmp_fn ]
1174         ) };
1175         {
1176             local $SIG{'PIPE'} = 'IGNORE';
1177             $args{'Signature'}->bodyhandle->print( $handle{'stdin'} );
1178             close $handle{'stdin'};
1179         }
1180         waitpid $pid, 0;
1181     };
1182     $res{'exit_code'} = $?;
1183     foreach ( qw(stderr logger status) ) {
1184         $res{$_} = do { local $/; readline $handle{$_} };
1185         delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1186         close $handle{$_};
1187     }
1188     $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1189     $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1190     $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1191     if ( $@ || $? ) {
1192         $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1193     }
1194     return %res;
1195 }
1196
1197 sub DecryptRFC3156 {
1198     my %args = (
1199         Data => undef,
1200         Info => undef,
1201         Top => undef,
1202         Passphrase => undef,
1203         @_
1204     );
1205
1206     my $gnupg = new GnuPG::Interface;
1207     my %opt = RT->Config->Get('GnuPGOptions');
1208
1209     # handling passphrase in GnupGOptions
1210     $args{'Passphrase'} = delete $opt{'passphrase'}
1211         if !defined($args{'Passphrase'});
1212
1213     $opt{'digest-algo'} ||= 'SHA1';
1214     $gnupg->options->hash_init(
1215         _PrepareGnuPGOptions( %opt ),
1216         meta_interactive => 0,
1217     );
1218
1219     if ( $args{'Data'}->bodyhandle->is_encoded ) {
1220         require RT::EmailParser;
1221         RT::EmailParser->_DecodeBody($args{'Data'});
1222     }
1223
1224     $args{'Passphrase'} = GetPassphrase()
1225         unless defined $args{'Passphrase'};
1226
1227     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1228     binmode $tmp_fh, ':raw';
1229
1230     my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
1231     my %handle = %$handle_list;
1232     $handles->options( 'stdout' )->{'direct'} = 1;
1233
1234     my %res;
1235     eval {
1236         local $SIG{'CHLD'} = 'DEFAULT';
1237         $gnupg->passphrase( $args{'Passphrase'} );
1238         my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1239         {
1240             local $SIG{'PIPE'} = 'IGNORE';
1241             $args{'Data'}->bodyhandle->print( $handle{'stdin'} );
1242             close $handle{'stdin'}
1243         }
1244
1245         waitpid $pid, 0;
1246     };
1247     $res{'exit_code'} = $?;
1248     foreach ( qw(stderr logger status) ) {
1249         $res{$_} = do { local $/; readline $handle{$_} };
1250         delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1251         close $handle{$_};
1252     }
1253     $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1254     $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1255     $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1256
1257     # if the decryption is fine but the signature is bad, then without this
1258     # status check we lose the decrypted text
1259     # XXX: add argument to the function to control this check
1260     if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1261         if ( $@ || $? ) {
1262             $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1263             return %res;
1264         }
1265     }
1266
1267     seek $tmp_fh, 0, 0;
1268     my $parser = new RT::EmailParser;
1269     my $decrypted = $parser->ParseMIMEEntityFromFileHandle( $tmp_fh, 0 );
1270     $decrypted->{'__store_link_to_object_to_avoid_early_cleanup'} = $parser;
1271     $args{'Top'}->parts( [] );
1272     $args{'Top'}->add_part( $decrypted );
1273     $args{'Top'}->make_singlepart;
1274     return %res;
1275 }
1276
1277 sub DecryptInline {
1278     my %args = (
1279         Data => undef,
1280         Passphrase => undef,
1281         @_
1282     );
1283
1284     my $gnupg = new GnuPG::Interface;
1285     my %opt = RT->Config->Get('GnuPGOptions');
1286
1287     # handling passphrase in GnuPGOptions
1288     $args{'Passphrase'} = delete $opt{'passphrase'}
1289         if !defined($args{'Passphrase'});
1290
1291     $opt{'digest-algo'} ||= 'SHA1';
1292     $gnupg->options->hash_init(
1293         _PrepareGnuPGOptions( %opt ),
1294         meta_interactive => 0,
1295     );
1296
1297     if ( $args{'Data'}->bodyhandle->is_encoded ) {
1298         require RT::EmailParser;
1299         RT::EmailParser->_DecodeBody($args{'Data'});
1300     }
1301
1302     $args{'Passphrase'} = GetPassphrase()
1303         unless defined $args{'Passphrase'};
1304
1305     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1306     binmode $tmp_fh, ':raw';
1307
1308     my $io = $args{'Data'}->open('r');
1309     unless ( $io ) {
1310         die "Entity has no body, never should happen";
1311     }
1312
1313     my %res;
1314
1315     my ($had_literal, $in_block) = ('', 0);
1316     my ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1317     binmode $block_fh, ':raw';
1318
1319     while ( defined(my $str = $io->getline) ) {
1320         if ( $in_block && $str =~ /^-----END PGP (?:MESSAGE|SIGNATURE)-----/ ) {
1321             print $block_fh $str;
1322             $in_block--;
1323             next if $in_block > 0;
1324
1325             seek $block_fh, 0, 0;
1326
1327             my ($res_fh, $res_fn);
1328             ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1329                 %args,
1330                 GnuPG => $gnupg,
1331                 BlockHandle => $block_fh,
1332             );
1333             return %res unless $res_fh;
1334
1335             print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1336             while (my $buf = <$res_fh> ) {
1337                 print $tmp_fh $buf;
1338             }
1339             print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1340
1341             ($block_fh, $block_fn) = File::Temp::tempfile( UNLINK => 1 );
1342             binmode $block_fh, ':raw';
1343             $in_block = 0;
1344         }
1345         elsif ( $str =~ /^-----BEGIN PGP (SIGNED )?MESSAGE-----/ ) {
1346             $in_block++;
1347             print $block_fh $str;
1348         }
1349         elsif ( $in_block ) {
1350             print $block_fh $str;
1351         }
1352         else {
1353             print $tmp_fh $str;
1354             $had_literal = 1 if /\S/s;
1355         }
1356     }
1357     $io->close;
1358
1359     if ( $in_block ) {
1360         # we're still in a block, this not bad not good. let's try to
1361         # decrypt what we have, it can be just missing -----END PGP...
1362         seek $block_fh, 0, 0;
1363
1364         my ($res_fh, $res_fn);
1365         ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1366             %args,
1367             GnuPG => $gnupg,
1368             BlockHandle => $block_fh,
1369         );
1370         return %res unless $res_fh;
1371
1372         print $tmp_fh "-----BEGIN OF PGP PROTECTED PART-----\n" if $had_literal;
1373         while (my $buf = <$res_fh> ) {
1374             print $tmp_fh $buf;
1375         }
1376         print $tmp_fh "-----END OF PART-----\n" if $had_literal;
1377     }
1378
1379     seek $tmp_fh, 0, 0;
1380     $args{'Data'}->bodyhandle( new MIME::Body::File $tmp_fn );
1381     $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;
1382     return %res;
1383 }
1384
1385 sub _DecryptInlineBlock {
1386     my %args = (
1387         GnuPG => undef,
1388         BlockHandle => undef,
1389         Passphrase => undef,
1390         @_
1391     );
1392     my $gnupg = $args{'GnuPG'};
1393
1394     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1395     binmode $tmp_fh, ':raw';
1396
1397     my ($handles, $handle_list) = _make_gpg_handles(
1398             stdin => $args{'BlockHandle'},
1399             stdout => $tmp_fh);
1400     my %handle = %$handle_list;
1401     $handles->options( 'stdout' )->{'direct'} = 1;
1402     $handles->options( 'stdin' )->{'direct'} = 1;
1403
1404     my %res;
1405     eval {
1406         local $SIG{'CHLD'} = 'DEFAULT';
1407         $gnupg->passphrase( $args{'Passphrase'} );
1408         my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1409         waitpid $pid, 0;
1410     };
1411     $res{'exit_code'} = $?;
1412     foreach ( qw(stderr logger status) ) {
1413         $res{$_} = do { local $/; readline $handle{$_} };
1414         delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1415         close $handle{$_};
1416     }
1417     $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1418     $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1419     $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1420
1421     # if the decryption is fine but the signature is bad, then without this
1422     # status check we lose the decrypted text
1423     # XXX: add argument to the function to control this check
1424     if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1425         if ( $@ || $? ) {
1426             $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1427             return (undef, undef, %res);
1428         }
1429     }
1430
1431     seek $tmp_fh, 0, 0;
1432     return ($tmp_fh, $tmp_fn, %res);
1433 }
1434
1435 sub DecryptAttachment {
1436     my %args = (
1437         Top  => undef,
1438         Data => undef,
1439         Passphrase => undef,
1440         @_
1441     );
1442
1443     my $gnupg = new GnuPG::Interface;
1444     my %opt = RT->Config->Get('GnuPGOptions');
1445
1446     # handling passphrase in GnuPGOptions
1447     $args{'Passphrase'} = delete $opt{'passphrase'}
1448         if !defined($args{'Passphrase'});
1449
1450     $opt{'digest-algo'} ||= 'SHA1';
1451     $gnupg->options->hash_init(
1452         _PrepareGnuPGOptions( %opt ),
1453         meta_interactive => 0,
1454     );
1455
1456     if ( $args{'Data'}->bodyhandle->is_encoded ) {
1457         require RT::EmailParser;
1458         RT::EmailParser->_DecodeBody($args{'Data'});
1459     }
1460
1461     $args{'Passphrase'} = GetPassphrase()
1462         unless defined $args{'Passphrase'};
1463
1464     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1465     binmode $tmp_fh, ':raw';
1466     $args{'Data'}->bodyhandle->print( $tmp_fh );
1467     seek $tmp_fh, 0, 0;
1468
1469     my ($res_fh, $res_fn, %res) = _DecryptInlineBlock(
1470         %args,
1471         GnuPG => $gnupg,
1472         BlockHandle => $tmp_fh,
1473     );
1474     return %res unless $res_fh;
1475
1476     $args{'Data'}->bodyhandle( new MIME::Body::File $res_fn );
1477     $args{'Data'}->{'__store_tmp_handle_to_avoid_early_cleanup'} = $res_fh;
1478
1479     my $head = $args{'Data'}->head;
1480
1481     # we can not trust original content type
1482     # TODO: and don't have way to detect, so we just use octet-stream
1483     # some clients may send .asc files (encryped) as text/plain
1484     $head->mime_attr( "Content-Type" => 'application/octet-stream' );
1485
1486     my $filename = $head->recommended_filename;
1487     $filename =~ s/\.${RE_FILE_EXTENSIONS}$//i;
1488     $head->mime_attr( $_ => $filename )
1489         foreach (qw(Content-Type.name Content-Disposition.filename));
1490
1491     return %res;
1492 }
1493
1494 sub DecryptContent {
1495     my %args = (
1496         Content => undef,
1497         Passphrase => undef,
1498         @_
1499     );
1500
1501     my $gnupg = new GnuPG::Interface;
1502     my %opt = RT->Config->Get('GnuPGOptions');
1503
1504     # handling passphrase in GnupGOptions
1505     $args{'Passphrase'} = delete $opt{'passphrase'}
1506         if !defined($args{'Passphrase'});
1507
1508     $opt{'digest-algo'} ||= 'SHA1';
1509     $gnupg->options->hash_init(
1510         _PrepareGnuPGOptions( %opt ),
1511         meta_interactive => 0,
1512     );
1513
1514     $args{'Passphrase'} = GetPassphrase()
1515         unless defined $args{'Passphrase'};
1516
1517     my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
1518     binmode $tmp_fh, ':raw';
1519
1520     my ($handles, $handle_list) = _make_gpg_handles(
1521             stdout => $tmp_fh);
1522     my %handle = %$handle_list;
1523     $handles->options( 'stdout' )->{'direct'} = 1;
1524
1525     my %res;
1526     eval {
1527         local $SIG{'CHLD'} = 'DEFAULT';
1528         $gnupg->passphrase( $args{'Passphrase'} );
1529         my $pid = safe_run_child { $gnupg->decrypt( handles => $handles ) };
1530         {
1531             local $SIG{'PIPE'} = 'IGNORE';
1532             print { $handle{'stdin'} } ${ $args{'Content'} };
1533             close $handle{'stdin'};
1534         }
1535
1536         waitpid $pid, 0;
1537     };
1538     $res{'exit_code'} = $?;
1539     foreach ( qw(stderr logger status) ) {
1540         $res{$_} = do { local $/; readline $handle{$_} };
1541         delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
1542         close $handle{$_};
1543     }
1544     $RT::Logger->debug( $res{'status'} ) if $res{'status'};
1545     $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
1546     $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
1547
1548     # if the decryption is fine but the signature is bad, then without this
1549     # status check we lose the decrypted text
1550     # XXX: add argument to the function to control this check
1551     if ( $res{'status'} !~ /DECRYPTION_OKAY/ ) {
1552         if ( $@ || $? ) {
1553             $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
1554             return %res;
1555         }
1556     }
1557
1558     ${ $args{'Content'} } = '';
1559     seek $tmp_fh, 0, 0;
1560     while (1) {
1561         my $status = read $tmp_fh, my $buf, 4*1024;
1562         unless ( defined $status ) {
1563             $RT::Logger->crit( "couldn't read message: $!" );
1564         } elsif ( !$status ) {
1565             last;
1566         }
1567         ${ $args{'Content'} } .= $buf;
1568     }
1569
1570     return %res;
1571 }
1572
1573 =head2 GetPassphrase [ Address => undef ]
1574
1575 Returns passphrase, called whenever it's required with Address as a named argument.
1576
1577 =cut
1578
1579 sub GetPassphrase {
1580     my %args = ( Address => undef, @_ );
1581     return 'test';
1582 }
1583
1584 =head2 ParseStatus
1585
1586 Takes a string containing output of gnupg status stream. Parses it and returns
1587 array of hashes. Each element of array is a hash ref and represents line or
1588 group of lines in the status message.
1589
1590 All hashes have Operation, Status and Message elements.
1591
1592 =over
1593
1594 =item Operation
1595
1596 Classification of operations gnupg performs. Now we have support
1597 for Sign, Encrypt, Decrypt, Verify, PassphraseCheck, RecipientsCheck and Data
1598 values.
1599
1600 =item Status
1601
1602 Informs about success. Value is 'DONE' on success, other values means that
1603 an operation failed, for example 'ERROR', 'BAD', 'MISSING' and may be other.
1604
1605 =item Message
1606
1607 User friendly message.
1608
1609 =back
1610
1611 This parser is based on information from GnuPG distribution, see also
1612 F<docs/design_docs/gnupg_details_on_output_formats> in the RT distribution.
1613
1614 =cut
1615
1616 my %REASON_CODE_TO_TEXT = (
1617     NODATA => {
1618         1 => "No armored data",
1619         2 => "Expected a packet, but did not found one",
1620         3 => "Invalid packet found",
1621         4 => "Signature expected, but not found",
1622     },
1623     INV_RECP => {
1624         0 => "No specific reason given",
1625         1 => "Not Found",
1626         2 => "Ambigious specification",
1627         3 => "Wrong key usage",
1628         4 => "Key revoked",
1629         5 => "Key expired",
1630         6 => "No CRL known",
1631         7 => "CRL too old",
1632         8 => "Policy mismatch",
1633         9 => "Not a secret key",
1634         10 => "Key not trusted",
1635     },
1636     ERRSIG => {
1637         0 => 'not specified',
1638         4 => 'unknown algorithm',
1639         9 => 'missing public key',
1640     },
1641 );
1642
1643 sub ReasonCodeToText {
1644     my $keyword = shift;
1645     my $code = shift;
1646     return $REASON_CODE_TO_TEXT{ $keyword }{ $code }
1647         if exists $REASON_CODE_TO_TEXT{ $keyword }{ $code };
1648     return 'unknown';
1649 }
1650
1651 my %simple_keyword = (
1652     NO_RECP => {
1653         Operation => 'RecipientsCheck',
1654         Status    => 'ERROR',
1655         Message   => 'No recipients',
1656     },
1657     UNEXPECTED => {
1658         Operation => 'Data',
1659         Status    => 'ERROR',
1660         Message   => 'Unexpected data has been encountered',
1661     },
1662     BADARMOR => {
1663         Operation => 'Data',
1664         Status    => 'ERROR',
1665         Message   => 'The ASCII armor is corrupted',
1666     },
1667 );
1668
1669 # keywords we parse
1670 my %parse_keyword = map { $_ => 1 } qw(
1671     USERID_HINT
1672     SIG_CREATED GOODSIG BADSIG ERRSIG
1673     END_ENCRYPTION
1674     DECRYPTION_FAILED DECRYPTION_OKAY
1675     BAD_PASSPHRASE GOOD_PASSPHRASE
1676     NO_SECKEY NO_PUBKEY
1677     NO_RECP INV_RECP NODATA UNEXPECTED
1678 );
1679
1680 # keywords we ignore without any messages as we parse them using other
1681 # keywords as starting point or just ignore as they are useless for us
1682 my %ignore_keyword = map { $_ => 1 } qw(
1683     NEED_PASSPHRASE MISSING_PASSPHRASE BEGIN_SIGNING PLAINTEXT PLAINTEXT_LENGTH
1684     BEGIN_ENCRYPTION SIG_ID VALIDSIG
1685     ENC_TO BEGIN_DECRYPTION END_DECRYPTION GOODMDC
1686     TRUST_UNDEFINED TRUST_NEVER TRUST_MARGINAL TRUST_FULLY TRUST_ULTIMATE
1687 );
1688
1689 sub ParseStatus {
1690     my $status = shift;
1691     return () unless $status;
1692
1693     my @status;
1694     while ( $status =~ /\[GNUPG:\]\s*(.*?)(?=\[GNUPG:\]|\z)/igms ) {
1695         push @status, $1; $status[-1] =~ s/\s+/ /g; $status[-1] =~ s/\s+$//;
1696     }
1697     $status = join "\n", @status;
1698     study $status;
1699
1700     my @res;
1701     my (%user_hint, $latest_user_main_key);
1702     for ( my $i = 0; $i < @status; $i++ ) {
1703         my $line = $status[$i];
1704         my ($keyword, $args) = ($line =~ /^(\S+)\s*(.*)$/s);
1705         if ( $simple_keyword{ $keyword } ) {
1706             push @res, $simple_keyword{ $keyword };
1707             $res[-1]->{'Keyword'} = $keyword;
1708             next;
1709         }
1710         unless ( $parse_keyword{ $keyword } ) {
1711             $RT::Logger->warning("Skipped $keyword") unless $ignore_keyword{ $keyword };
1712             next;
1713         }
1714
1715         if ( $keyword eq 'USERID_HINT' ) {
1716             my %tmp = _ParseUserHint($status, $line);
1717             $latest_user_main_key = $tmp{'MainKey'};
1718             if ( $user_hint{ $tmp{'MainKey'} } ) {
1719                 while ( my ($k, $v) = each %tmp ) {
1720                     $user_hint{ $tmp{'MainKey'} }->{$k} = $v;
1721                 }
1722             } else {
1723                 $user_hint{ $tmp{'MainKey'} } = \%tmp;
1724             }
1725             next;
1726         }
1727         elsif ( $keyword eq 'BAD_PASSPHRASE' || $keyword eq 'GOOD_PASSPHRASE' ) {
1728             my $key_id = $args;
1729             my %res = (
1730                 Operation => 'PassphraseCheck',
1731                 Status    => $keyword eq 'BAD_PASSPHRASE'? 'BAD' : 'DONE',
1732                 Key       => $key_id,
1733             );
1734             $res{'Status'} = 'MISSING' if $status[ $i - 1 ] =~ /^MISSING_PASSPHRASE/;
1735             foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1736                 next unless $line =~ /^NEED_PASSPHRASE\s+(\S+)\s+(\S+)\s+(\S+)/;
1737                 next if $key_id && $2 ne $key_id;
1738                 @res{'MainKey', 'Key', 'KeyType'} = ($1, $2, $3);
1739                 last;
1740             }
1741             $res{'Message'} = ucfirst( lc( $res{'Status'} eq 'DONE'? 'GOOD': $res{'Status'} ) ) .' passphrase';
1742             $res{'User'} = ( $user_hint{ $res{'MainKey'} } ||= {} ) if $res{'MainKey'};
1743             if ( exists $res{'User'}->{'EmailAddress'} ) {
1744                 $res{'Message'} .= ' for '. $res{'User'}->{'EmailAddress'};
1745             } else {
1746                 $res{'Message'} .= " for '0x$key_id'";
1747             }
1748             push @res, \%res;
1749         }
1750         elsif ( $keyword eq 'END_ENCRYPTION' ) {
1751             my %res = (
1752                 Operation => 'Encrypt',
1753                 Status    => 'DONE',
1754                 Message   => 'Data has been encrypted',
1755             );
1756             foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1757                 next unless $line =~ /^BEGIN_ENCRYPTION\s+(\S+)\s+(\S+)/;
1758                 @res{'MdcMethod', 'SymAlgo'} = ($1, $2);
1759                 last;
1760             }
1761             push @res, \%res;
1762         }
1763         elsif ( $keyword eq 'DECRYPTION_FAILED' || $keyword eq 'DECRYPTION_OKAY' ) {
1764             my %res = ( Operation => 'Decrypt' );
1765             @res{'Status', 'Message'} =
1766                 $keyword eq 'DECRYPTION_FAILED'
1767                 ? ('ERROR', 'Decryption failed')
1768                 : ('DONE',  'Decryption process succeeded');
1769
1770             foreach my $line ( reverse @status[ 0 .. $i-1 ] ) {
1771                 next unless $line =~ /^ENC_TO\s+(\S+)\s+(\S+)\s+(\S+)/;
1772                 my ($key, $alg, $key_length) = ($1, $2, $3);
1773
1774                 my %encrypted_to = (
1775                     Message   => "The message is encrypted to '0x$key'",
1776                     User      => ( $user_hint{ $key } ||= {} ),
1777                     Key       => $key,
1778                     KeyLength => $key_length,
1779                     Algorithm => $alg,
1780                 );
1781
1782                 push @{ $res{'EncryptedTo'} ||= [] }, \%encrypted_to;
1783             }
1784
1785             push @res, \%res;
1786         }
1787         elsif ( $keyword eq 'NO_SECKEY' || $keyword eq 'NO_PUBKEY' ) {
1788             my ($key) = split /\s+/, $args;
1789             my $type = $keyword eq 'NO_SECKEY'? 'secret': 'public';
1790             my %res = (
1791                 Operation => 'KeyCheck',
1792                 Status    => 'MISSING',
1793                 Message   => ucfirst( $type ) ." key '0x$key' is not available",
1794                 Key       => $key,
1795                 KeyType   => $type,
1796             );
1797             $res{'User'} = ( $user_hint{ $key } ||= {} );
1798             $res{'User'}{ ucfirst( $type ). 'KeyMissing' } = 1;
1799             push @res, \%res;
1800         }
1801         # GOODSIG, BADSIG, VALIDSIG, TRUST_*
1802         elsif ( $keyword eq 'GOODSIG' ) {
1803             my %res = (
1804                 Operation  => 'Verify',
1805                 Status     => 'DONE',
1806                 Message    => 'The signature is good',
1807             );
1808             @res{qw(Key UserString)} = split /\s+/, $args, 2;
1809             $res{'Message'} .= ', signed by '. $res{'UserString'};
1810
1811             foreach my $line ( @status[ $i .. $#status ] ) {
1812                 next unless $line =~ /^TRUST_(\S+)/;
1813                 $res{'Trust'} = $1;
1814                 last;
1815             }
1816             $res{'Message'} .= ', trust level is '. lc( $res{'Trust'} || 'unknown');
1817
1818             foreach my $line ( @status[ $i .. $#status ] ) {
1819                 next unless $line =~ /^VALIDSIG\s+(.*)/;
1820                 @res{ qw(
1821                     Fingerprint
1822                     CreationDate
1823                     Timestamp
1824                     ExpireTimestamp
1825                     Version
1826                     Reserved
1827                     PubkeyAlgo
1828                     HashAlgo
1829                     Class
1830                     PKFingerprint
1831                     Other
1832                 ) } = split /\s+/, $1, 10;
1833                 last;
1834             }
1835             push @res, \%res;
1836         }
1837         elsif ( $keyword eq 'BADSIG' ) {
1838             my %res = (
1839                 Operation  => 'Verify',
1840                 Status     => 'BAD',
1841                 Message    => 'The signature has not been verified okay',
1842             );
1843             @res{qw(Key UserString)} = split /\s+/, $args, 2;
1844             push @res, \%res;
1845         }
1846         elsif ( $keyword eq 'ERRSIG' ) {
1847             my %res = (
1848                 Operation => 'Verify',
1849                 Status    => 'ERROR',
1850                 Message   => 'Not possible to check the signature',
1851             );
1852             @res{qw(Key PubkeyAlgo HashAlgo Class Timestamp ReasonCode Other)}
1853                 = split /\s+/, $args, 7;
1854
1855             $res{'Reason'} = ReasonCodeToText( $keyword, $res{'ReasonCode'} );
1856             $res{'Message'} .= ", the reason is ". $res{'Reason'};
1857
1858             push @res, \%res;
1859         }
1860         elsif ( $keyword eq 'SIG_CREATED' ) {
1861             # SIG_CREATED <type> <pubkey algo> <hash algo> <class> <timestamp> <key fpr>
1862             my @props = split /\s+/, $args;
1863             push @res, {
1864                 Operation      => 'Sign',
1865                 Status         => 'DONE',
1866                 Message        => "Signed message",
1867                 Type           => $props[0],
1868                 PubKeyAlgo     => $props[1],
1869                 HashKeyAlgo    => $props[2],
1870                 Class          => $props[3],
1871                 Timestamp      => $props[4],
1872                 KeyFingerprint => $props[5],
1873                 User           => $user_hint{ $latest_user_main_key },
1874             };
1875             $res[-1]->{Message} .= ' by '. $user_hint{ $latest_user_main_key }->{'EmailAddress'}
1876                 if $user_hint{ $latest_user_main_key };
1877         }
1878         elsif ( $keyword eq 'INV_RECP' ) {
1879             my ($rcode, $recipient) = split /\s+/, $args, 2;
1880             my $reason = ReasonCodeToText( $keyword, $rcode );
1881             push @res, {
1882                 Operation  => 'RecipientsCheck',
1883                 Status     => 'ERROR',
1884                 Message    => "Recipient '$recipient' is unusable, the reason is '$reason'",
1885                 Recipient  => $recipient,
1886                 ReasonCode => $rcode,
1887                 Reason     => $reason,
1888             };
1889         }
1890         elsif ( $keyword eq 'NODATA' ) {
1891             my $rcode = (split /\s+/, $args)[0];
1892             my $reason = ReasonCodeToText( $keyword, $rcode );
1893             push @res, {
1894                 Operation  => 'Data',
1895                 Status     => 'ERROR',
1896                 Message    => "No data has been found. The reason is '$reason'",
1897                 ReasonCode => $rcode,
1898                 Reason     => $reason,
1899             };
1900         }
1901         else {
1902             $RT::Logger->warning("Keyword $keyword is unknown");
1903             next;
1904         }
1905         $res[-1]{'Keyword'} = $keyword if @res && !$res[-1]{'Keyword'};
1906     }
1907     return @res;
1908 }
1909
1910 sub _ParseUserHint {
1911     my ($status, $hint) = (@_);
1912     my ($main_key_id, $user_str) = ($hint =~ /^USERID_HINT\s+(\S+)\s+(.*)$/);
1913     return () unless $main_key_id;
1914     return (
1915         MainKey      => $main_key_id,
1916         String       => $user_str,
1917         EmailAddress => (map $_->address, Email::Address->parse( $user_str ))[0],
1918     );
1919 }
1920
1921 sub _PrepareGnuPGOptions {
1922     my %opt = @_;
1923     my %res = map { lc $_ => $opt{ $_ } } grep $supported_opt{ lc $_ }, keys %opt;
1924     $res{'extra_args'} ||= [];
1925     foreach my $o ( grep !$supported_opt{ lc $_ }, keys %opt ) {
1926         push @{ $res{'extra_args'} }, '--'. lc $o;
1927         push @{ $res{'extra_args'} }, $opt{ $o }
1928             if defined $opt{ $o };
1929     }
1930     return %res;
1931 }
1932
1933 { my %key;
1934 # no args -> clear
1935 # one arg -> return preferred key
1936 # many -> set
1937 sub UseKeyForEncryption {
1938     unless ( @_ ) {
1939         %key = ();
1940     } elsif ( @_ > 1 ) {
1941         %key = (%key, @_);
1942         $key{ lc($_) } = delete $key{ $_ } foreach grep lc ne $_, keys %key;
1943     } else {
1944         return $key{ $_[0] };
1945     }
1946     return ();
1947 } }
1948
1949 =head2 UseKeyForSigning
1950
1951 Returns or sets identifier of the key that should be used for signing.
1952
1953 Returns the current value when called without arguments.
1954
1955 Sets new value when called with one argument and unsets if it's undef.
1956
1957 =cut
1958
1959 { my $key;
1960 sub UseKeyForSigning {
1961     if ( @_ ) {
1962         $key = $_[0];
1963     }
1964     return $key;
1965 } }
1966
1967 =head2 GetKeysForEncryption
1968
1969 Takes identifier and returns keys suitable for encryption.
1970
1971 B<Note> that keys for which trust level is not set are
1972 also listed.
1973
1974 =cut
1975
1976 sub GetKeysForEncryption {
1977     my $key_id = shift;
1978     my %res = GetKeysInfo( $key_id, 'public', @_ );
1979     return %res if $res{'exit_code'};
1980     return %res unless $res{'info'};
1981
1982     foreach my $key ( splice @{ $res{'info'} } ) {
1983         # skip disabled keys
1984         next if $key->{'Capabilities'} =~ /D/;
1985         # skip keys not suitable for encryption
1986         next unless $key->{'Capabilities'} =~ /e/i;
1987         # skip disabled, expired, revoke and keys with no trust,
1988         # but leave keys with unknown trust level
1989         next if $key->{'TrustLevel'} < 0;
1990
1991         push @{ $res{'info'} }, $key;
1992     }
1993     delete $res{'info'} unless @{ $res{'info'} };
1994     return %res;
1995 }
1996
1997 sub GetKeysForSigning {
1998     my $key_id = shift;
1999     return GetKeysInfo( $key_id, 'private', @_ );
2000 }
2001
2002 sub CheckRecipients {
2003     my @recipients = (@_);
2004
2005     my ($status, @issues) = (1, ());
2006
2007     my %seen;
2008     foreach my $address ( grep !$seen{ lc $_ }++, map $_->address, @recipients ) {
2009         my %res = GetKeysForEncryption( $address );
2010         if ( $res{'info'} && @{ $res{'info'} } == 1 && $res{'info'}[0]{'TrustLevel'} > 0 ) {
2011             # good, one suitable and trusted key
2012             next;
2013         }
2014         my $user = RT::User->new( $RT::SystemUser );
2015         $user->LoadByEmail( $address );
2016         # it's possible that we have no User record with the email
2017         $user = undef unless $user->id;
2018
2019         if ( my $fpr = UseKeyForEncryption( $address ) ) {
2020             if ( $res{'info'} && @{ $res{'info'} } ) {
2021                 next if
2022                     grep lc $_->{'Fingerprint'} eq lc $fpr,
2023                     grep $_->{'TrustLevel'} > 0,
2024                     @{ $res{'info'} };
2025             }
2026
2027             $status = 0;
2028             my %issue = (
2029                 EmailAddress => $address,
2030                 $user? (User => $user) : (),
2031                 Keys => undef,
2032             );
2033             $issue{'Message'} = "Selected key either is not trusted or doesn't exist anymore."; #loc
2034             push @issues, \%issue;
2035             next;
2036         }
2037
2038         my $prefered_key;
2039         $prefered_key = $user->PreferredKey if $user;
2040         #XXX: prefered key is not yet implemented...
2041
2042         # classify errors
2043         $status = 0;
2044         my %issue = (
2045             EmailAddress => $address,
2046             $user? (User => $user) : (),
2047             Keys => undef,
2048         );
2049
2050         unless ( $res{'info'} && @{ $res{'info'} } ) {
2051             # no key
2052             $issue{'Message'} = "There is no key suitable for encryption."; #loc
2053         }
2054         elsif ( @{ $res{'info'} } == 1 && !$res{'info'}[0]{'TrustLevel'} ) {
2055             # trust is not set
2056             $issue{'Message'} = "There is one suitable key, but trust level is not set."; #loc
2057         }
2058         else {
2059             # multiple keys
2060             $issue{'Message'} = "There are several keys suitable for encryption."; #loc
2061         }
2062         push @issues, \%issue;
2063     }
2064     return ($status, @issues);
2065 }
2066
2067 sub GetPublicKeyInfo {
2068     return GetKeyInfo( shift, 'public', @_ );
2069 }
2070
2071 sub GetPrivateKeyInfo {
2072     return GetKeyInfo( shift, 'private', @_ );
2073 }
2074
2075 sub GetKeyInfo {
2076     my %res = GetKeysInfo(@_);
2077     $res{'info'} = $res{'info'}->[0];
2078     return %res;
2079 }
2080
2081 sub GetKeysInfo {
2082     my $email = shift;
2083     my $type = shift || 'public';
2084     my $force = shift;
2085
2086     unless ( $email ) {
2087         return (exit_code => 0) unless $force;
2088     }
2089
2090     my $gnupg = new GnuPG::Interface;
2091     my %opt = RT->Config->Get('GnuPGOptions');
2092     $opt{'digest-algo'} ||= 'SHA1';
2093     $opt{'with-colons'} = undef; # parseable format
2094     $opt{'fingerprint'} = undef; # show fingerprint
2095     $opt{'fixed-list-mode'} = undef; # don't merge uid with keys
2096     $gnupg->options->hash_init(
2097         _PrepareGnuPGOptions( %opt ),
2098         armor => 1,
2099         meta_interactive => 0,
2100     );
2101
2102     my %res;
2103
2104     my ($handles, $handle_list) = _make_gpg_handles();
2105     my %handle = %$handle_list;
2106
2107     eval {
2108         local $SIG{'CHLD'} = 'DEFAULT';
2109         my $method = $type eq 'private'? 'list_secret_keys': 'list_public_keys';
2110         my $pid = safe_run_child { $gnupg->$method( handles => $handles, $email? (command_args => $email) : () ) };
2111         close $handle{'stdin'};
2112         waitpid $pid, 0;
2113     };
2114
2115     my @info = readline $handle{'stdout'};
2116     close $handle{'stdout'};
2117
2118     $res{'exit_code'} = $?;
2119     foreach ( qw(stderr logger status) ) {
2120         $res{$_} = do { local $/; readline $handle{$_} };
2121         delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2122         close $handle{$_};
2123     }
2124     $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2125     $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2126     $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2127     if ( $@ || $? ) {
2128         $res{'message'} = $@? $@: "gpg exitted with error code ". ($? >> 8);
2129         return %res;
2130     }
2131
2132     @info = ParseKeysInfo( @info );
2133     $res{'info'} = \@info;
2134     return %res;
2135 }
2136
2137 sub ParseKeysInfo {
2138     my @lines = @_;
2139
2140     my %gpg_opt = RT->Config->Get('GnuPGOptions');
2141
2142     my @res = ();
2143     foreach my $line( @lines ) {
2144         chomp $line;
2145         my $tag;
2146         ($tag, $line) = split /:/, $line, 2;
2147         if ( $tag eq 'pub' ) {
2148             my %info;
2149             @info{ qw(
2150                 TrustChar KeyLength Algorithm Key
2151                 Created Expire Empty OwnerTrustChar
2152                 Empty Empty Capabilities Other
2153             ) } = split /:/, $line, 12;
2154
2155             # workaround gnupg's wierd behaviour, --list-keys command report calculated trust levels
2156             # for any model except 'always', so you can change models and see changes, but not for 'always'
2157             # we try to handle it in a simple way - we set ultimate trust for any key with trust
2158             # level >= 0 if trust model is 'always'
2159             my $always_trust;
2160             $always_trust = 1 if exists $gpg_opt{'always-trust'};
2161             $always_trust = 1 if exists $gpg_opt{'trust-model'} && $gpg_opt{'trust-model'} eq 'always';
2162             @info{qw(Trust TrustTerse TrustLevel)} =
2163                 _ConvertTrustChar( $info{'TrustChar'} );
2164             if ( $always_trust && $info{'TrustLevel'} >= 0 ) {
2165                 @info{qw(Trust TrustTerse TrustLevel)} =
2166                     _ConvertTrustChar( 'u' );
2167             }
2168
2169             @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
2170                 _ConvertTrustChar( $info{'OwnerTrustChar'} );
2171             $info{ $_ } = _ParseDate( $info{ $_ } )
2172                 foreach qw(Created Expire);
2173             push @res, \%info;
2174         }
2175         elsif ( $tag eq 'sec' ) {
2176             my %info;
2177             @info{ qw(
2178                 Empty KeyLength Algorithm Key
2179                 Created Expire Empty OwnerTrustChar
2180                 Empty Empty Capabilities Other
2181             ) } = split /:/, $line, 12;
2182             @info{qw(OwnerTrust OwnerTrustTerse OwnerTrustLevel)} =
2183                 _ConvertTrustChar( $info{'OwnerTrustChar'} );
2184             $info{ $_ } = _ParseDate( $info{ $_ } )
2185                 foreach qw(Created Expire);
2186             push @res, \%info;
2187         }
2188         elsif ( $tag eq 'uid' ) {
2189             my %info;
2190             @info{ qw(Trust Created Expire String) }
2191                 = (split /:/, $line)[0,4,5,8];
2192             $info{ $_ } = _ParseDate( $info{ $_ } )
2193                 foreach qw(Created Expire);
2194             push @{ $res[-1]{'User'} ||= [] }, \%info;
2195         }
2196         elsif ( $tag eq 'fpr' ) {
2197             $res[-1]{'Fingerprint'} = (split /:/, $line, 10)[8];
2198         }
2199     }
2200     return @res;
2201 }
2202
2203 {
2204     my %verbose = (
2205         # deprecated
2206         d   => [
2207             "The key has been disabled", #loc
2208             "key disabled", #loc
2209             "-2"
2210         ],
2211
2212         r   => [
2213             "The key has been revoked", #loc
2214             "key revoked", #loc
2215             -3,
2216         ],
2217
2218         e   => [ "The key has expired", #loc
2219             "key expired", #loc
2220             '-4',
2221         ],
2222
2223         n   => [ "Don't trust this key at all", #loc
2224             'none', #loc
2225             -1,
2226         ],
2227
2228         #gpupg docs says that '-' and 'q' may safely be treated as the same value
2229         '-' => [
2230             'Unknown (no trust value assigned)', #loc
2231             'not set',
2232             0,
2233         ],
2234         q   => [
2235             'Unknown (no trust value assigned)', #loc
2236             'not set',
2237             0,
2238         ],
2239         o   => [
2240             'Unknown (this value is new to the system)', #loc
2241             'unknown',
2242             0,
2243         ],
2244
2245         m   => [
2246             "There is marginal trust in this key", #loc
2247             'marginal', #loc
2248             1,
2249         ],
2250         f   => [
2251             "The key is fully trusted", #loc
2252             'full', #loc
2253             2,
2254         ],
2255         u   => [
2256             "The key is ultimately trusted", #loc
2257             'ultimate', #loc
2258             3,
2259         ],
2260     );
2261
2262     sub _ConvertTrustChar {
2263         my $value = shift;
2264         return @{ $verbose{'-'} } unless $value;
2265         $value = substr $value, 0, 1;
2266         return @{ $verbose{ $value } || $verbose{'o'} };
2267     }
2268 }
2269
2270 sub _ParseDate {
2271     my $value = shift;
2272     # never
2273     return $value unless $value;
2274
2275     require RT::Date;
2276     my $obj = RT::Date->new( $RT::SystemUser );
2277     # unix time
2278     if ( $value =~ /^\d+$/ ) {
2279         $obj->Set( Value => $value );
2280     } else {
2281         $obj->Set( Format => 'unknown', Value => $value, Timezone => 'utc' );
2282     }
2283     return $obj;
2284 }
2285
2286 sub DeleteKey {
2287     my $key = shift;
2288
2289     my $gnupg = new GnuPG::Interface;
2290     my %opt = RT->Config->Get('GnuPGOptions');
2291     $gnupg->options->hash_init(
2292         _PrepareGnuPGOptions( %opt ),
2293         meta_interactive => 0,
2294     );
2295
2296     my ($handles, $handle_list) = _make_gpg_handles();
2297     my %handle = %$handle_list;
2298
2299     eval {
2300         local $SIG{'CHLD'} = 'DEFAULT';
2301         local @ENV{'LANG', 'LC_ALL'} = ('C', 'C');
2302         my $pid = safe_run_child { $gnupg->wrap_call(
2303             handles => $handles,
2304             commands => ['--delete-secret-and-public-key'],
2305             command_args => [$key],
2306         ) };
2307         close $handle{'stdin'};
2308         while ( my $str = readline $handle{'status'} ) {
2309             if ( $str =~ /^\[GNUPG:\]\s*GET_BOOL delete_key\..*/ ) {
2310                 print { $handle{'command'} } "y\n";
2311             }
2312         }
2313         waitpid $pid, 0;
2314     };
2315     my $err = $@;
2316     close $handle{'stdout'};
2317
2318     my %res;
2319     $res{'exit_code'} = $?;
2320     foreach ( qw(stderr logger status) ) {
2321         $res{$_} = do { local $/; readline $handle{$_} };
2322         delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2323         close $handle{$_};
2324     }
2325     $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2326     $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2327     $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2328     if ( $err || $res{'exit_code'} ) {
2329         $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
2330     }
2331     return %res;
2332 }
2333
2334 sub ImportKey {
2335     my $key = shift;
2336
2337     my $gnupg = new GnuPG::Interface;
2338     my %opt = RT->Config->Get('GnuPGOptions');
2339     $gnupg->options->hash_init(
2340         _PrepareGnuPGOptions( %opt ),
2341         meta_interactive => 0,
2342     );
2343
2344     my ($handles, $handle_list) = _make_gpg_handles();
2345     my %handle = %$handle_list;
2346
2347     eval {
2348         local $SIG{'CHLD'} = 'DEFAULT';
2349         local @ENV{'LANG', 'LC_ALL'} = ('C', 'C');
2350         my $pid = safe_run_child { $gnupg->wrap_call(
2351             handles => $handles,
2352             commands => ['--import'],
2353         ) };
2354         print { $handle{'stdin'} } $key;
2355         close $handle{'stdin'};
2356         waitpid $pid, 0;
2357     };
2358     my $err = $@;
2359     close $handle{'stdout'};
2360
2361     my %res;
2362     $res{'exit_code'} = $?;
2363     foreach ( qw(stderr logger status) ) {
2364         $res{$_} = do { local $/; readline $handle{$_} };
2365         delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
2366         close $handle{$_};
2367     }
2368     $RT::Logger->debug( $res{'status'} ) if $res{'status'};
2369     $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
2370     $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
2371     if ( $err || $res{'exit_code'} ) {
2372         $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
2373     }
2374     return %res;
2375 }
2376
2377 =head2 KEY
2378
2379 Signs a small message with the key, to make sure the key exists and
2380 we have a useable passphrase. The first argument MUST be a key identifier
2381 of the signer: either email address, key id or finger print.
2382
2383 Returns a true value if all went well.
2384
2385 =cut
2386
2387 sub DrySign {
2388     my $from = shift;
2389
2390     my $mime = MIME::Entity->build(
2391         Type    => "text/plain",
2392         From    => 'nobody@localhost',
2393         To      => 'nobody@localhost',
2394         Subject => "dry sign",
2395         Data    => ['t'],
2396     );
2397
2398     my %res = SignEncrypt(
2399         Sign    => 1,
2400         Encrypt => 0,
2401         Entity  => $mime,
2402         Signer  => $from,
2403     );
2404
2405     return $res{exit_code} == 0;
2406 }
2407
2408 1;
2409
2410 =head2 Probe
2411
2412 This routine returns true if RT's GnuPG support is configured and working
2413 properly (and false otherwise).
2414
2415
2416 =cut
2417
2418
2419 sub Probe {
2420     my $gnupg = new GnuPG::Interface;
2421     my %opt = RT->Config->Get('GnuPGOptions');
2422     $gnupg->options->hash_init(
2423         _PrepareGnuPGOptions( %opt ),
2424         armor => 1,
2425         meta_interactive => 0,
2426     );
2427
2428     my ($handles, $handle_list) = _make_gpg_handles();
2429     my %handle = %$handle_list;
2430
2431     local $@;
2432     eval {
2433         local $SIG{'CHLD'} = 'DEFAULT';
2434         my $pid = safe_run_child { $gnupg->wrap_call( commands => ['--version' ], handles => $handles ) };
2435         close $handle{'stdin'};
2436         waitpid $pid, 0;
2437     };
2438     if ( $@ ) {
2439         $RT::Logger->debug(
2440             "Probe for GPG failed."
2441             ." Couldn't run `gpg --version`: ". $@
2442         );
2443         return 0;
2444     }
2445
2446 # on some systems gpg exits with code 2, but still 100% functional,
2447 # it's general error system error or incorrect command, command is correct,
2448 # but there is no way to get actuall error
2449     if ( $? && ($? >> 8) != 2 ) {
2450         my $msg = "Probe for GPG failed."
2451             ." Process exitted with code ". ($? >> 8)
2452             . ($? & 127 ? (" as recieved signal ". ($? & 127)) : '')
2453             . ".";
2454         foreach ( qw(stderr logger status) ) {
2455             my $tmp = do { local $/; readline $handle{$_} };
2456             next unless $tmp && $tmp =~ /\S/s;
2457             close $handle{$_};
2458             $msg .= "\n$_:\n$tmp\n";
2459         }
2460         $RT::Logger->debug( $msg );
2461         return 0;
2462     }
2463     return 1;
2464 }
2465
2466
2467 sub _make_gpg_handles {
2468     my %handle_map = (@_);
2469     $handle_map{$_} = IO::Handle->new
2470         foreach grep !defined $handle_map{$_},
2471         qw(stdin stdout stderr logger status command);
2472
2473     my $handles = GnuPG::Handles->new(%handle_map);
2474     return ($handles, \%handle_map);
2475 }
2476
2477 RT::Base->_ImportOverlays();
2478
2479 # helper package to avoid using temp file
2480 package IO::Handle::CRLF;
2481
2482 use base qw(IO::Handle);
2483
2484 sub print {
2485     my ($self, @args) = (@_);
2486     s/\r*\n/\x0D\x0A/g foreach @args;
2487     return $self->SUPER::print( @args );
2488 }
2489
2490 1;