view release on metacpan or  search on metacpan

lib/AnyEvent/GnuPG.pm  view on Meta::CPAN

sub DESTROY {
    my $self = shift;

    $self->{gnupg_proc}->kill if $self->{gnupg_proc};
}

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my %args = @_;

    my $self = {};
    if ( $args{homedir} ) {
        confess("Invalid home directory: $args{homedir}")
          unless -d $args{homedir} && -x _;
        $self->{homedir} = $args{homedir};
    }
    if ( $args{options} ) {
        confess("Invalid options file: $args{options}")
          unless -r $args{options};
        $self->{options} = $args{options};
    }
    if ( $args{gnupg_path} ) {
        confess("Invalid gpg path: $args{gnupg_path}")
          unless -x $args{gnupg_path};
        $self->{gnupg_path} = $args{gnupg_path};
    }
    else {
        my ($path) = grep { -x "$_/gpg" } split /:/, $ENV{PATH};
        confess("Couldn't find gpg in PATH ($ENV{PATH})") unless $path;
        $self->{gnupg_path} = "$path/gpg";
    }

    bless $self, $class;
}

sub version {
    shift->version_cb(@_)->recv;
}

sub version_cb {
    my ( $self, $cb ) = @_;
    my $cv = _condvar($cb);

    $self->_command("version");
    $self->_options( [] );
    $self->_args(    [] );

    my $version;

    my $proc = $self->_run_gnupg($cv);

    $proc->pipe( \$version );

    $proc->finish;

    $self->_end_gnupg(
        sub {
            if ( $version =~ m{\d(?:\.\d)*} ) {
                $cv->send( split m{\.} => $& );
            }
            else {
                $cv->croak(
                    "cannot obtain version number from string: '$version'");
            }
        }
    );

    $cv;
}

sub gen_key {
    shift->gen_key_cb(@_)->recv;
}

sub gen_key_cb {
    my ( $self, %args ) = @_;
    my $cv = _condvar( delete $args{cb} );
    my $cmd;
    my $arg;

    my $algo = $args{algo};
    $algo ||= RSA_RSA;

    my $size = $args{size};
    $size ||= 1024;
    return _croak( $cv, "Keysize is too small: $size" ) if $size < 768;
    return _croak( $cv, "Keysize is too big: $size" )   if $size > 2048;

    my $expire = $args{valid};
    $expire ||= 0;

    my $passphrase = $args{passphrase} || "";
    my $name = $args{name};

    return _croak( $cv, "Missing key name" ) unless $name;
    return _croak( $cv, "Invalid name: $name" )
      unless $name =~ /^\s*[^0-9\<\(\[\]\)\>][^\<\(\[\]\)\>]+$/;

    my $email = $args{email};
    if ($email) {
        ($email) = Email::Address->parse($email)
          or _croak( $cv, "Invalid email address: $email" );
    }
    else {
        $email = "";
    }

    my $comment = $args{comment};
    if ($comment) {
        _croak( $cv, "Invalid characters in comment" ) if $comment =~ /[\(\)]/;
    }
    else {
        $comment = "";
    }

    $self->_command("gen-key");
    $self->_options( [] );
    $self->_args(    [] );