File Coverage

blib/lib/Mail/GPG.pm

Criterion	Covered	Total	%
statement	595	647	91.9
branch	167	254	65.7
condition	54	87	62.0
subroutine	49	62	79.0
pod	16	43	37.2
total	881	1093	80.6

package Mail::GPG;

$VERSION = "1.0.13";

use strict;
use Carp;
use IO::Handle;
use Data::Dumper ();
use GnuPG::Interface;
use MIME::Parser;
use Mail::GPG::Result;
use Mail::Address;
use File::Temp;
use List::MoreUtils ();

use EV;
use AnyEvent;

#-- control debug output on i/o multiplexing
use constant IODEBUG => 0;

sub get_default_key_id          { shift->{default_key_id}               }
sub get_default_passphrase      { shift->{default_passphrase}           }
sub get_debug                   { shift->{debug}                        }
sub get_debug_dir               { shift->{debug_dir}                    }
sub get_gnupg_hash_init         { shift->{gnupg_hash_init}              }
sub get_digest                  { shift->{digest}                       }
sub get_default_key_encrypt     { shift->{default_key_encrypt}          }
sub get_gpg_call                { shift->{gpg_call}                     }
sub get_no_strict_7bit_encoding { shift->{no_strict_7bit_encoding}      }
sub get_use_long_key_ids        { shift->{use_long_key_ids}             }

sub set_default_key_id          { shift->{default_key_id}       = $_[1] }
sub set_default_passphrase      { shift->{default_passphrase}   = $_[1] }
sub set_debug                   { shift->{debug}                = $_[1] }
sub set_debug_dir               { shift->{debug_dir}            = $_[1] }
sub set_gnupg_hash_init         { shift->{gnupg_hash_init}      = $_[1] }
sub set_digest                  { shift->{digest}               = $_[1] }
sub set_default_key_encrypt     { shift->{default_key_encrypt}  = $_[1] }
sub set_gpg_call                { shift->{gpg_call}             = $_[1] }
sub set_no_strict_7bit_encoding { shift->{no_strict_7bit_encoding}=$_[1]}
sub set_use_long_key_ids        { shift->{use_long_key_ids}     = $_[1] }

sub new {
    my $class = shift;
    my %par   = @_;
    my  ($default_key_id, $default_passphrase, $debug, $debug_dir) =
    @par{'default_key_id','default_passphrase','debug','debug_dir'};
    my  ($gnupg_hash_init, $digest, $gpg_call, $default_key_encrypt) =
    @par{'gnupg_hash_init','digest','gpg_call','default_key_encrypt'};
    my  ($no_strict_7bit_encoding, $use_long_key_ids) =
    @par{'no_strict_7bit_encoding','use_long_key_ids'};

    $debug_dir               ||= $ENV{DUMPDIR} || File::Spec->tmpdir . '/mail-gpg-test';
    $gnupg_hash_init         ||= {};
    $digest                  ||= "RIPEMD160";
    $gpg_call                ||= "gpg";
    $no_strict_7bit_encoding ||= 0;
    $use_long_key_ids        ||= 0;

    my $self = bless {
        default_key_id          => $default_key_id,
        default_passphrase      => $default_passphrase,
        debug                   => $debug,
        debug_dir               => $debug_dir,
        gnupg_hash_init         => $gnupg_hash_init,
        digest                  => $digest,
        default_key_encrypt     => $default_key_encrypt,
        gpg_call                => $gpg_call,
        no_strict_7bit_encoding => $no_strict_7bit_encoding,
        use_long_key_ids        => $use_long_key_ids,
    }, $class;

    return $self;
}

sub new_gpg_interface {
    my $self = shift;
    my %par  = @_;
    my ($options, $passphrase) = @par{'options','passphrase'};

    my $gpg = GnuPG::Interface->new;

    $gpg->passphrase($passphrase) if defined $passphrase;
    $gpg->call( $self->get_gpg_call ) if $self->get_gpg_call ne '';

    my $gnupg_hash_init = $self->get_gnupg_hash_init;

    if ($options) {
        $gpg->options->hash_init( %{$options}, %{$gnupg_hash_init} );
    }
    else {
        $gpg->options->hash_init( %{$gnupg_hash_init} );
    }

    $gpg->options->push_extra_args( '--digest', $self->get_digest );
    $gpg->options->meta_interactive(0);

    return $gpg;
}

sub save_debug_file {
    my $self = shift;
    my %par  = @_;
    my ($name, $data, $data_fh ) = @par{'name','data','data_fh' };

    $name = $self->get_debug_dir . "/mgpg-" . $name;

    open( DBG, ">$name" ) or die "can't write $name";
    if ($data_fh) {
        seek $data_fh, 0, 0;
        print DBG $_ while <$data_fh>;
    }
    elsif ( ref $data ) {
        print DBG $$data;
    }
    else {
        print DBG $data;
    }
    close DBG;

    1;
}

sub check_7bit_encoding_of_all_parts {
    my $self     = shift;
    my %par      = @_;
    my ($entity) = $par{'entity'};

    #-- skip if no strict encoding check should be applied
    return 1 if $self->get_no_strict_7bit_encoding;

    #-- first the primary entity
    my $encoding = $entity->head->get("content-transfer-encoding");
    die "Content transfer encoding '$encoding' is not 7bit safe"
        unless not defined $encoding
        or $encoding =~ /^(quoted-printable|base64|7bit)\s*$/i;

    #-- now all parts
    return 1 if not $entity->parts;

    #-- recursively
    my $parts = $entity->parts;
    for ( my $i = 0; $i < $parts; ++$i ) {
        $self->check_7bit_encoding_of_all_parts( entity => $entity->parts($i),
        );
    }

    return 1;
}

sub check_encryption {
    my $self = shift;
    my %par  = @_;
    my  ($entity, $encrypted_text_sref) =
    @par{'entity','encrypted_text_sref'};

    my $is_armor;
    if ( $entity->effective_type =~ m!multipart/encrypted!i ) {

        #-- is this a valid RFC 3156 multipart/encrypted entity?
        die "Entity must have two parts"
            if $entity->parts != 2;
        die "Entity is not OpenPGP encrypted"
            unless $entity->parts(0)->effective_type
            =~ m!application/pgp-encrypted!i;
        $$encrypted_text_sref = $entity->parts(1)->body_as_string;

    }
    elsif ( $entity->bodyhandle ) {

        #-- probably an ASCII armor encrypted entity
        #-- (we need the *decoded* data here - hopefully the
        #--  MIME::Parser had decode_body(1) set).
        $$encrypted_text_sref = $entity->bodyhandle->as_string;
        die "Entity is not OpenPGP encrypted"
            unless $$encrypted_text_sref =~ /^-----BEGIN PGP MESSAGE-----/m;
        $is_armor = 1;
    }
    else {
        die "Entity is not multipart/encrypted and has no body";
    }

    return $is_armor;
}

