GnuPG.pm

# BEGIN BPS TAGGED BLOCK {{{
# 
# COPYRIGHT:
# 
# This software is Copyright (c) 1996-2010 Best Practical Solutions, LLC
#                                          <jesse@bestpractical.com>
# 
# (Except where explicitly superseded by other copyright notices)
# 
# 
# LICENSE:
# 
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
# 
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
# 
# 
# CONTRIBUTION SUBMISSION POLICY:
# 
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
# 
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# you are the copyright holder for those contributions and you grant
# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
# 
# END BPS TAGGED BLOCK }}}

use strict;
use warnings;

package RT::Crypt::GnuPG;

use IO::Handle;
use GnuPG::Interface;
use RT::EmailParser ();
use RT::Util 'safe_run_child';

=head1 NAME

RT::Crypt::GnuPG - encrypt/decrypt and sign/verify email messages with the GNU Privacy Guard (GPG)

=head1 DESCRIPTION

This module provides support for encryption and signing of outgoing messages, 
as well as the decryption and verification of incoming email.

=head1 CONFIGURATION

You can control the configuration of this subsystem from RT's configuration file.
Some options are available via the web interface, but to enable this functionality, you
MUST start in the configuration file.

There are two hashes, GnuPG and GnuPGOptions in the configuration file. The 
first one controls RT specific options. It enables you to enable/disable facility 
or change the format of messages. The second one is a hash with options for the 
'gnupg' utility. You can use it to define a keyserver, enable auto-retrieval keys 
and set almost any option 'gnupg' supports on your system.

=head2 %GnuPG

=head3 Enabling GnuPG

Set to true value to enable this subsystem:

    Set( %GnuPG,
        Enable => 1,
        ... other options ...
    );

However, note that you B<must> add the 'Auth::GnuPG' email filter to enable
the handling of incoming encrypted/signed messages.

=head3 Format of outgoing messages

Format of outgoing messages can be controlled using the 'OutgoingMessagesFormat'
option in the RT config:

    Set( %GnuPG,
        ... other options ...
        OutgoingMessagesFormat => 'RFC',
        ... other options ...
    );

or

    Set( %GnuPG,
        ... other options ...
        OutgoingMessagesFormat => 'Inline',
        ... other options ...
    );

This framework implements two formats of signing and encrypting of email messages:

=over

=item RFC

This format is also known as GPG/MIME and described in RFC3156 and RFC1847.
Technique described in these RFCs is well supported by many mail user
agents (MUA), but some MUAs support only inline signatures and encryption,
so it's possible to use inline format (see below).

=item Inline

This format doesn't take advantage of MIME, but some mail clients do
not support GPG/MIME.

We sign text parts using clear signatures. For each attachments another
attachment with a signature is added with '.sig' extension.

Encryption of text parts is implemented using inline format, other parts
are replaced with attachments with the filename extension '.pgp'.

This format is discouraged because modern mail clients typically don't support
it well.

=back

=head3 Encrypting data in the database

You can allow users to encrypt data in the database using
option C<AllowEncryptDataInDB>. By default it's disabled.
Users must have rights to see and modify tickets to use
this feature.

=head2 %GnuPGOptions

Use this hash to set options of the 'gnupg' program. You can define almost any
option you want which  gnupg supports, but never try to set options which
change output format or gnupg's commands, such as --sign (command),
--list-options (option) and other.

Some GnuPG options take arguments while others take none. (Such as  --use-agent).
For options without specific value use C<undef> as hash value.
To disable these option just comment them out or delete them from the hash

    Set(%GnuPGOptions,
        'option-with-value' => 'value',
        'enabled-option-without-value' => undef,
        # 'commented-option' => 'value or undef',
    );

B<NOTE> that options may contain '-' character and such options B<MUST> be
quoted, otherwise you can see quite cryptic error 'gpg: Invalid option "--0"'.

=over

=item --homedir

The GnuPG home directory, by default it is set to F</opt/rt3/var/data/gpg>.

You can manage this data with the 'gpg' commandline utility 
using the GNUPGHOME environment variable or --homedir option. 
Other utilities may be used as well.

In a standard installation, access to this directory should be granted to
the web server user which is running RT's web interface, but if you're running
cronjobs or other utilities that access RT directly via API and may generate
encrypted/signed notifications then the users you execute these scripts under
must have access too. 

