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