sub perform_multiplexed_gpg_io {
    my $self = shift;
    my %par  = @_;
    my  ($data_fh, $data_canonify, $stdin_fh, $stderr_fh) =
    @par{'data_fh','data_canonify','stdin_fh','stderr_fh'};
    my  ($stdout_fh, $status_fh, $stderr_sref, $stdout_sref) =
    @par{'stdout_fh','status_fh','stderr_sref','stdout_sref'};
    my  ($status_sref) =
    $par{'status_sref'};

    #-- Debug stuff
    IODEBUG && print "anyevent\n";
    my $nl = "\n";
    my $r = 0;
    my $w = 0;

    #-- I/O buffer size
    my $bsize = 8192;

    #-- perl < 5.6 compatibility: seek() and read() work
    #-- on native GLOB filehandle only, so dertmine type
    #-- of filehandle here
    my $data_fh_glob = ref $data_fh eq 'GLOB';

    #-- rewind the data filehandle
    if ($data_fh_glob) {
        seek $data_fh, 0, 0;
    }
    else {
        $data_fh->seek( 0, 0 );
    }

    #-- Watchers for various handles
    my ($data_watcher, $stdin_watcher, $stderr_watcher,
        $stdout_watcher, $status_watcher);

    #-- Buffer for data reading and stdin writing
    my $data_buffer = "";

    #-- Mainloop condvar
    my $done = AnyEvent->condvar;

    IODEBUG && print "dw $nl";

    #-- watch for incoming data
    $data_watcher = AnyEvent->io (
        fh => $data_fh,
        poll => "r",
        cb => sub {
            IODEBUG && print "d";

            my $rc = sysread($data_fh, my $buffer, $bsize);

            IODEBUG && ( $r += $rc );
            IODEBUG && print "($rc->$r) $nl";

            #-- on eof stop watcher and close filehandle
            if ( !$rc ) {
                IODEBUG && print "de $nl";
                $data_watcher = undef;
                close $data_fh;
                return;
            }

            if ( $data_canonify ) {
                #-- canonify it if requested
                $buffer =~ s/\x0A/\x0D\x0A/g;
                $buffer =~ s/\x0D\x0D\x0A/\x0D\x0A/g;
            }

            $data_buffer .= $buffer;

            #-- start stdin watcher if there is no watcher yet
            if ( not $stdin_watcher ) {
                IODEBUG && print "iw $nl";

                $stdin_watcher = AnyEvent->io (
                    fh   => $stdin_fh,
                    poll => 'w',
                    cb   => sub {
                        IODEBUG && print "i";

                        my $written = syswrite($stdin_fh, $data_buffer, $bsize);

                        $w += $written;
                        IODEBUG && print "($written->$w) $nl";

                        #-- if we couldn't write anything, stop watcher
                        if ( not defined $written ) {
                            $stdin_watcher = undef;
                            IODEBUG && print "ie $nl";
                            return;
                        }

                        #-- cut off i/o buffer
                        $data_buffer = substr($data_buffer, $written) if $written;

                        #-- on empty buffer there is no need to watch
                        #-- for writing into the stdin handle
                        $stdin_watcher = undef if $data_buffer eq "";

                        IODEBUG && print "is $nl" unless $stdin_watcher;

                        #-- if read and write watchers are off, we
                        #-- are done with feeding and close stdin
                        #-- filehandle to signal that to gpg
                        if ( not $stdin_watcher and not $data_watcher ) {
                            IODEBUG && print "ic $nl";
                            close $stdin_fh;
                        }
                    },
                );
            }
        }
    );

    IODEBUG && print "ew $nl";

    #-- grab stderr
    $stderr_watcher = AnyEvent->io (
        fh   => $stderr_fh,
        poll => 'r',
        cb   => sub {
            IODEBUG && print "e";

            my $rc = sysread(
                $stderr_fh,
                ${$stderr_sref},
                $bsize,
                length(${$stderr_sref})
            );

            IODEBUG && print "($rc) $nl";

            $stderr_watcher = undef unless $rc;
        },
    );

    #-- grab stdout and stop loop on eof
    $stdout_watcher = AnyEvent->io (
        fh   => $stdout_fh,
        poll => 'r',
        cb   => sub {
            IODEBUG && print "o";

            my $rc = sysread(
                $stdout_fh,
                ${$stdout_sref},
                $bsize,
                length(${$stdout_sref})
            );

            IODEBUG && print "($rc) $nl";

            #-- if gpg stdout is eof we're done
            if ( not $rc ) {
                $stdout_watcher = undef;
                $done->send;
            }
        },
    );

    #-- grab status if requested
    if ( $status_fh ) {
        IODEBUG && print "sw $nl";

        $status_watcher = AnyEvent->io (
            fh   => $status_fh,
            poll => 'r',
            cb   => sub {
                IODEBUG && print "s";

                my $rc = sysread(
                    $status_fh,
                    ${$status_sref},
                    $bsize,
                    length(${$status_sref})
                );

                IODEBUG && print "($rc) $nl";

                $status_watcher = undef unless $rc;
            },
        );
    }

    IODEBUG && print "loop $nl";

    #-- enter mainloop until eof of gpg stdout
    $done->recv;

    1;
}

#-- Addresses bug:     https://rt.cpan.org/Public/Bug/Display.html?id=103828  (here)
#-- Possibly also:     https://rt.cpan.org/Public/Bug/Display.html?id=81082   (here)
#                  and https://rt.cpan.org/Public/Bug/Display.html?id=80500   (in Makefile.PL)