However, granting access to the dir to many users makes your setup less secure,
some features, such as auto-import of keys, may not be available if you do not.
To enable this features and suppress warnings about permissions on
the dir use --no-permission-warning.

=item --digest-algo

This option is required in advance when RFC format for outgoing messages is
used. We can not get default algorithm from gpg program so RT uses 'SHA1' by
default. You may want to override it. You can use MD5, SHA1, RIPEMD160,
SHA256 or other, however use `gpg --version` command to get information about
supported algorithms by your gpg. These algorithms are listed as hash-functions.

=item --use-agent

This option lets you use GPG Agent to cache the passphrase of RT's key. See
L<http://www.gnupg.org/documentation/manuals/gnupg/Invoking-GPG_002dAGENT.html>
for information about GPG Agent.

=item --passphrase

This option lets you set the passphrase of RT's key directly. This option is
special in that it isn't passed directly to GPG, but is put into a file that
GPG then reads (which is more secure). The downside is that anyone who has read
access to your RT_SiteConfig.pm file can see the passphrase, thus we recommend
the --use-agent option instead.

=item other

Read `man gpg` to get list of all options this program support.

=back

=head2 Per-queue options

Using the web interface it's possible to enable signing and/or encrypting by
default. As an administrative user of RT, open 'Configuration' then 'Queues',
and select a queue. On the page you can see information about the queue's keys 
at the bottom and two checkboxes to choose default actions.

As well, encryption is enabled for autoreplies and other notifications when
an encypted message enters system via mailgate interface even if queue's
option is disabled.

=head2 Handling incoming messages

To enable handling of encrypted and signed message in the RT you should add
'Auth::GnuPG' mail plugin.

    Set(@MailPlugins, 'Auth::MailFrom', 'Auth::GnuPG', ...other filter...);

See also `perldoc lib/RT/Interface/Email/Auth/GnuPG.pm`.

=head2 Errors handling

There are several global templates created in the database by default. RT
uses these templates to send error messages to users or RT's owner. These 
templates have 'Error:' or 'Error to RT owner:' prefix in the name. You can 
adjust the text of the messages using the web interface.

Note that C<$TicketObj>, C<$TransactionObj> and other variable usually available
in RT's templates are not available in these templates, but each template
used for errors reporting has set of available data structures you can use to
build better messages. See default templates and descriptions below.

As well, you can disable particular notification by deleting content of
a template. You can delete a template too, but in this case you'll see
error messages in the logs when RT can not load template you've deleted.

=head3 Problems with public keys

Template 'Error: public key' is used to inform the user that RT has problems with
his public key and won't be able to send him encrypted content. There are several 
reasons why RT can't use a key. However, the actual reason is not sent to the user, 
but sent to RT owner using 'Error to RT owner: public key'.

The possible reasons: "Not Found", "Ambiguous specification", "Wrong
key usage", "Key revoked", "Key expired", "No CRL known", "CRL too
old", "Policy mismatch", "Not a secret key", "Key not trusted" or
"No specific reason given".

Due to limitations of GnuPG, it's impossible to encrypt to an untrusted key,
unless 'always trust' mode is enabled.

In the 'Error: public key' template there are a few additional variables available:

=over 4

=item $Message - user friendly error message

=item $Reason - short reason as listed above

=item $Recipient - recipient's identification

=item $AddressObj - L<Email::Address> object containing recipient's email address

=back

A message can have several invalid recipients, to avoid sending many emails
to the RT owner the system sends one message to the owner, grouped by
recipient. In the 'Error to RT owner: public key' template a C<@BadRecipients>
array is available where each element is a hash reference that describes one
recipient using the same fields as described above. So it's something like:

    @BadRecipients = (
        { Message => '...', Reason => '...', Recipient => '...', ...},
        { Message => '...', Reason => '...', Recipient => '...', ...},
        ...
    )

=head3 Private key doesn't exist

Template 'Error: no private key' is used to inform the user that
he sent an encrypted email, but we have no private key to decrypt
it.

In this template C<$Message> object of L<MIME::Entity> class
available. It's the message RT received.

=head3 Invalid data

Template 'Error: bad GnuPG data' used to inform the user that a
message he sent has invalid data and can not be handled.

