parcimonie 0.10.2-4 / usr / share / perl5 / App / Parcimonie.pm

package App::Parcimonie;

use warnings;
use strict;

use App::Parcimonie::GnuPG::Interface;
use Carp;
use Clone qw{clone};
use Config::General qw/ParseConfig/;
use Encode;
use English qw/-no_match_vars/;
use File::HomeDir;
use IPC::System::Simple qw/capturex/;
use List::MoreUtils qw/uniq/;
use List::Util qw/shuffle/;
use Path::Tiny;
use Try::Tiny;
use version 0.77;

use Exporter;
our @ISA = qw(Exporter);

use namespace::clean;


=head1 NAME

App::Parcimonie - tools for the parcimonie program

=head1 SYNOPSIS

See bin/parcimonie :)

=head1 EXPORT

=cut

our @EXPORT = qw/pickRandomItems gpgPublicKeys gpgRecvKeys gpg_is_v21
                 checkGpgHasDefinedKeyserver averageLapseTime/;

my $codeset;
try {
    require I18N::Langinfo;
    I18N::Langinfo->import(qw(langinfo CODESET));
    $codeset = langinfo(CODESET());
} catch {
    croak "No default character code set configured.\nPlease fix your locale settings.";
};


=head1 SUBROUTINES

=head2 pickRandomItems(N, @list)

Returns a list of N unique items picked at random from the input list.

=cut

sub pickRandomItems {
    my $n = shift;
    my @randomized_pool = shuffle(uniq(@_));

    defined $n
        or croak "pickRandomItems must be passed at least one argument";
    $n =~ m/[0-9]+/
        or croak "pickRandomItems must be passed an integer";
    $n <= @randomized_pool
        or croak "pickRandomItems can't return more unique items than you feed it";

    return @randomized_pool[0..$n - 1];
}

=head2 gpg_is_v21()

Detects the version of the gpg binary in the $PATH.
Returns true iff. it is 2.1 or newer.

=cut
sub gpg_is_v21 {
    version->parse(App::Parcimonie::GnuPG::Interface->new()->version())
        >= version->parse('2.1.0');
}

=head2 gpgPublicKeys()

Returns the list of key fingerprints found in the public keyring.

Args:
  - $gnupg_options: reference to a hash passed to ->hash_init

=cut

sub gpgPublicKeys {
    my $gnupg_options = shift;
    my %gi_args       = @_;

    my $gnupg = App::Parcimonie::GnuPG::Interface->new(%gi_args);
    $gnupg->options->hash_init(%{ clone($gnupg_options) });
    $gnupg->get_public_keys_hex();
}

=head2 gpgRecvKeys( $keyids, $gnupg_options )

Imports the keys with the given key IDs from a keyserver.

Args:
  - $keyids: reference to an array of key IDs
  - $gnupg_options: reference to a hash passed to ->hash_init

=cut

sub gpgRecvKeys {
    my $keyids        = shift;
    my $gnupg_options = shift;
    my %gi_args       = @_;

    my $gnupg = App::Parcimonie::GnuPG::Interface->new(%gi_args);
    $gnupg->options->hash_init(%{ clone($gnupg_options) });
    my $err_h = IO::Handle->new();
    my $handles = GnuPG::Handles->new(stderr => $err_h);
    my $pid = $gnupg->recv_keys( handles => $handles, command_args => $keyids );

    my @raw_stderr = <$err_h>;  # reading the output
    close $err_h;

    waitpid $pid, 0;  # clean up the finished GnuPG process

    my $std_err = decode($codeset, join('', @raw_stderr));

    # Filter out lines such as:
    # 11:21:19 libtorsocks(27234): The symbol res_query() was not found...
    $std_err =~ s{
                     ^                  # anchor at a line beginning
                     [[:digit:]]{2}
                     [:]
                     [[:digit:]]{2}     # time such as 11:21:19
                     [:]
                     [[:digit:]]{2}
                     [[:space:]]+
                     libtorsocks
                     [(]
                     [[:digit:]]+       # PID surrounded by parenthesis
                     [)]
                     [:]
                     [[:space:]]+
                     [^\n]*             # anything but a line break
                     $
                     [\n]?
             }{}xmsg;

    no warnings;
    unless ($CHILD_ERROR == 0) {
        use warnings;
        croak $std_err;
    }
    use warnings;

    return $std_err;
}

=head2 checkGpgHasDefinedKeyserver

Throws an exception if no keyserver is defined in GnuPG configuration.

When using GnuPG 2.x, a keyserver can be defined either in dirmngr's
configuration or in good old gpg.conf, so we check both.

=cut

sub checkGpgHasDefinedKeyserver {
    my $gnupg_options = shift;
    my $arg_ref       = shift;
    my $gnupg_homedir = $gnupg_options->{homedir};
    my $gnupg2        = $arg_ref->{gnupg2};

    if ($gnupg2) {
        my @homedir_args = defined $gnupg_homedir
            ? ('--homedir', $gnupg_homedir)
            : ();
        my @output = capturex(
            'gpg-connect-agent', @homedir_args,
            qw{--dirmngr keyserver /bye}
        );
        my $res = pop @output;
        $res eq "OK\n" || croak "Agent replied: $res";
        if (@output) {
            my $last_keyserver = pop @output;
            if ($last_keyserver =~ m{\A [S] \s+ KEYSERVER \s+}xms) {
                return;
            }
        }
    }

    my $gpgconf;
    if (defined $gnupg_homedir) {
        $gpgconf = path($gnupg_homedir, 'gpg.conf');
    }
    else {
        $gpgconf = path(File::HomeDir->my_home, '.gnupg', 'gpg.conf');
    }

    -f $gpgconf
        or croak "No GnuPG configuration file was found in '$gpgconf'";
    -r $gpgconf
        or croak "The GnuPG configuration file ($gpgconf) is not readable";

    my %gpgconf = ParseConfig($gpgconf);

    defined $gpgconf{keyserver} && length $gpgconf{keyserver}
        or croak
            "No keyserver is defined in GnuPG configuration ($gpgconf).\n" .
            "See 'man parcimonie' to learn how to correct that.";

    return;
}

=head2 averageLapseTime

Argument: number of public keys in the keyring.
Returns the desirable average lapse time (in seconds) between two key
fetches.

=cut

sub averageLapseTime {
    604800 / shift;     # 1 week = 604800 seconds
}

1; # End of App::Parcimonie