sub _parse_key_list {
  my $self = shift;
  my ($output_stdout, %par) = @_;
  my  ($coerce, $debug, $verbose) =
  @par{'coerce','debug','verbose'};

  #-- grab key ID's and emails from output (backward compatible to gpg 1.x)
  #
  #  Example:
  #  search request: "--list-keys --with-colons 6C187D0F196ED9E3"
  #  format        : see /usr/share/doc/packages/gpg2/DETAILS
  #
  #--OLD sample: gpg (GnuPG) 1.4.11
  #   tru:t:1:1431088683:0:3:1:5
  #   pub:-:1024:17:062F00DAE20F5035:2004-02-10:::-:Jörn Reder Mail\x3a\x3aGPG Test Key ::scaESCA:
  #   sub:-:1024:16:6C187D0F196ED9E3:2004-02-10::::::e:
  #
  #   expected output: (062F00DAE20F5035, 'Jörn Reder Mail::GPG Test Key ')
  #
  #--NEW sample: gpg (GnuPG) 2.0.22
  #  tru:t:1:1429473192:0:3:1:5
  #  pub:-:1024:17:062F00DAE20F5035:1076425915:::-:::scaESCA:
  #  uid:-::::1076425915::588869ADE077B8FB05788A99565AEED15AED8231::Jörn Reder Mail\x3a\x3aGPG Test Key :
  #  sub:-:1024:16:6C187D0F196ED9E3:1076425917::::::e:
  #
  #  expected output: (062F00DAE20F5035, 'Jörn Reder Mail::GPG Test Key ',
  #                    6C187D0F196ED9E3, 'Jörn Reder Mail::GPG Test Key ')
  #
  #  PERLBOTIX<ätt>cpan.org / May, 2015

  my @result;

  #-- needed for utf8 handling
  require Encode if $] >= 5.008;

  $output_stdout .= "\nFLUSH\n"; #-- we add this token to trigger flushing of the last record

  #-- these values are valid per "paragraph" (from pub: to pub:)
  my @ids;                       #-- list of potential IDs (pub, sub)
  my @emails;                    #-- list of potential email adresses (uid)
  my $gpg2_mode = 0;             #-- auto-detect OLD/NEW format: true if NEW (gpg2) format

  #-- parse output line by line
  #--  OLD-format (gpg 1.x): simulate old behaviour
  #--  NEW-format (gpg 2.x): create all combinations of valid key-IDs and emails; return (pub) key-ID first,
  #    so the result stays backward compatible

  while (  $output_stdout =~ m!^((\w+):?.*?)[\r\n]+!mg  ) {

    my ($line, $tag) = ($1, $2);
    my @fields       = split /:/, $line, -1;

    warn("\nFields: ", join(", ", map { "($_)" } @fields)) if $debug;

    #-- skip entries that are expired or otherwise invalid
    if (     ( $fields[1]  and  $fields[1]  =~ /^([eird])$/ )
          or ( $fields[11] and  $fields[11] =~ /([D])/      )
       ) { #-- cannot use key (invalid/expired/revoked/[dD]isabled)
      carp "Skipping key invalidated by '$1'-flag: ($line)" if $verbose or $debug;
      next;
    }

    #-- a further 'pub' marks a new paragraph or the end of the current paragraph
    #-- a 'FLUSH' marks the end of the the whole text
    if ( $tag eq 'pub'  or  $tag eq 'FLUSH' ) {

      #-- flush intermediate or final results
      if ( @ids  and  @emails ) {

        @emails = List::MoreUtils::uniq @emails; #-- uniq preserves order

        for ( @emails ) {
          #-- $key_mail is quoted C-style (e.g. \x3a is a colon)
          s/\\x(..)/chr(hex($1))/eg;

          #-- tell Perl that this variable is utf8 encoded
          #-- (if Perl version is 5.8.0 or greater)
          eval { $_ = Encode::decode("utf-8", $_, Encode::FB_CROAK) }
            if $] >= 5.008;
        }

        @ids = List::MoreUtils::uniq @ids;
        if ( !$self->get_use_long_key_ids ) {
          $_ = substr($_,-8)  for ( @ids );
        }

        #-- finally, fill result array with all combinations of key-ids and emails (legacy), found in the previous paragraph
        for my $id ( @ids ) {

          if ( $coerce ) {
            push @result, $id, [ @emails ]; #-- "modern" interface
          }
          else {
            for my $m ( @emails ) {
              push @result, ($id, $m); #-- legacy
            }
          }
        }

      } elsif ( @ids  or  @emails ) {
        carp "Incomplete key data - key is probably invalid?  (@ids) x (@emails)!";
      }

      @ids    = ();
      @emails = ();
      last if defined $fields[1] and $fields[1] eq 'FLUSH';


      #-- parse 'new' format (pub:..;  next: uid:..., uid:..., sub:... )
      if ( not defined $fields[9] or $fields[9] =~ /^\s*$/ ) {
        $gpg2_mode = 1;
        push @ids, $fields[4];
      }
      #-- parse 'old' format (pub:)
      elsif ( $fields[9] =~ /<[^>]+>/ ) {
        $gpg2_mode = 0;
        push @ids, $fields[4];
        push @emails, $fields[9];
      }
      else {
        die "Cannot parse: ($line)";
      }

    } #-- 'pub' & 'FLUSH' handled obove

    #-- handle 'sub' entries  /  extract key-id
    elsif ( $tag eq 'sub'  and  $gpg2_mode  and   $fields[4]) {
      push @ids, $fields[4];
    }

    #-- handle 'uid' entries  /  extract email
    elsif ( $tag eq 'uid'  and  $gpg2_mode  and   $fields[9] =~ /<[^>]+>/ ) {
      push @emails, $fields[9];
    }

    #-- ignore anything else
    else {
      warn "Ignoring line [gpg2_mode=$gpg2_mode] --  '$line'"  if $debug;
    }

  } #-- loop over output_stdout

  warn  Data::Dumper->Dump( [ \@result], [qw(RESULT_AS_REF)] ) if $debug;

  return @result;
}


sub query_keyring {
    my $self     = shift;
    my %par      = @_;
    my ($search, $debug) = @par{'search','debug'};

    #-- ignore any PIPE signals, in case of gpg exited
    #-- early before we fed our data into it.
    local $SIG{PIPE} = 'IGNORE';

    #-- we parse gpg's output and rely on english
    local $ENV{LC_ALL} = "C";

    #-- get a GnuPG::Interface
    my $gpg = $self->new_gpg_interface;

    #-- initialize Handles
    my $stdout  = IO::Handle->new;
    my $stderr  = IO::Handle->new;
    my $handles = GnuPG::Handles->new(
        stdout => $stdout,
        stderr => $stderr,
    );

    #-- execute gpg --list-public-keys
    my $pid = $gpg->wrap_call(
        handles      => $handles,
        commands     => [ "--list-keys", "--with-colons" ],
        command_args => [$search],
    );

    #-- fetch gpg's STDERR
    my $output_stderr;
    $output_stderr .= $_ while <$stderr>;
    close $stderr;

    #-- fetch gpg's STDOUT
    my $output_stdout;
    $output_stdout .= $_ while <$stdout>;
    close $stdout;

    #-- wait on gpg exit
    waitpid $pid, 0;

    if ( $debug ) {
      warn "LIST_KEYS(CMD)    -- --list-keys --with-colons $search\n";
      warn "LIST_KEYS(STDERR) -- search for ($search):\n$output_stderr\n";
      warn "LIST_KEYS(STDOUT) -- search for ($search):\n$output_stdout\n";
    }

    my @result = $self->_parse_key_list( $output_stdout , %par);

    #-- return result: undef if nothing found, first key-id if
    #-- a scalar is requested, all entries suitable for a hash
    #-- slurp if an array is requested

    # Compatibility note: The first id is always the id of the 'pub' entry, even for a subkey-hit.
    #                     gpgv2: The result should not be used to initialise a hash, since some emails will be clobbered.
    #                     We need another interface here. Curently Mail::GPG uses only the first entry...
    return            if not @result;
    return $result[0] if not wantarray;
    return @result;
}