There are several reasons for this error, but most of them are data
corruption or absence of expected information.

In this template C<@Messages> array is available and contains list
of error messages.

=head1 FOR DEVELOPERS

=head2 Documentation and references

* RFC1847 - Security Multiparts for MIME: Multipart/Signed and Multipart/Encrypted.
Describes generic MIME security framework, "mulitpart/signed" and "multipart/encrypted"
MIME types.

* RFC3156 - MIME Security with Pretty Good Privacy (PGP),
updates RFC2015.

=cut

# gnupg options supported by GnuPG::Interface
# other otions should be handled via extra_args argument
my %supported_opt = map { $_ => 1 } qw(
       always_trust
       armor
       batch
       comment
       compress_algo
       default_key
       encrypt_to
       extra_args
       force_v3_sigs
       homedir
       logger_fd
       no_greeting
       no_options
       no_verbose
       openpgp
       options
       passphrase_fd
       quiet
       recipients
       rfc1991
       status_fd
       textmode
       verbose
);

# DEV WARNING: always pass all STD* handles to GnuPG interface even if we don't
# need them, just pass 'new IO::Handle' and then close it after safe_run_child.
# we don't want to leak anything into FCGI/Apache/MP handles, this break things.
# So code should look like:
#        my $handles = GnuPG::Handles->new(
#            stdin  => ($handle{'stdin'}  = new IO::Handle),
#            stdout => ($handle{'stdout'} = new IO::Handle),
#            stderr => ($handle{'stderr'}  = new IO::Handle),
#            ...
#        );

=head2 SignEncrypt Entity => MIME::Entity, [ Encrypt => 1, Sign => 1, ... ]

Signs and/or encrypts an email message with GnuPG utility.

=over

=item Signing

During signing you can pass C<Signer> argument to set key we sign with this option
overrides gnupg's C<default-key> option. If C<Signer> argument is not provided
then address of a message sender is used.

As well you can pass C<Passphrase>, but if value is undefined then L</GetPassphrase>
called to get it.

=item Encrypting

During encryption you can pass a C<Recipients> array, otherwise C<To>, C<Cc> and
C<Bcc> fields of the message are used to fetch the list.

=back

Returns a hash with the following keys:

* exit_code
* error
* logger
* status
* message

=cut

sub SignEncrypt {
    my %args = (@_);

    my $entity = $args{'Entity'};
    if ( $args{'Sign'} && !defined $args{'Signer'} ) {
        $args{'Signer'} = UseKeyForSigning()
            || (Email::Address->parse( $entity->head->get( 'From' ) ))[0]->address;
    }
    if ( $args{'Encrypt'} && !$args{'Recipients'} ) {
        my %seen;
        $args{'Recipients'} = [
            grep $_ && !$seen{ $_ }++, map $_->address,
            map Email::Address->parse( $entity->head->get( $_ ) ),
            qw(To Cc Bcc)
        ];
    }
    
    my $format = lc RT->Config->Get('GnuPG')->{'OutgoingMessagesFormat'} || 'RFC';
    if ( $format eq 'inline' ) {
        return SignEncryptInline( %args );
    } else {
        return SignEncryptRFC3156( %args );
    }
}