sub build_rfc3156_multipart_entity {
    my $self = shift;
    my %par  = @_;
    my ($entity, $method) = @par{'entity','method'};

    #-- check, if content-transfer-encoding follows the
    #-- RFC 3156 requirement of being 7bit safe
    $self->check_7bit_encoding_of_all_parts( entity => $entity );

    #-- build entity for signed/encrypted version; first make
    #-- a copy of the given entity (deep copy of body
    #-- files isn't necessary, body data isn't modified
    #-- here).
    my $rfc_entity = $entity->dup;

    #-- determine the part, which is to be signed/encrypted
    my ( $work_part, $multipart );
    if ( $rfc_entity->parts > 1 ) {

        #-- the entity is multipart, so we need to build
        #-- a new version of it with all parts, but without
        #-- the rfc822 mail headers of the original entity
        #-- (according RFC 3156 the signed/encrypted parts
        #--  need MIME content headers only)
        $work_part = MIME::Entity->build( Type => "multipart/mixed" );
        $work_part->add_part($_) for $rfc_entity->parts;
        $rfc_entity->parts( [] );
        $multipart = 1;
    }
    else {

        #-- the entity is single part, so just make it
        #-- multipart and take the first (and only) part
        $rfc_entity->make_multipart;
        $work_part = $rfc_entity->parts(0);
        $multipart = 0;
    }

    #-- configure headers and add first part to the entity
    if ( $method eq 'sign' ) {

        #-- set correct MIME OpenPGP header für multipart/signed
        $rfc_entity->head->mime_attr( "Content-Type", "multipart/signed" );
        $rfc_entity->head->mime_attr( "Content-Type.protocol",
            "application/pgp-signature" );
        $rfc_entity->head->mime_attr( "Content-Type.micalg",
            "pgp-" . lc( $self->get_digest ) );

        #-- add content part as first part
        $rfc_entity->add_part($work_part) if $multipart;
    }
    else {

        #-- set correct MIME OpenPGP header für multipart/encrypted
        $rfc_entity->head->mime_attr( "Content-Type", "multipart/encrypted" );
        $rfc_entity->head->mime_attr( "Content-Type.protocol",
            "application/pgp-encrypted" );

        #-- remove all parts
        $rfc_entity->parts( [] );

        #-- and add OpenPGP version part as first part
        $rfc_entity->attach(
            Type        => "application/pgp-encrypted",
            Disposition => "inline",
            Data        => ["Version: 1\n"],
            Encoding    => "7bit",
        );
    }

    #-- return the newly created entitiy and the part to work on
    return ( $rfc_entity, $work_part );
}

sub mime_sign {
    my $self = shift;
    my %par  = @_;
    my  ($key_id, $passphrase, $entity) =
    @par{'key_id','passphrase','entity'};

    #-- ignore any PIPE signals, in case of gpg exited
    #-- early before we fed our data into it.
    local $SIG{PIPE} = 'IGNORE';

    #-- we parse gpg's output and rely on english
    local $ENV{LC_ALL} = "C";

    #-- get default key ID and passphrase, if not given
    $key_id     = $self->get_default_key_id     if not defined $key_id;
    $passphrase = $self->get_default_passphrase if not defined $passphrase;

    #-- check parameters
    die "No key_id set"     if $key_id     eq '';
    die "No passphrase set" if not defined $passphrase;

    #-- build entity for signed version
    #-- (only the 2nd part with the signature data
    #--  needs to be added later)
    my ( $signed_entity, $sign_part ) = $self->build_rfc3156_multipart_entity(
        entity => $entity,
        method => "sign",
    );

    #-- get a GnuPG::Interface
    my $gpg = $self->new_gpg_interface(
        options => {
            armor       => 1,
            default_key => $key_id,
        },
        passphrase => $passphrase,
    );

    #-- initialize handles
    my $stdin   = IO::Handle->new;
    my $stdout  = IO::Handle->new;
    my $stderr  = IO::Handle->new;
    my $handles = GnuPG::Handles->new(
        stdin  => $stdin,
        stdout => $stdout,
        stderr => $stderr,
    );

    #-- execute gpg for signing
    my $pid = $gpg->detach_sign( handles => $handles );

    #-- put encoded entity data into temporary file
    #-- (faster than in-memory operation)
    my ( $data_fh, $data_file ) = File::Temp::tempfile();
    unlink $data_file;
    $sign_part->print($data_fh);

    #-- perform I/O (multiplexed to prevent blocking)
    my ( $output_stdout, $output_stderr ) = ("", "");
    $self->perform_multiplexed_gpg_io(
        data_fh       => $data_fh,
        data_canonify => 1,
        stdin_fh      => $stdin,
        stderr_fh     => $stderr,
        stdout_fh     => $stdout,
        stderr_sref   => \$output_stderr,
        stdout_sref   => \$output_stdout,
    );

    #-- close reader filehandles (stdin was closed
    #-- by perform_multiplexed_gpg_io())
    close $stdout;
    close $stderr;

    #-- fetch zombie
    waitpid $pid, 0;
    die $output_stderr if $?;

    #-- attach OpenPGP signature as second part
    $signed_entity->attach(
        Type        => "application/pgp-signature",
        Disposition => "inline",
        Data        => [$output_stdout],
        Encoding    => "7bit",
    );

    #-- debugging: create file with signed data
    if ( $self->get_debug ) {
        $self->save_debug_file(
            name    => "mime-sign-data.txt",
            data_fh => $data_fh,
        );
        $self->save_debug_file(
            name => "mime-sign-entity.txt",
            data => \$signed_entity->as_string,
        );
    }

    #-- close temporary data filehandle
    close $data_fh;

    #-- return signed entity
    return $signed_entity;
}

sub mime_encrypt {
    my $self = shift;
    my %par  = @_;
    my ($entity, $recipients) = @par{'entity','recipients'};

    #-- call mime_sign_encrypt() with no_sign option
    return $self->mime_sign_encrypt(
        entity     => $entity,
        recipients => $recipients,
        _no_sign   => 1,
    );
}