sub SignEncryptRFC3156 {
    my %args = (
        Entity => undef,

        Sign => 1,
        Signer => undef,
        Passphrase => undef,

        Encrypt => 1,
        Recipients => undef,

        @_
    );

    my $gnupg = new GnuPG::Interface;
    my %opt = RT->Config->Get('GnuPGOptions');

    # handling passphrase in GnuPGOptions
    $args{'Passphrase'} = delete $opt{'passphrase'}
        if !defined $args{'Passphrase'};

    $opt{'digest-algo'} ||= 'SHA1';
    $opt{'default_key'} = $args{'Signer'}
        if $args{'Sign'} && $args{'Signer'};
    $gnupg->options->hash_init(
        _PrepareGnuPGOptions( %opt ),
        armor => 1,
        meta_interactive => 0,
    );

    my $entity = $args{'Entity'};

    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
    }

    my %res;
    if ( $args{'Sign'} && !$args{'Encrypt'} ) {
        # required by RFC3156(Ch. 5) and RFC1847(Ch. 2.1)
        foreach ( grep !$_->is_multipart, $entity->parts_DFS ) {
            my $tenc = $_->head->mime_encoding;
            unless ( $tenc =~ m/^(?:7bit|quoted-printable|base64)$/i ) {
                $_->head->mime_attr( 'Content-Transfer-Encoding'
                    => $_->effective_type =~ m{^text/}? 'quoted-printable': 'base64'
                );
            }
        }

        my ($handles, $handle_list) = _make_gpg_handles(stdin =>IO::Handle::CRLF->new );
        my %handle = %$handle_list;

        $gnupg->passphrase( $args{'Passphrase'} );

        eval {
            local $SIG{'CHLD'} = 'DEFAULT';
            my $pid = safe_run_child { $gnupg->detach_sign( handles => $handles ) };
            $entity->make_multipart( 'mixed', Force => 1 );
            {
                local $SIG{'PIPE'} = 'IGNORE';
                $entity->parts(0)->print( $handle{'stdin'} );
                close $handle{'stdin'};
            }
            waitpid $pid, 0;
        };
        my $err = $@;
        my @signature = readline $handle{'stdout'};
        close $handle{'stdout'};

        $res{'exit_code'} = $?;
        foreach ( qw(stderr logger status) ) {
            $res{$_} = do { local $/; readline $handle{$_} };
            delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
            close $handle{$_};
        }
        $RT::Logger->debug( $res{'status'} ) if $res{'status'};
        $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
        $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
        if ( $err || $res{'exit_code'} ) {
            $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
            return %res;
        }

        # setup RFC1847(Ch.2.1) requirements
        my $protocol = 'application/pgp-signature';
        $entity->head->mime_attr( 'Content-Type' => 'multipart/signed' );
        $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
        $entity->head->mime_attr( 'Content-Type.micalg'   => 'pgp-'. lc $opt{'digest-algo'} );
        $entity->attach(
            Type        => $protocol,
            Disposition => 'inline',
            Data        => \@signature,
            Encoding    => '7bit',
        );
    }
    if ( $args{'Encrypt'} ) {
        my %seen;
        $gnupg->options->push_recipients( $_ ) foreach 
            map UseKeyForEncryption($_) || $_,
            grep !$seen{ $_ }++, map $_->address,
            map Email::Address->parse( $entity->head->get( $_ ) ),
            qw(To Cc Bcc);

        my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
        binmode $tmp_fh, ':raw';

        my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
        my %handle = %$handle_list;
        $handles->options( 'stdout'  )->{'direct'} = 1;
        $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};

        eval {
            local $SIG{'CHLD'} = 'DEFAULT';
            my $pid = safe_run_child { $args{'Sign'}
                ? $gnupg->sign_and_encrypt( handles => $handles )
                : $gnupg->encrypt( handles => $handles ) };
            $entity->make_multipart( 'mixed', Force => 1 );
            {
                local $SIG{'PIPE'} = 'IGNORE';
                $entity->parts(0)->print( $handle{'stdin'} );
                close $handle{'stdin'};
            }
            waitpid $pid, 0;
        };

        $res{'exit_code'} = $?;
        foreach ( qw(stderr logger status) ) {
            $res{$_} = do { local $/; readline $handle{$_} };
            delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
            close $handle{$_};
        }
        $RT::Logger->debug( $res{'status'} ) if $res{'status'};
        $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
        $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
        if ( $@ || $? ) {
            $res{'message'} = $@? $@: "gpg exited with error code ". ($? >> 8);
            return %res;
        }

        my $protocol = 'application/pgp-encrypted';
        $entity->parts([]);
        $entity->head->mime_attr( 'Content-Type' => 'multipart/encrypted' );
        $entity->head->mime_attr( 'Content-Type.protocol' => $protocol );
        $entity->attach(
            Type        => $protocol,
            Disposition => 'inline',
            Data        => ['Version: 1',''],
            Encoding    => '7bit',
        );
        $entity->attach(
            Type        => 'application/octet-stream',
            Disposition => 'inline',
            Path        => $tmp_fn,
            Filename    => '',
            Encoding    => '7bit',
        );
        $entity->parts(-1)->bodyhandle->{'_dirty_hack_to_save_a_ref_tmp_fh'} = $tmp_fh;
    }
    return %res;
}