sub mime_sign_encrypt {
    my $self = shift;
    my %par = @_;
    my  ($key_id, $passphrase, $entity, $recipients, $_no_sign) =
    @par{'key_id','passphrase','entity','recipients','_no_sign'};

    #-- ignore any PIPE signals, in case of gpg exited
    #-- early before we fed our data into it.
    local $SIG{PIPE} = 'IGNORE';

    #-- we parse gpg's output and rely on english
    local $ENV{LC_ALL} = "C";

    #-- get default key ID and passphrase, if not given
    $key_id     = $self->get_default_key_id     if not defined $key_id;
    $passphrase = $self->get_default_passphrase if not defined $passphrase;

    #-- check parameters
    die "No key_id set"     if not $_no_sign and $key_id     eq '';
    die "No passphrase set" if not $_no_sign and not defined $passphrase;

    #-- build entity for encrypted version
    #-- (only the 2nd part with the encrypted data
    #--  needs to be added later)
    my ( $encrypted_entity, $encrypt_part )
        = $self->build_rfc3156_multipart_entity(
        entity => $entity,
        method => "encrypt",
        );

    #-- get a GnuPG::Interface
    my $gpg = $self->new_gpg_interface(
        options => {
            armor       => 1,
            default_key => $key_id,
        },
        passphrase => $passphrase,
    );

    #-- add recipients, but first extract the mail-adress
    #-- part, otherwise gpg couldn't find keys for adresses
    #-- with quoted printable encodings in the name part-
    $recipients = $self->extract_mail_address( recipients => $recipients, );
    $gpg->options->push_recipients($_) for @{$recipients};

    #-- add default key to recipients if requested
    $gpg->options->push_recipients( $self->get_default_key_id )
        if $self->get_default_key_encrypt
        and $self->get_default_key_id;

    #-- initialize handles
    my $stdin   = IO::Handle->new;
    my $stdout  = IO::Handle->new;
    my $stderr  = IO::Handle->new;
    my $handles = GnuPG::Handles->new(
        stdin  => $stdin,
        stdout => $stdout,
        stderr => $stderr,
    );

    #-- execute gpg for encryption
    my $pid;
    if ($_no_sign) {
        $pid = $gpg->encrypt( handles => $handles );
    }
    else {
        $pid = $gpg->sign_and_encrypt( handles => $handles );
    }

    #-- put encoded entity data into temporary file
    #-- (faster than in-memory operation)
    my ( $data_fh, $data_file ) = File::Temp::tempfile();
    unlink $data_file;
    $encrypt_part->print($data_fh);

    #-- perform I/O (multiplexed to prevent blocking)
    my ( $output_stdout, $output_stderr ) = ("", "");
    $self->perform_multiplexed_gpg_io(
        data_fh       => $data_fh,
        data_canonify => 1,
        stdin_fh      => $stdin,
        stderr_fh     => $stderr,
        stdout_fh     => $stdout,
        stderr_sref   => \$output_stderr,
        stdout_sref   => \$output_stdout,
    );

    #-- close reader filehandles (stdin was closed
    #-- by perform_multiplexed_gpg_io())
    close $stdout;
    close $stderr;

    #-- fetch zombie
    waitpid $pid, 0;
    die $output_stderr if $?;

    #-- attach second part with the encrytped text
    $encrypted_entity->attach(
        Type        => "application/octet-stream",
        Disposition => "inline",
        Data        => [$output_stdout],
        Encoding    => "7bit",
    );

    #-- debugging: create file with encrypted data
    if ( $self->get_debug ) {
        $self->save_debug_file(
            name    => "mime-enc-data.txt",
            data_fh => $data_fh,
        );
        $self->save_debug_file(
            name => "mime-enc-entity.txt",
            data => \$encrypted_entity->as_string,
        );
    }

    #-- close temporary data filehandle
    close $data_fh;

    #-- return encrytped entity
    return $encrypted_entity;
}

sub armor_sign {
    my $self = shift;
    my %par  = @_;
    my  ($key_id, $passphrase, $entity) =
    @par{'key_id','passphrase','entity'};

    #-- ignore any PIPE signals, in case of gpg exited
    #-- early before we fed our data into it.
    local $SIG{PIPE} = 'IGNORE';

    #-- we parse gpg's output and rely on english
    local $ENV{LC_ALL} = "C";

    #-- get default key ID and passphrase, if not given
    $key_id     = $self->get_default_key_id     if not defined $key_id;
    $passphrase = $self->get_default_passphrase if not defined $passphrase;

    #-- check parameters
    die "No key_id set"     if $key_id     eq '';
    die "No passphrase set" if not defined $passphrase;
    die "Entity has no body" if not $entity->bodyhandle;

    #-- check, if body content-transfer-encoding is 7bit safe
    if ( not $self->get_no_strict_7bit_encoding ) {
        my $encoding = $entity->head->get("content-transfer-encoding");
        die "Content transfer encoding '$encoding' is not 7bit safe"
            unless $encoding =~ /^(quoted-printable|base64|7bit)\s*$/i;
    }

    #-- get a GnuPG::Interface, with ASCII armor enabled
    my $gpg = $self->new_gpg_interface(
        options => {
            armor       => 1,
            default_key => $key_id,
        },
        passphrase => $passphrase,
    );

    #-- initialize handles
    my $stdin   = IO::Handle->new;
    my $stdout  = IO::Handle->new;
    my $stderr  = IO::Handle->new;
    my $handles = GnuPG::Handles->new(
        stdin  => $stdin,
        stdout => $stdout,
        stderr => $stderr,
    );

    #-- execute gpg for signing
    my $pid = $gpg->clearsign( handles => $handles );

    #-- put encoded entity data into temporary file
    #-- (faster than in-memory operation)
    my ( $data_fh, $data_file ) = File::Temp::tempfile();
    unlink $data_file;
    $entity->print($data_fh);

    #-- perform I/O (multiplexed to prevent blocking)
    my ( $output_stdout, $output_stderr ) = ("", "");
    $self->perform_multiplexed_gpg_io(
        data_fh       => $data_fh,
        data_canonify => 1,
        stdin_fh      => $stdin,
        stderr_fh     => $stderr,
        stdout_fh     => $stdout,
        stderr_sref   => \$output_stderr,
        stdout_sref   => \$output_stdout,
    );

    #-- close reader filehandles (stdin was closed
    #-- by perform_multiplexed_gpg_io())
    close $stdout;
    close $stderr;

    #-- fetch zombie
    waitpid $pid, 0;
    die $output_stderr if $?;

    #-- build entity for encrypted version
    my $signed_entity = MIME::Entity->build( Data => [$output_stdout], );

    #-- copy all header fields from original entity
    foreach my $tag ( $entity->head->tags ) {
        my @values = $entity->head->get($tag);
        for ( my $i = 0; $i < @values; ++$i ) {
            $signed_entity->head->replace( $tag, $values[$i], $i );
        }
    }

    #-- debugging: create file with signed data
    if ( $self->get_debug ) {
        $self->save_debug_file(
            name => "armor-sign-data.txt",
            data => \$entity->bodyhandle->as_string,
        );
        $self->save_debug_file(
            name => "armor-sign-entity.txt",
            data => \$signed_entity->as_string,
        );
    }

    #-- return the signed entity
    return $signed_entity;
}