sub SignEncryptInline {
    my %args = ( @_ );

    my $entity = $args{'Entity'};

    my %res;
    $entity->make_singlepart;
    if ( $entity->is_multipart ) {
        foreach ( $entity->parts ) {
            %res = SignEncryptInline( @_, Entity => $_ );
            return %res if $res{'exit_code'};
        }
        return %res;
    }

    return _SignEncryptTextInline( @_ )
        if $entity->effective_type =~ /^text\//i;

    return _SignEncryptAttachmentInline( @_ );
}

sub _SignEncryptTextInline {
    my %args = (
        Entity => undef,

        Sign => 1,
        Signer => undef,
        Passphrase => undef,

        Encrypt => 1,
        Recipients => undef,

        @_
    );
    return unless $args{'Sign'} || $args{'Encrypt'};

    my $gnupg = new GnuPG::Interface;
    my %opt = RT->Config->Get('GnuPGOptions');

    # handling passphrase in GnupGOptions
    $args{'Passphrase'} = delete $opt{'passphrase'}
        if !defined($args{'Passphrase'});

    $opt{'digest-algo'} ||= 'SHA1';
    $opt{'default_key'} = $args{'Signer'}
        if $args{'Sign'} && $args{'Signer'};
    $gnupg->options->hash_init(
        _PrepareGnuPGOptions( %opt ),
        armor => 1,
        meta_interactive => 0,
    );

    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
    }

    if ( $args{'Encrypt'} ) {
        $gnupg->options->push_recipients( $_ ) foreach 
            map UseKeyForEncryption($_) || $_,
            @{ $args{'Recipients'} || [] };
    }

    my %res;

    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
    binmode $tmp_fh, ':raw';

    my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
    my %handle = %$handle_list;

    $handles->options( 'stdout'  )->{'direct'} = 1;
    $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};

    my $entity = $args{'Entity'};
    eval {
        local $SIG{'CHLD'} = 'DEFAULT';
        my $method = $args{'Sign'} && $args{'Encrypt'}
            ? 'sign_and_encrypt'
            : ($args{'Sign'}? 'clearsign': 'encrypt');
        my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
        {
            local $SIG{'PIPE'} = 'IGNORE';
            $entity->bodyhandle->print( $handle{'stdin'} );
            close $handle{'stdin'};
        }
        waitpid $pid, 0;
    };
    $res{'exit_code'} = $?;
    my $err = $@;

    foreach ( qw(stderr logger status) ) {
        $res{$_} = do { local $/; readline $handle{$_} };
        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
        close $handle{$_};
    }
    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
    if ( $err || $res{'exit_code'} ) {
        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
        return %res;
    }

    $entity->bodyhandle( new MIME::Body::File $tmp_fn );
    $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;

    return %res;
}

sub _SignEncryptAttachmentInline {
    my %args = (
        Entity => undef,

        Sign => 1,
        Signer => undef,
        Passphrase => undef,

        Encrypt => 1,
        Recipients => undef,

        @_
    );
    return unless $args{'Sign'} || $args{'Encrypt'};

    my $gnupg = new GnuPG::Interface;
    my %opt = RT->Config->Get('GnuPGOptions');

    # handling passphrase in GnupGOptions
    $args{'Passphrase'} = delete $opt{'passphrase'}
        if !defined($args{'Passphrase'});

    $opt{'digest-algo'} ||= 'SHA1';
    $opt{'default_key'} = $args{'Signer'}
        if $args{'Sign'} && $args{'Signer'};
    $gnupg->options->hash_init(
        _PrepareGnuPGOptions( %opt ),
        armor => 1,
        meta_interactive => 0,
    );

    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
    }

    my $entity = $args{'Entity'};
    if ( $args{'Encrypt'} ) {
        $gnupg->options->push_recipients( $_ ) foreach
            map UseKeyForEncryption($_) || $_,
            @{ $args{'Recipients'} || [] };
    }

    my %res;

    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
    binmode $tmp_fh, ':raw';

    my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
    my %handle = %$handle_list;
    $handles->options( 'stdout'  )->{'direct'} = 1;
    $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};

    eval {
        local $SIG{'CHLD'} = 'DEFAULT';
        my $method = $args{'Sign'} && $args{'Encrypt'}
            ? 'sign_and_encrypt'
            : ($args{'Sign'}? 'detach_sign': 'encrypt');
        my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
        {
            local $SIG{'PIPE'} = 'IGNORE';
            $entity->bodyhandle->print( $handle{'stdin'} );
            close $handle{'stdin'};
        }
        waitpid $pid, 0;
    };
    $res{'exit_code'} = $?;
    my $err = $@;

    foreach ( qw(stderr logger status) ) {
        $res{$_} = do { local $/; readline $handle{$_} };
        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
        close $handle{$_};
    }
    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
    if ( $err || $res{'exit_code'} ) {
        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
        return %res;
    }

    my $filename = $entity->head->recommended_filename || 'no_name';
    if ( $args{'Sign'} && !$args{'Encrypt'} ) {
        $entity->make_multipart;
        $entity->attach(
            Type     => 'application/octet-stream',
            Path     => $tmp_fn,
            Filename => "$filename.sig",
            Disposition => 'attachment',
        );
    } else {
        $entity->bodyhandle( new MIME::Body::File $tmp_fn );
        $entity->effective_type('application/octet-stream');
        $entity->head->mime_attr( $_ => "$filename.pgp" )
            foreach (qw(Content-Type.name Content-Disposition.filename));

    }
    $entity->{'__store_tmp_handle_to_avoid_early_cleanup'} = $tmp_fh;

    return %res;
}

sub SignEncryptContent {
    my %args = (
        Content => undef,

        Sign => 1,
        Signer => undef,
        Passphrase => undef,

        Encrypt => 1,
        Recipients => undef,

        @_
    );
    return unless $args{'Sign'} || $args{'Encrypt'};

    my $gnupg = new GnuPG::Interface;
    my %opt = RT->Config->Get('GnuPGOptions');

    # handling passphrase in GnupGOptions
    $args{'Passphrase'} = delete $opt{'passphrase'}
        if !defined($args{'Passphrase'});

    $opt{'digest-algo'} ||= 'SHA1';
    $opt{'default_key'} = $args{'Signer'}
        if $args{'Sign'} && $args{'Signer'};
    $gnupg->options->hash_init(
        _PrepareGnuPGOptions( %opt ),
        armor => 1,
        meta_interactive => 0,
    );

    if ( $args{'Sign'} && !defined $args{'Passphrase'} ) {
        $args{'Passphrase'} = GetPassphrase( Address => $args{'Signer'} );
    }

    if ( $args{'Encrypt'} ) {
        $gnupg->options->push_recipients( $_ ) foreach 
            map UseKeyForEncryption($_) || $_,
            @{ $args{'Recipients'} || [] };
    }

    my %res;

    my ($tmp_fh, $tmp_fn) = File::Temp::tempfile( UNLINK => 1 );
    binmode $tmp_fh, ':raw';

    my ($handles, $handle_list) = _make_gpg_handles(stdout => $tmp_fh);
    my %handle = %$handle_list;
    $handles->options( 'stdout'  )->{'direct'} = 1;
    $gnupg->passphrase( $args{'Passphrase'} ) if $args{'Sign'};

    eval {
        local $SIG{'CHLD'} = 'DEFAULT';
        my $method = $args{'Sign'} && $args{'Encrypt'}
            ? 'sign_and_encrypt'
            : ($args{'Sign'}? 'clearsign': 'encrypt');
        my $pid = safe_run_child { $gnupg->$method( handles => $handles ) };
        {
            local $SIG{'PIPE'} = 'IGNORE';
            $handle{'stdin'}->print( ${ $args{'Content'} } );
            close $handle{'stdin'};
        }
        waitpid $pid, 0;
    };
    $res{'exit_code'} = $?;
    my $err = $@;

    foreach ( qw(stderr logger status) ) {
        $res{$_} = do { local $/; readline $handle{$_} };
        delete $res{$_} unless $res{$_} && $res{$_} =~ /\S/s;
        close $handle{$_};
    }
    $RT::Logger->debug( $res{'status'} ) if $res{'status'};
    $RT::Logger->warning( $res{'stderr'} ) if $res{'stderr'};
    $RT::Logger->error( $res{'logger'} ) if $res{'logger'} && $?;
    if ( $err || $res{'exit_code'} ) {
        $res{'message'} = $err? $err : "gpg exitted with error code ". ($res{'exit_code'} >> 8);
        return %res;
    }

    ${ $args{'Content'} } = '';
    seek $tmp_fh, 0, 0;
    while (1) {
        my $status = read $tmp_fh, my $buf, 4*1024;
        unless ( defined $status ) {
            $RT::Logger->crit( "couldn't read message: $!" );
        } elsif ( !$status ) {
            last;
        }
        ${ $args{'Content'} } .= $buf;
    }

    return %res;
}