sub armor_encrypt {
    my $self = shift;
    my %par  = @_;
    my ($entity, $recipients) = @par{'entity','recipients'};

    #-- call armor_sign_encrypt() with no_sign option
    return $self->armor_sign_encrypt(
        entity     => $entity,
        recipients => $recipients,
        _no_sign   => 1,
    );
}

sub armor_sign_encrypt {
    my $self = shift;
    my %par = @_;
    my  ($key_id, $passphrase, $entity, $recipients, $_no_sign) =
    @par{'key_id','passphrase','entity','recipients','_no_sign'};

    #-- ignore any PIPE signals, in case of gpg exited
    #-- early before we fed our data into it.
    local $SIG{PIPE} = 'IGNORE';

    #-- we parse gpg's output and rely on english
    local $ENV{LC_ALL} = "C";

    #-- get default key ID and passphrase, if not given
    if ( not $_no_sign ) {
        $key_id = $self->get_default_key_id if not defined $key_id;
        $passphrase = $self->get_default_passphrase
            if not defined $passphrase;

        #-- check parameters
        die "No key_id set"     if $key_id     eq '';
        die "No passphrase set" if not defined $passphrase;
    }

    #-- check parameters
    die "Entity has no body" if not $entity->bodyhandle;

    #-- get a GnuPG::Interface, with ASCII armor enabled
    my $gpg = $self->new_gpg_interface(
        options => {
            armor       => 1,
            default_key => $key_id,
        },
        passphrase => $passphrase,
    );

    #-- add recipients, but first extract the mail-adress
    #-- part, otherwise gpg couldn't find keys for adresses
    #-- with quoted printable encodings in the name part-
    $recipients = $self->extract_mail_address( recipients => $recipients, );
    $gpg->options->push_recipients($_) for @{$recipients};

    #-- add default key to recipients if requested
    $gpg->options->push_recipients( $self->get_default_key_id )
        if $self->get_default_key_encrypt
        and $self->get_default_key_id;

    #-- initialize handles
    my $stdin   = IO::Handle->new;
    my $stdout  = IO::Handle->new;
    my $stderr  = IO::Handle->new;
    my $handles = GnuPG::Handles->new(
        stdin  => $stdin,
        stdout => $stdout,
        stderr => $stderr,
    );

    #-- execute gpg for encryption
    my $pid;
    if ($_no_sign) {
        $pid = $gpg->encrypt( handles => $handles );
    }
    else {
        $pid = $gpg->sign_and_encrypt( handles => $handles );
    }

    #-- put encoded entity data into temporary file
    #-- (faster than in-memory operation)
    my ( $data_fh, $data_file ) = File::Temp::tempfile();
    unlink $data_file;
    $entity->print($data_fh);

    #-- perform I/O (multiplexed to prevent blocking)
    my ( $output_stdout, $output_stderr ) = ("", "");
    $self->perform_multiplexed_gpg_io(
        data_fh       => $data_fh,
        data_canonify => 0,
        stdin_fh      => $stdin,
        stderr_fh     => $stderr,
        stdout_fh     => $stdout,
        stderr_sref   => \$output_stderr,
        stdout_sref   => \$output_stdout,
    );

    #-- close reader filehandles (stdin was closed
    #-- by perform_multiplexed_gpg_io())
    close $stdout;
    close $stderr;

    #-- fetch zombie
    waitpid $pid, 0;
    die $output_stderr if $?;

    #-- build entity for encrypted version
    my $encrypted_entity = MIME::Entity->build(
        Type     => "text/plain",
        Encoding => "7bit",
        Data     => [$output_stdout],
    );

    #-- copy header fields from original entity
    foreach my $tag ( $entity->head->tags ) {
        next if $tag =~ /^content/i;
        my @values = $entity->head->get($tag);
        for ( my $i = 0; $i < @values; ++$i ) {
            $encrypted_entity->head->replace( $tag, $values[$i], $i );
        }
    }

    #-- debugging: create file with signed data
    if ( $self->get_debug ) {
        $self->save_debug_file(
            name => "armor-enc-data.txt",
            data => \$entity->bodyhandle->as_string,
        );
        $self->save_debug_file(
            name => "armor-enc-entity.txt",
            data => \$encrypted_entity->as_string,
        );
    }

    #-- return the signed entity
    return $encrypted_entity;
}

sub decrypt {
    my $self = shift;
    my %par  = @_;
    my ($entity, $passphrase) = @par{'entity','passphrase'};

    #-- ignore any PIPE signals, in case of gpg exited
    #-- early before we fed our data into it.
    local $SIG{PIPE} = 'IGNORE';

    #-- we parse gpg's output and rely on english
    local $ENV{LC_ALL} = "C";

    #-- get default passphrase, if not given
    $passphrase = $self->get_default_passphrase if not defined $passphrase;

    #-- check if the entity is encrypted at all
    #-- (dies if not)
    my $encrypted_text;
    my $is_armor = $self->check_encryption(
        entity              => $entity,
        encrypted_text_sref => \$encrypted_text,
    );

    #-- get a GnuPG::Interface
    my $gpg = $self->new_gpg_interface( passphrase => $passphrase, );

    #-- initialize handles
    my $stdin  = IO::Handle->new;
    my $stdout = IO::Handle->new;
    my $stderr = IO::Handle->new;
    my $status = IO::Handle->new;

    my $handles = GnuPG::Handles->new(
        stdin  => $stdin,
        stdout => $stdout,
        stderr => $stderr,
        status => $status,
    );

    #-- start gpg for decryption
    my $pid = $gpg->decrypt( handles => $handles );

    #-- put encoded entity data into temporary file
    #-- (faster than in-memory operation)
    my ( $data_fh, $data_file ) = File::Temp::tempfile();
    unlink $data_file;
    print $data_fh $encrypted_text;

    #-- perform I/O (multiplexed to prevent blocking)
    my ( $output_stdout, $output_stderr, $output_status ) = ( "", "", "" );

    $self->perform_multiplexed_gpg_io(
        data_fh       => $data_fh,
        data_canonify => 1,
        stdin_fh      => $stdin,
        stderr_fh     => $stderr,
        stdout_fh     => $stdout,
        status_fh     => $status,
        stderr_sref   => \$output_stderr,
        stdout_sref   => \$output_stdout,
        status_sref   => \$output_status,
    );

    #-- close reader filehandles (stdin was closed
    #-- by perform_multiplexed_gpg_io())
    close $stdout;
    close $stderr;

    #-- fetch zombie
    waitpid $pid, 0;
    my $rc = $? >> 8;

    #-- don't die here for return values != 0, because
    #-- this also happens for encrypted+signed mails,
    #-- where the public key is missing for verification
    #-- and that's not intended here.

    #-- parse decrypted text
    my $parser = new MIME::Parser;
    $parser->output_to_core(1);

    # for armor message (which usually contain no MIME entity)
    # and if the first line seems to be no header, add an empty
    # line at the top, otherwise the first line of a text message
    # will be removed by the parser.
    if ( $is_armor and $output_stdout !~ /^[\w-]+:/ ) {
        $output_stdout = "\n" . $output_stdout;
    }

    my $dec_entity = $parser->parse_data( $output_stdout );

    #-- Add headers from original entity
    if ( $dec_entity->head->as_string eq '' ) {
        $dec_entity->head( $entity->head->dup );
    }
    else {

        #-- copy header fields from original entity
        foreach my $tag ( $entity->head->tags ) {
            next if $tag =~ /^content/i;
            my @values = $entity->head->get($tag);
            for ( my $i = 0; $i < @values; ++$i ) {
                $dec_entity->head->replace( $tag, $values[$i], $i );
            }
        }
    }

    #-- debugging: create file with encrypted data
    if ( $self->get_debug ) {
        $self->save_debug_file(
            name => "dec-data.txt",
            data => $dec_entity->as_string,
        );
    }

    #-- fetch information from gpg's stderr output
    #-- and construct a Mail::GPG::Result object from it
    my $result = Mail::GPG::Result->new(
        mail_gpg   => $self,
        gpg_stdout => \$output_stdout,
        gpg_stderr => \$output_stderr,
        gpg_status => \$output_status,
        gpg_rc     => $rc,
    );

    #-- return decrypted entity and result object
    return $dec_entity if not wantarray;
    return ( $dec_entity, $result );
}

sub verify {
    my $self     = shift;
    my %par      = @_;
    my ($entity) = $par{'entity'};

    #-- ignore any PIPE signals, in case of gpg exited
    #-- early before we fed our data into it.
    local $SIG{PIPE} = 'IGNORE';

    #-- we parse gpg's output and rely on english
    local $ENV{LC_ALL} = "C";

    #-- check if the entity is signed
    my ( $signed_text, $signature_text );

    if ( $entity->effective_type =~ m!multipart/signed!i ) {

        #-- is this a valid RFC 3156 multipart/signed entity?
        die "Entity must have two parts"
            if $entity->parts != 2;
        die "Entity is not OpenPGP signed"
            unless $entity->parts(1)->effective_type
            =~ m!application/pgp-signature!i;

        #-- hopefully the $entity was parsed with
        #-- decode_bodies(0), otherwise this would
        #-- return decoded data, but the signature
        #-- is calculated on the *encoded* version.
        $signed_text    = $entity->parts(0)->as_string;
        $signature_text = $entity->parts(1)->body_as_string;

    }
    elsif ( $entity->bodyhandle ) {

        #-- probably an ASCII armor signed entity
        #-- in that case we need the *decoded* data
        $signed_text = $entity->bodyhandle->as_string;
        die "Entity is not OpenPGP signed"
            unless $signed_text =~ /^-----BEGIN PGP SIGNED MESSAGE-----/m;
    }
    else {
        die "Entity is not multipart/signed and has no body";
    }

    #-- get a GnuPG::Interface
    my $gpg = $self->new_gpg_interface;

    #-- initialize handles
    my $stdin  = IO::Handle->new;
    my $stdout = IO::Handle->new;
    my $stderr = IO::Handle->new;
    my $status = IO::Handle->new;

    my $handles = GnuPG::Handles->new(
        stdin  => $stdin,
        stdout => $stdout,
        stderr => $stderr,
        status => $status,
    );

    #-- distinguish between ascii amor embedded signature
    #-- and detached signature (RFC 3156)
    my ( $pid, $sign_file, $sign_fh );
    if ($signature_text) {

        #-- signature is detached, save it to a temp file
        ( $sign_fh, $sign_file ) = File::Temp::tempfile();
        print $sign_fh $signature_text;
        close $sign_fh;

        #-- pass signature filename to gpg
        $pid = $gpg->verify(
            handles      => $handles,
            command_args => [ $sign_file, "-" ],
        );

    }
    else {

        #-- ASCII armor message with embedded signature
        $pid = $gpg->verify( handles => $handles, );
    }

    #-- put encoded entity data into temporary file
    #-- (faster than in-memory operation)
    my ( $data_fh, $data_file ) = File::Temp::tempfile();
    unlink $data_file;
    print $data_fh $signed_text;

    #-- perform I/O (multiplexed to prevent blocking)
    my ( $output_stdout, $output_stderr, $output_status ) = ( "", "", "" );
    $self->perform_multiplexed_gpg_io(
        data_fh       => $data_fh,
        data_canonify => 1,
        stdin_fh      => $stdin,
        stderr_fh     => $stderr,
        stdout_fh     => $stdout,
        status_fh     => $status,
        stderr_sref   => \$output_stderr,
        stdout_sref   => \$output_stdout,
        status_sref   => \$output_status,
    );

    #-- close reader filehandles (stdin was closed
    #-- by perform_multiplexed_gpg_io())
    close $stdout;
    close $stderr;

    #-- fetch zombie
    waitpid $pid, 0;
    my $rc = $? >> 8;

    #-- remove detached signature file
    unlink $sign_file if defined $sign_file;

    #-- debugging: create file with verified data
    if ( $self->get_debug ) {
        $self->save_debug_file(
            name => "verify-data.txt",
            data => \$signed_text,
        );
    }

    #-- construct a Mail::GPG::Result object from
    #-- gpg's stderr output
    my $result = Mail::GPG::Result->new(
        mail_gpg   => $self,
        gpg_stdout => \$output_stdout,
        gpg_stderr => \$output_stderr,
        gpg_status => \$output_status,
        gpg_rc     => $rc,
    );

    #-- return result object
    return $result;
}

sub is_encrypted {
    my $self     = shift;
    my %par      = @_;
    my ($entity) = $par{'entity'};

    if ( $entity->effective_type =~ m!multipart/encrypted!i ) {

        #-- is this a valid RFC 3156 multipart/encrypted entity?
        return 0 if $entity->parts != 2;
        return 0
            unless $entity->parts(0)->effective_type
            =~ m!application/pgp-encrypted!i;

    }
    elsif ( $entity->bodyhandle ) {

        #-- probably an ASCII armor encrypted entity
        #-- check the decoded body for a PGP message
        return 0
            unless $entity->bodyhandle->as_string
            =~ /^-----BEGIN PGP MESSAGE-----/m;
    }
    else {
        return 0;
    }

    return 1;
}

sub is_signed {
    my $self     = shift;
    my %par      = @_;
    my ($entity) = $par{'entity'};

    if ( $entity->effective_type =~ m!multipart/signed!i ) {

        #-- is this a valid RFC 3156 multipart/signed entity?
        return 0 if $entity->parts != 2;
        return 0
            unless $entity->parts(1)->effective_type
            =~ m!application/pgp-signature!i;

    }
    elsif ( $entity->bodyhandle ) {

        #-- probably an ASCII armor signed entity,
        #-- check the decoded body for a PGP message
        return 0
            unless $entity->bodyhandle->as_string
            =~ /^-----BEGIN PGP SIGNED MESSAGE-----/m;
    }
    else {
        return 0;
    }

    return 1;
}