sub FindProtectedParts {
    my %args = ( Entity => undef, CheckBody => 1, @_ );
    my $entity = $args{'Entity'};

    # inline PGP block, only in singlepart
    unless ( $entity->is_multipart ) {
        my $io = $entity->open('r');
        unless ( $io ) {
            $RT::Logger->warning( "Entity of type ". $entity->effective_type ." has no body" );
            return ();
        }
        while ( defined($_ = $io->getline) ) {
            next unless /^-----BEGIN PGP (SIGNED )?MESSAGE-----/;
            my $type = $1? 'signed': 'encrypted';
            $RT::Logger->debug("Found $type inline part");
            return {
                Type    => $type,
                Format  => 'Inline',
                Data  => $entity,
            };
        }
        $io->close;
        return ();
    }

    # RFC3156, multipart/{signed,encrypted}
    if ( ( my $type = $entity->effective_type ) =~ /^multipart\/(?:encrypted|signed)$/ ) {
        unless ( $entity->parts == 2 ) {
            $RT::Logger->error( "Encrypted or signed entity must has two subparts. Skipped" );
            return ();
        }

        my $protocol = $entity->head->mime_attr( 'Content-Type.protocol' );
        unless ( $protocol ) {
            $RT::Logger->error( "Entity is '$type', but has no protocol defined. Skipped" );
            return ();
        }

        if ( $type eq 'multipart/encrypted' ) {
            unless ( $protocol eq 'application/pgp-encrypted' ) {
                $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-encrypted' is supported" );
                return ();
            }
            $RT::Logger->debug("Found encrypted according to RFC3156 part");
            return {
                Type    => 'encrypted',
                Format  => 'RFC3156',
                Top   => $entity,
                Data  => $entity->parts(1),
                Info    => $entity->parts(0),
            };
        } else {
            unless ( $protocol eq 'application/pgp-signature' ) {
                $RT::Logger->info( "Skipping protocol '$protocol', only 'application/pgp-signature' is supported" );
                return ();
            }
            $RT::Logger->debug("Found signed according to RFC3156 part");
            return {
                Type      => 'signed',
                Format    => 'RFC3156',
                Top     => $entity,
                Data    => $entity->parts(0),
                Signature => $entity->parts(1),
            };
        }
    }

    # attachments signed with signature in another part
    my @file_indices;
    foreach my $i ( 0 .. $entity->parts - 1 ) {
        my $part = $entity->parts($i);

        # we can not associate a signature within an attachment
        # without file names
        my $fname = $part->head->recommended_filename;
        next unless $fname;

        if ( $part->effective_type eq 'application/pgp-signature' ) {
            push @file_indices, $i;
        }
        elsif ( $fname =~ /\.sig$/i && $part->effective_type eq 'application/octet-stream' ) {
            push @file_indices, $i;
        }
    }

    my (@res, %skip);
    foreach my $i ( @file_indices ) {
        my $sig_part = $entity->parts($i);
        $skip{"$sig_part"}++;
        my $sig_name = $sig_part->head->recommended_filename;
        my ($file_name) = $sig_name =~ /^(.*?)(?:\.sig)?$/;

        my ($data_part_idx) =
            grep $file_name eq ($entity->parts($_)->head->recommended_filename||''),
            grep $sig_part  ne  $entity->parts($_),
                0 .. $entity->parts - 1;
        unless ( defined $data_part_idx ) {
            $RT::Logger->error("Found $sig_name attachment, but didn't find $file_name");
            next;
        }
        my $data_part_in = $entity->parts($data_part_idx);

        $skip{"$data_part_in"}++;
        $RT::Logger->debug("Found signature (in '$sig_name') of attachment '$file_name'");
        push @res, {
            Type      => 'signed',
            Format    => 'Attachment',
            Top       => $entity,
            Data      => $data_part_in,
            Signature => $sig_part,
        };
    }