sub is_signed_quick {
    my $self = shift;
    my %par  = @_;
    my ($mail_fh, $mail_sref) = @par{'mail_fh', 'mail_sref'};

    croak "Specify mail_fh xor mail_sref"
        unless $mail_fh xor $mail_sref;

    if ( defined $mail_fh ) {

        #-- rewind filehandle
        seek( $mail_fh, 0, 0 );

        #-- read filehandle and do rough checks
        local ($_);
        my $is_signed = 0;
        while (<$mail_fh>) {
            if (m!application/pgp-signature!i) {
                $is_signed = 1;
                last;
            }
            if (/^-----BEGIN PGP SIGNED MESSAGE-----/) {
                $is_signed = 1;
                last;
            }
        }

        #-- rewind filehandle again
        seek( $mail_fh, 0, 0 );

        #-- return sign status
        return $is_signed;

    }
    elsif ( defined $mail_sref ) {

        #-- looks like a RFC 3156 multipart/signed entity?
        return 1 if $$mail_sref =~ m!application/pgp-signature!i;

        #-- or ASCII armor signed?
        return 1 if $$mail_sref =~ m!^-----BEGIN PGP SIGNED MESSAGE-----!m;

        #-- not signed at all
        return 0,;
    }

    return 1;
}

sub get_decrypt_key {
    my $self     = shift;
    my %par      = @_;
    my ($entity) = $par{'entity'};

    #-- ignore any PIPE signals, in case of gpg exited
    #-- early before we fed our data into it.
    local $SIG{PIPE} = 'IGNORE';

    #-- we parse gpg's output and rely on english
    local $ENV{LC_ALL} = "C";

    #-- check if the entity is encrypted at all
    #-- (dies if not)
    my $encrypted_text;
    my $is_armor = $self->check_encryption(
        entity              => $entity,
        encrypted_text_sref => \$encrypted_text,
    );

    #-- get a GnuPG::Interface
    my $gpg = $self->new_gpg_interface;

    #-- initialize handles
    my $stdin   = IO::Handle->new;
    my $stdout  = IO::Handle->new;
    my $stderr  = IO::Handle->new;
    my $handles = GnuPG::Handles->new(
        stdin  => $stdin,
        stdout => $stdout,
        stderr => $stderr,
    );

    #-- start gpg for decryption
    my $pid = $gpg->wrap_call(
        handles  => $handles,
        commands =>
            [ "--decrypt", "--batch", "--list-only", "--status-fd", "1" ],
    );

    #-- put encoded entity data into temporary file
    #-- (faster than in-memory operation)
    my ( $data_fh, $data_file ) = File::Temp::tempfile();
    unlink $data_file;
    print $data_fh $encrypted_text;

    #-- perform I/O (multiplexed to prevent blocking)
    my ( $output_stdout, $output_stderr ) = ( "", "" );
    $self->perform_multiplexed_gpg_io(
        data_fh       => $data_fh,
        data_canonify => 1,
        stdin_fh      => $stdin,
        stderr_fh     => $stderr,
        stdout_fh     => $stdout,
        stderr_sref   => \$output_stderr,
        stdout_sref   => \$output_stdout,
    );

    #-- close reader filehandles (stdin was closed
    #-- by perform_multiplexed_gpg_io())
    close $stdout;
    close $stderr;

    #-- fetch zombie
    waitpid $pid, 0;
    my $rc = $? >> 8;

    #-- grep ENC_TO and NO_SECKEY items
    my ( @enc_to_keys, %no_sec_keys, $line );
    while ( $output_stdout =~ /^(.*)$/mg ) {
        $line = $1;
        push @enc_to_keys, $1 if $line =~ /ENC_TO\s+([^\s]+)/;
        $no_sec_keys{$1} = 1 if $line =~ /NO_SECKEY\s+([^\s]+)/;
    }

    #-- find first key we have the secret portion of
    my $key_id;
    foreach my $k (@enc_to_keys) {
        if ( not exists $no_sec_keys{$k} ) {
            $key_id = $k;
            last;
        }
    }

    #-- get mail address of this key
    my $key_mail;
    ( $key_id, $key_mail ) = $self->query_keyring( search => $key_id );

    return $key_id if not wantarray;
    return ( $key_id, $key_mail );
}

sub extract_mail_address {
    my $self         = shift;
    my %par          = @_;
    my ($recipients) = $par{'recipients'};

    my @recipients;

    my $address;
    foreach my $r ( @{$recipients} ) {
        ($address) = Mail::Address->parse($r);
        push @recipients, $address
            ? $address->address
            : $r;
    }
    return \@recipients;
}

sub parse {
    my $thing = shift;
    my %par   = @_;
    my ($mail_fh, $mail_sref) = @par{'mail_fh','mail_sref'};

    croak "Specify mail_fh xor mail_sref"
        unless $mail_fh xor $mail_sref;

    require MIME::Parser;
    my ( $parser, $entity );

    #-- First parse without body decoding, which is correct
    #-- for MIME messages
    $parser = MIME::Parser->new;
    $parser->output_to_core(1);
    $parser->decode_bodies(0);
    $entity = $mail_fh
        ? $parser->parse($mail_fh)
        : $parser->parse_data($$mail_sref);

    #-- Ok, if this is a MIME message
    return $entity
        if $entity->effective_type eq 'multipart/signed'
        or $entity->effective_type eq 'multipart/encrypted';

    #-- Now with body decoding, which is MIME::Parser's default
    #-- and correct for OpenPGP armor message. Probably this
    #-- isn't an OpenPGP message at all. But also in that case
    #-- it's the best to return a decoded entity, as MIME::Parser
    #-- usually does.
    seek( $mail_fh, 0, 0 ) if $mail_fh;
    $parser->decode_bodies(1);
    $entity = $mail_fh
        ? $parser->parse($mail_fh)
        : $parser->parse_data($$mail_sref);

    return $entity;
}

sub get_key_trust {
    my $self     = shift;
    my %par      = @_;
    my ($key_id) = $par{'key_id'};

    # Suppress warnings about unknown record type 'tru'
    # in GnuPG::Interface
    local $SIG{__WARN__} = sub {1};

    my $gpg  = $self->new_gpg_interface;
    my @keys = $gpg->get_public_keys($key_id);

    croak "Request for key ID '$key_id' got multiple result"
        if @keys > 1;

    return "" unless $keys[0];
    return $keys[0]->owner_trust;
}

1;

__END__