Crypt-GpgME
view release on metacpan or search on metacpan
Revision history for Crypt-GpgME
0.09 Tue, 17 Nov 2009 23:49:04 +0100
* Disable auto_install in Makefile.PL.
* Upgrade Module::Install to 0.91.
* Fix failing tests by not relying on engine specifics.
0.08 Sun, 31 Aug 2008 21:53:02 +0200
* Require gpgme with api version == 1.
0.07 Fri, 29 Aug 2008 00:34:39 +0200
* Require perl 5.8.
0.06 Thu, 28 Aug 2008 21:44:26 +0200
* Add diagnostics to Makefile.PL in order to fix FAIL reports from
cpantesters.
0.05 Thu, 28 Aug 2008 07:54:18 +0200
* Add a testcase for openpgp key generation.
* Make key generation work with all engines.
0.04 Thu, 13 Sep 2007 15:02:34 +0200
* Don't croak when attemting to convert illegal enum values to strings.
* Don't pass NULL to newSVpv{,n}.
0.03 Thu, 10 May 2007 15:33:05 +0200
* Fix a coredump when gpgme_data_release_and_get_mem returned NULL.
* Use gpgme functions to convert algos/protos to strings.
This is an incompatible change as the proto/algo names were
previously returned in lower case (i.e. 'OpenPGP' was called 'openpgp'
in version 0.02 and below).
* Build depend on File::Which.
* Make Test::MockModule optional for the tests.
* Don't auto_include things anymore.
0.02 Sun, 29 Apr 2007 15:58:12 +0200
* Don't use IPC::Run to execute gpgme-config.
* Better error checking for converting c structures to perl hashes.
* Some performance optimisations.
* Make signature notation flags available from perl.
0.01 Wed, 18 Apr 2007 01:24:41 +0200
* First version, released on an unsuspecting world.
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/PRIVATE/Crypt/GpgME.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/Crypt/GpgME.pm
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
META.yml
perl_glue/perl_gpgme.c
perl_glue/perl_gpgme.h
perl_glue/perl_gpgme_data.c
perl_glue/perl_gpgme_data.h
perl_glue/ppport.h
README
t/00-load.t
t/armor.t
t/engine_info.t
t/genkey.t
t/get_key.t
t/gpg/gpg.conf
t/gpg/pubring.gpg
t/gpg/secring.gpg
t/gpg/trustdb.gpg
t/import.t
t/include_certs.t
t/keylist_mode.t
t/kwalitee.t
t/notabs.t
t/passphrase_cb.t
t/perl_glue.t
t/pod-coverage.t
t/pod.t
t/progress_cb.t
MANIFEST.SKIP view on Meta::CPAN
^xs/.*\.c$
\.o$
^pm_to_blib$
^\.git
^MANIFEST\.bak$
^Makefile$
\.bs$
^t/gpg/random_seed$
^t/var
^Crypt-GpgME-
^blib\b
\.swp$
~$
\.$
\.old$
^\.
---
abstract: 'Perl interface to libgpgme'
author:
- 'Florian Ragwitz, C<< <rafl at debian.org> >>'
build_requires:
ExtUtils::MakeMaker: 6.42
Test::Exception: 0
Test::More: 0
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
generated_by: 'Module::Install version 0.91'
Makefile.PL view on Meta::CPAN
use strict;
use warnings;
use lib 'ext';
use inc::Module::Install;
name 'Crypt-GpgME';
perl_version '5.008';
all_from 'lib/Crypt/GpgME.pm';
requires 'IO::Scalar';
requires_external_bin 'gpgme-config';
test_requires 'Test::Exception';
test_requires 'Test::More';
gpgme;
no_index directory => 'ext';
WriteAll;
ext/Module/Install/PRIVATE/Crypt/GpgME.pm view on Meta::CPAN
use strict;
use warnings;
use Module::Install::Base;
use vars qw{$VERSION @ISA};
BEGIN {
$VERSION = '0.01';
@ISA = qw{Module::Install::Base};
}
sub gpgme {
my ($self) = @_;
$self->requires_external_cc;
my $config_exe = $self->find_config_exe;
my %gpgme_config = $self->get_config($config_exe);
printf "*** Found GpgME with api version %s\n", $gpgme_config{'api-version'};
$self->check_api_version($gpgme_config{ 'api-version' });
$self->makemaker_args(INC => '-Iperl_glue' );
$self->makemaker_args(LIBS => $gpgme_config{ libs });
$self->makemaker_args(CCFLAGS => $gpgme_config{ cflags }
. sprintf(' -Wall -DGPGME_API_VERSION="%s"', $gpgme_config{'api-version'}) );
$self->xs_files;
}
sub find_config_exe {
my ($self) = @_;
if (defined $ENV{GPGME_CONFIG}) {
return $ENV{GPGME_CONFIG};
}
return 'gpgme-config';
}
sub get_config {
my ($self, $exe) = @_;
my %config = map {
($_ => $self->run_gpgme_config($exe, $_))
} qw/prefix exec-prefix api-version libs cflags/;
return %config;
}
sub run_gpgme_config {
my ($self, $exe, $key) = @_;
my $out = `$exe --$key`;
chomp $out;
return $out;
}
sub check_api_version {
my ($self, $version) = @_;
if (!defined $version) {
die "*** Could not find gpgme api version.\n"
}
if ($version ne '1') {
die <<EOM;
*** Your gpgme api version is incompatible to this module.
Please inform the author.
EOM
}
}
sub xs_files {
my ($self) = @_;
my @clean;
my @OBJECT;
inc/Module/Install/PRIVATE/Crypt/GpgME.pm view on Meta::CPAN
use strict;
use warnings;
use Module::Install::Base;
use vars qw{$VERSION @ISA};
BEGIN {
$VERSION = '0.01';
@ISA = qw{Module::Install::Base};
}
sub gpgme {
my ($self) = @_;
$self->requires_external_cc;
my $config_exe = $self->find_config_exe;
my %gpgme_config = $self->get_config($config_exe);
printf "*** Found GpgME with api version %s\n", $gpgme_config{'api-version'};
$self->check_api_version($gpgme_config{ 'api-version' });
$self->makemaker_args(INC => '-Iperl_glue' );
$self->makemaker_args(LIBS => $gpgme_config{ libs });
$self->makemaker_args(CCFLAGS => $gpgme_config{ cflags }
. sprintf(' -Wall -DGPGME_API_VERSION="%s"', $gpgme_config{'api-version'}) );
$self->xs_files;
}
sub find_config_exe {
my ($self) = @_;
if (defined $ENV{GPGME_CONFIG}) {
return $ENV{GPGME_CONFIG};
}
return 'gpgme-config';
}
sub get_config {
my ($self, $exe) = @_;
my %config = map {
($_ => $self->run_gpgme_config($exe, $_))
} qw/prefix exec-prefix api-version libs cflags/;
return %config;
}
sub run_gpgme_config {
my ($self, $exe, $key) = @_;
my $out = `$exe --$key`;
chomp $out;
return $out;
}
sub check_api_version {
my ($self, $version) = @_;
if (!defined $version) {
die "*** Could not find gpgme api version.\n"
}
if ($version ne '1') {
die <<EOM;
*** Your gpgme api version is incompatible to this module.
Please inform the author.
EOM
}
}
sub xs_files {
my ($self) = @_;
my @clean;
my @OBJECT;
lib/Crypt/GpgME.pm view on Meta::CPAN
use strict;
use warnings;
use base qw/IO::Scalar/;
1;
__END__
=head1 NAME
Crypt::GpgME - Perl interface to libgpgme
=head1 SYNOPSIS
use IO::File;
use Crypt::GpgME;
my $ctx = Crypt::GpgME->new;
$ctx->set_passphrase_cb(sub { 'abc' });
lib/Crypt/GpgME.pm view on Meta::CPAN
print while <$signed>;
=head1 FUNCTIONS
=head2 GPGME_VERSION
my $version = Crypt::GpgME->GPGME_VERSION;
my $version = $ctx->GPGME_VERSION;
Returns a string containing the libgpgme version number this module has been
compiled against.
=head2 new
my $ctx = Crypt::GpgME->new;
Returns a new Crypt::GpgME instance. Throws an exception on error.
=head2 card_edit
lib/Crypt/GpgME.pm view on Meta::CPAN
my ($result, $plain) = $ctx->verify($sig);
my $result = $ctx->verify($sig, $signed_text);
=head1 AUTHOR
Florian Ragwitz, C<< <rafl at debian.org> >>
=head1 BUGS
Please report any bugs or feature requests to
C<bug-crypt-gpgme at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Crypt-GpgME>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Crypt::GpgME
perl_glue/perl_gpgme.c view on Meta::CPAN
#include "perl_gpgme.h"
static const perl_gpgme_status_code_map_t perl_gpgme_status_code_map[] = {
{ GPGME_STATUS_EOF, "eof" },
{ GPGME_STATUS_ENTER, "enter" },
{ GPGME_STATUS_LEAVE, "leave" },
{ GPGME_STATUS_ABORT, "abort" },
{ GPGME_STATUS_GOODSIG, "goodsig" },
{ GPGME_STATUS_BADSIG, "badsig" },
{ GPGME_STATUS_ERRSIG, "errsig" },
perl_glue/perl_gpgme.c view on Meta::CPAN
{ GPGME_STATUS_SC_OP_SUCCESS, "sc-op-success" },
{ GPGME_STATUS_CARDCTRL, "cardctrl" },
{ GPGME_STATUS_BACKUP_KEY_CREATED, "backup-key-created" },
{ GPGME_STATUS_PKA_TRUST_BAD, "pka-trust-bad" },
{ GPGME_STATUS_PKA_TRUST_GOOD, "pka-trust-good" },
{ GPGME_STATUS_PLAINTEXT, "plaintext" }
};
void
_perl_gpgme_call_xs (pTHX_ void (*subaddr) (pTHX_ CV *), CV *cv, SV **mark) {
dSP;
PUSHMARK (mark);
(*subaddr) (aTHX_ cv);
PUTBACK;
}
SV *
perl_gpgme_new_sv_from_ptr (void *ptr, const char *class) {
SV *obj, *sv;
HV *stash;
obj = (SV *)newHV ();
sv_magic (obj, 0, PERL_MAGIC_ext, (const char *)ptr, 0);
sv = newRV_noinc (obj);
stash = gv_stashpv (class, 0);
sv_bless (sv, stash);
return sv;
}
void *
perl_gpgme_get_ptr_from_sv (SV *sv, const char *class) {
MAGIC *mg;
mg = perl_gpgme_get_magic_from_sv (sv, class);
return (void *)mg->mg_ptr;
}
MAGIC *
perl_gpgme_get_magic_from_sv (SV *sv, const char *class) {
MAGIC *mg;
if (!sv || !SvOK (sv) || !SvROK (sv)
|| (class && !sv_derived_from (sv, class))
|| !(mg = mg_find (SvRV (sv), PERL_MAGIC_ext))) {
croak ("invalid object");
}
return mg;
}
void
perl_gpgme_assert_error (gpgme_error_t err) {
if (err == GPG_ERR_NO_ERROR) {
return;
}
croak ("%s: %s", gpgme_strsource (err), gpgme_strerror (err));
}
perl_gpgme_callback_t *
perl_gpgme_callback_new (SV *func, SV *data, SV *obj, int n_params, perl_gpgme_callback_param_type_t param_types[], int n_retvals, perl_gpgme_callback_retval_type_t retval_types[]) {
perl_gpgme_callback_t *cb;
Newxz (cb, 1, perl_gpgme_callback_t);
cb->func = newSVsv (func);
if (data) {
cb->data = newSVsv (data);
}
if (obj) {
SvREFCNT_inc (obj);
cb->obj = obj;
}
cb->n_params = n_params;
if (cb->n_params) {
if (!param_types) {
croak ("n_params is %d, but param_types is NULL", n_params);
}
Newx (cb->param_types, n_params, perl_gpgme_callback_param_type_t);
Copy (param_types, cb->param_types, n_params, perl_gpgme_callback_param_type_t);
}
cb->n_retvals = n_retvals;
if (cb->n_retvals) {
if (!retval_types) {
croak ("n_retvals is %d, but retval_types is NULL", n_retvals);
}
Newx (cb->retval_types, n_retvals, perl_gpgme_callback_retval_type_t);
Copy (retval_types, cb->retval_types, n_retvals, perl_gpgme_callback_retval_type_t);
}
#ifdef PERL_IMPLICIT_CONTEXT
cb->priv = aTHX;
#endif
return cb;
}
void
perl_gpgme_callback_destroy (perl_gpgme_callback_t *cb) {
if (cb) {
if (cb->func) {
SvREFCNT_dec (cb->func);
cb->func = NULL;
}
if (cb->data) {
SvREFCNT_dec (cb->func);
cb->func = NULL;
}
perl_glue/perl_gpgme.c view on Meta::CPAN
Safefree (cb->retval_types);
cb->n_retvals = 0;
cb->retval_types = NULL;
}
Safefree (cb);
}
}
void
perl_gpgme_callback_invoke (perl_gpgme_callback_t *cb, perl_gpgme_callback_retval_t *retvals, ...) {
va_list va_args;
int ret, i;
I32 call_flags;
dPERL_GPGME_CALLBACK_MARSHAL_SP;
if (!cb) {
croak ("NULL cb in callback_invoke");
}
perl_glue/perl_gpgme.c view on Meta::CPAN
sv = newSViv (va_arg (va_args, int));
break;
case PERL_GPGME_CALLBACK_PARAM_TYPE_CHAR: {
char tmp[0];
tmp[0] = va_arg (va_args, int);
sv = newSVpv (tmp, 1);
break;
}
case PERL_GPGME_CALLBACK_PARAM_TYPE_STATUS:
sv = perl_gpgme_sv_from_status_code (va_arg (va_args, gpgme_status_code_t));
break;
default:
PUTBACK;
croak ("unknown perl_gpgme_callback_param_type_t");
}
if (!sv) {
PUTBACK;
croak ("failed to convert value to sv");
}
PUSHs (sv);
}
perl_glue/perl_gpgme.c view on Meta::CPAN
SPAGAIN;
if (ret != cb->n_retvals) {
PUTBACK;
croak ("callback didn't return as much values as expected (got: %d, expected: %d)", ret, cb->n_retvals);
}
for (i = 0; i < ret; i++) {
switch (cb->retval_types[i]) {
case PERL_GPGME_CALLBACK_RETVAL_TYPE_STR:
retvals[i] = (perl_gpgme_callback_retval_t)savepv (POPp);
break;
default:
PUTBACK;
croak ("unknown perl_gpgme_callback_retval_type_t");
}
}
PUTBACK;
FREETMPS;
LEAVE;
}
SV *
perl_gpgme_protocol_to_string (gpgme_protocol_t protocol) {
const char *name = gpgme_get_protocol_name (protocol);
if (!name) {
return &PL_sv_undef;
}
return newSVpv (name, 0);
}
void
perl_gpgme_hv_store (HV *hv, const char *key, I32 key_len, SV *val) {
SV **ret;
if (key_len == 0) {
key_len = strlen (key);
}
ret = hv_store (hv, key, key_len, val, 0);
if (!ret) {
croak ("failed to store value inside hash");
}
}
SV *
perl_gpgme_hashref_from_engine_info (gpgme_engine_info_t info) {
SV *sv;
HV *hv;
hv = newHV ();
if (info->file_name) {
perl_gpgme_hv_store (hv, "file_name", 9, newSVpv (info->file_name, 0));
}
if (info->home_dir) {
perl_gpgme_hv_store (hv, "home_dir", 8, newSVpv (info->home_dir, 0));
}
if (info->version) {
perl_gpgme_hv_store (hv, "version", 7, newSVpv (info->version, 0));
}
if (info->req_version) {
perl_gpgme_hv_store (hv, "req_version", 11, newSVpv (info->req_version, 0));
}
perl_gpgme_hv_store (hv, "protocol", 8, perl_gpgme_protocol_to_string (info->protocol));
sv = newRV_noinc ((SV *)hv);
return sv;
}
SV *
perl_gpgme_pubkey_algo_to_string (gpgme_pubkey_algo_t algo) {
const char *name = gpgme_pubkey_algo_name (algo);
if (!name) {
return &PL_sv_undef;
}
return newSVpv (name, 0);
}
SV *
perl_gpgme_hashref_from_subkey (gpgme_subkey_t subkey) {
SV *sv;
HV *hv;
hv = newHV ();
perl_gpgme_hv_store (hv, "revoked", 7, newSVuv (subkey->revoked));
perl_gpgme_hv_store (hv, "expired", 7, newSVuv (subkey->expired));
perl_gpgme_hv_store (hv, "disabled", 8, newSVuv (subkey->disabled));
perl_gpgme_hv_store (hv, "invalid", 7, newSVuv (subkey->invalid));
perl_gpgme_hv_store (hv, "can_encrypt", 11, newSVuv (subkey->can_encrypt));
perl_gpgme_hv_store (hv, "can_sign", 8, newSVuv (subkey->can_sign));
perl_gpgme_hv_store (hv, "can_certify", 11, newSVuv (subkey->can_certify));
perl_gpgme_hv_store (hv, "secret", 6, newSVuv (subkey->secret));
perl_gpgme_hv_store (hv, "can_authenticate", 16, newSVuv (subkey->can_authenticate));
perl_gpgme_hv_store (hv, "is_qualified", 12, newSVuv (subkey->is_qualified));
perl_gpgme_hv_store (hv, "pubkey_algo", 11, perl_gpgme_pubkey_algo_to_string (subkey->pubkey_algo));
perl_gpgme_hv_store (hv, "length", 6, newSVuv (subkey->length));
if (subkey->keyid) {
perl_gpgme_hv_store (hv, "keyid", 5, newSVpv (subkey->keyid, 0));
}
if (subkey->fpr) {
perl_gpgme_hv_store (hv, "fpr", 3, newSVpv (subkey->fpr, 0));
}
perl_gpgme_hv_store (hv, "timestamp", 9, newSViv (subkey->timestamp)); /* FIXME: long int vs. int? */
perl_gpgme_hv_store (hv, "expires", 7, newSViv (subkey->expires)); /* ditto */
sv = newRV_noinc ((SV *)hv);
return sv;
}
SV *
perl_gpgme_hashref_from_uid (gpgme_user_id_t uid) {
SV *sv;
HV *hv;
hv = newHV ();
perl_gpgme_hv_store (hv, "revoked", 7, newSVuv (uid->revoked));
perl_gpgme_hv_store (hv, "invalid", 7, newSVuv (uid->invalid));
perl_gpgme_hv_store (hv, "validity", 8, perl_gpgme_validity_to_string (uid->validity));
if (uid->uid) {
perl_gpgme_hv_store (hv, "uid", 3, newSVpv (uid->uid, 0));
}
if (uid->name) {
perl_gpgme_hv_store (hv, "name", 4, newSVpv (uid->name, 0));
}
if (uid->email) {
perl_gpgme_hv_store (hv, "email", 5, newSVpv (uid->email, 0));
}
if (uid->comment) {
perl_gpgme_hv_store (hv, "comment", 7, newSVpv (uid->comment, 0));
}
if (uid->signatures) {
perl_gpgme_hv_store (hv, "signatures", 10, perl_gpgme_array_ref_from_signatures (uid->signatures));
}
sv = newRV_noinc ((SV *)hv);
return sv;
}
SV *
perl_gpgme_array_ref_from_signatures (gpgme_key_sig_t sig) {
SV *sv;
AV *av;
gpgme_key_sig_t i;
av = newAV ();
for (i = sig; i != NULL; i = i->next) {
av_push (av, perl_gpgme_hashref_from_signature (i));
}
sv = newRV_noinc ((SV *)av);
return sv;
}
SV *
perl_gpgme_hashref_from_signature (gpgme_key_sig_t sig) {
SV *sv;
HV *hv;
hv = newHV ();
perl_gpgme_hv_store (hv, "revoked", 7, newSVuv (sig->revoked));
perl_gpgme_hv_store (hv, "expired", 7, newSVuv (sig->expired));
perl_gpgme_hv_store (hv, "invalid", 7, newSVuv (sig->invalid));
perl_gpgme_hv_store (hv, "exportable", 10, newSVuv (sig->exportable));
perl_gpgme_hv_store (hv, "pubkey_algo", 11, perl_gpgme_pubkey_algo_to_string (sig->pubkey_algo));
if (sig->keyid) {
perl_gpgme_hv_store (hv, "keyid", 5, newSVpv (sig->keyid, 0));
}
perl_gpgme_hv_store (hv, "timestamp", 9, newSViv (sig->timestamp)); /* FIXME: long int vs. IV? */
perl_gpgme_hv_store (hv, "expires", 7, newSViv (sig->expires)); /* ditto */
if (sig->status != GPG_ERR_NO_ERROR) {
perl_gpgme_hv_store (hv, "status", 6, newSVpvf ("%s: %s", gpgme_strsource (sig->status), gpgme_strerror (sig->status)));
}
if (sig->uid) {
perl_gpgme_hv_store (hv, "uid", 3, newSVpv (sig->uid, 0));
}
if (sig->name) {
perl_gpgme_hv_store (hv, "name", 4, newSVpv (sig->name, 0));
}
if (sig->email) {
perl_gpgme_hv_store (hv, "email", 5, newSVpv (sig->email, 0));
}
if (sig->comment) {
perl_gpgme_hv_store (hv, "comment", 7, newSVpv (sig->comment, 0));
}
/* FIXME: really export this? */
perl_gpgme_hv_store (hv, "sig_class", 9, newSVuv (sig->sig_class));
if (sig->notations) {
perl_gpgme_hv_store (hv, "notations", 9, perl_gpgme_array_ref_from_notations (sig->notations));
}
sv = newRV_noinc ((SV *)hv);
return sv;
}
SV *
perl_gpgme_array_ref_from_notations (gpgme_sig_notation_t notations) {
SV *sv;
AV *av;
gpgme_sig_notation_t i;
av = newAV ();
for (i = notations; i != NULL; i = i->next) {
av_push (av, perl_gpgme_hashref_from_notation (i));
}
sv = newRV_noinc ((SV *)av);
return sv;
}
SV *
perl_gpgme_hashref_from_notation (gpgme_sig_notation_t notation) {
SV *sv;
HV *hv;
hv = newHV ();
if (notation->name) {
perl_gpgme_hv_store (hv, "name", 4, newSVpv (notation->name, notation->name_len));
}
if (notation->value) {
perl_gpgme_hv_store (hv, "value", 5, newSVpv (notation->value, notation->value_len));
}
perl_gpgme_hv_store (hv, "flags", 5, perl_gpgme_avref_from_notation_flags (notation->flags));
perl_gpgme_hv_store (hv, "human_readable", 14, newSVuv (notation->human_readable));
perl_gpgme_hv_store (hv, "critical", 8, newSVuv (notation->critical));
sv = newRV_noinc ((SV *)hv);
return sv;
}
SV *
perl_gpgme_avref_from_notation_flags (gpgme_sig_notation_flags_t flags) {
SV *sv;
AV *av;
av = newAV ();
if (flags & GPGME_SIG_NOTATION_HUMAN_READABLE) {
av_push (av, newSVpv ("human-readable", 0));
}
if (flags & GPGME_SIG_NOTATION_CRITICAL) {
av_push (av, newSVpv ("critical", 0));
}
sv = newRV_inc ((SV *)av);
return sv;
}
SV *
perl_gpgme_validity_to_string (gpgme_validity_t validity) {
SV *ret;
switch (validity) {
case GPGME_VALIDITY_UNKNOWN:
ret = newSVpvn ("unknown", 7);
break;
case GPGME_VALIDITY_UNDEFINED:
ret = newSVpvn ("undefined", 9);
break;
case GPGME_VALIDITY_NEVER:
perl_glue/perl_gpgme.c view on Meta::CPAN
ret = newSVpvn ("ultimate", 8);
break;
default:
ret = &PL_sv_undef;
}
return ret;
}
SV *
perl_gpgme_hashref_from_verify_result (gpgme_verify_result_t result) {
SV *sv;
HV *hv;
hv = newHV ();
if (result->file_name) {
perl_gpgme_hv_store (hv, "file_name", 9, newSVpv (result->file_name, 0));
}
if (result->signatures) {
perl_gpgme_hv_store (hv, "signatures", 10, perl_gpgme_array_ref_from_verify_signatures (result->signatures));
}
sv = newRV_noinc ((SV *)hv);
return sv;
}
SV *
perl_gpgme_array_ref_from_verify_signatures (gpgme_signature_t sig) {
SV *sv;
AV *av;
gpgme_signature_t i;
av = newAV ();
for (i = sig; i != NULL; i = i->next) {
av_push (av, perl_gpgme_hashref_from_verify_signature (i));
}
sv = newRV_noinc ((SV *)av);
return sv;
}
SV *
perl_gpgme_hashref_from_verify_signature (gpgme_signature_t sig) {
SV *sv;
HV *hv;
hv = newHV ();
perl_gpgme_hv_store (hv, "summary", 7, perl_gpgme_sigsum_to_string (sig->summary));
if (sig->fpr) {
perl_gpgme_hv_store (hv, "fpr", 3, newSVpv (sig->fpr, 0));
}
if (sig->status != GPG_ERR_NO_ERROR) {
perl_gpgme_hv_store (hv, "status", 6, newSVpvf ("%s: %s", gpgme_strsource (sig->status), gpgme_strerror (sig->status)));
}
perl_gpgme_hv_store (hv, "notations", 9, perl_gpgme_array_ref_from_notations (sig->notations));
perl_gpgme_hv_store (hv, "timestamp", 9, newSVuv (sig->timestamp)); /* FIXME: long uint vs. UV */
perl_gpgme_hv_store (hv, "exp_timestamp", 13, newSVuv (sig->exp_timestamp)); /* ditto */
perl_gpgme_hv_store (hv, "wrong_key_usage", 15, newSVuv (sig->wrong_key_usage));
perl_gpgme_hv_store (hv, "pka_trust", 9, newSVuv (sig->pka_trust));
perl_gpgme_hv_store (hv, "validity", 8, perl_gpgme_validity_to_string (sig->validity));
if (sig->validity_reason != GPG_ERR_NO_ERROR) {
perl_gpgme_hv_store (hv, "validity_reason", 15, newSVpvf ("%s: %s", gpgme_strsource (sig->status), gpgme_strerror (sig->status)));
}
perl_gpgme_hv_store (hv, "pubkey_algo", 11, perl_gpgme_pubkey_algo_to_string (sig->pubkey_algo));
perl_gpgme_hv_store (hv, "hash_algo", 9, perl_gpgme_hash_algo_to_string (sig->hash_algo));
if (sig->pka_address) {
perl_gpgme_hv_store (hv, "pka_address", 11, newSVpv (sig->pka_address, 0));
}
sv = newRV_noinc ((SV *)hv);
return sv;
}
SV *
perl_gpgme_sigsum_to_string (gpgme_sigsum_t summary) {
SV *sv;
AV *av;
av = newAV ();
if (summary & GPGME_SIGSUM_VALID) {
av_push (av, newSVpv ("valid", 0));
}
if (summary & GPGME_SIGSUM_GREEN) {
perl_glue/perl_gpgme.c view on Meta::CPAN
if (summary & GPGME_SIGSUM_SYS_ERROR) {
av_push (av, newSVpv ("sys-error", 0));
}
sv = newRV_noinc ((SV *)av);
return sv;
}
SV *
perl_gpgme_hash_algo_to_string (gpgme_hash_algo_t algo) {
const char *name = gpgme_hash_algo_name (algo);
if (!name) {
return &PL_sv_undef;
}
return newSVpv (name, 0);
}
SV *
perl_gpgme_hashref_from_trust_item (gpgme_trust_item_t item) {
SV *sv;
HV *hv;
hv = newHV ();
if (item->keyid) {
perl_gpgme_hv_store (hv, "keyid", 5, newSVpv (item->keyid, 0));
}
perl_gpgme_hv_store (hv, "type", 4, newSVpv (item->type == 1 ? "key" : "uid", 0));
perl_gpgme_hv_store (hv, "level", 5, newSViv (item->level));
if (item->type == 1 && item->owner_trust) {
perl_gpgme_hv_store (hv, "owner_trust", 11, newSVpv (item->owner_trust, 0));
}
if (item->validity) {
perl_gpgme_hv_store (hv, "validity", 8, newSVpv (item->validity, 0));
}
if (item->type == 2 && item->name) {
perl_gpgme_hv_store (hv, "name", 4, newSVpv (item->name, 0));
}
sv = newRV_noinc ((SV *)hv);
return sv;
}
SV *
perl_gpgme_sv_from_status_code (gpgme_status_code_t status) {
int i;
SV *ret = NULL;
for (i = 0; i < sizeof (perl_gpgme_status_code_map) / sizeof (perl_gpgme_status_code_map[0]); i++) {
perl_gpgme_status_code_map_t map = perl_gpgme_status_code_map[i];
if (map.status == status) {
ret = newSVpv (map.string, 0);
break;
}
}
if (!ret) {
croak ("unknown status code");
}
return ret;
}
SV *
perl_gpgme_genkey_result_to_sv (gpgme_genkey_result_t result) {
SV *sv;
HV *hv;
hv = newHV ();
perl_gpgme_hv_store (hv, "primary", 7, newSViv (result->primary));
perl_gpgme_hv_store (hv, "sub", 3, newSViv (result->sub));
if (result->fpr) {
perl_gpgme_hv_store (hv, "fpr", 3, newSVpv (result->fpr, 0));
}
sv = newRV_noinc ((SV *)hv);
return sv;
}
perl_glue/perl_gpgme.h view on Meta::CPAN
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#include <proto.h>
#include "ppport.h"
#include <gpgme.h>
#include <string.h>
#include <sys/types.h>
#include <unistd.h>
#include "perl_gpgme_data.h"
#define PERL_GPGME_CALL_BOOT(name) \
{ \
EXTERN_C XS(name); \
_perl_gpgme_call_xs (aTHX_ name, cv, mark); \
}
#ifdef PERL_IMPLICIT_CONTEXT
#define dPERL_GPGME_CALLBACK_MARSHAL_SP \
SV **sp;
#define PERL_GPGME_MARSHAL_INIT(cb) \
PERL_SET_CONTEXT (cb->priv); \
SPAGAIN;
perl_glue/perl_gpgme.h view on Meta::CPAN
#else
#define dPERL_GPGME_CALLBACK_MARSHAL_SP \
dSP;
#define PERL_GPGME_MARSHAL_INIT(cb) \
/* nothing to do */
#endif
typedef gpgme_ctx_t perl_gpgme_ctx_or_null_t;
typedef struct perl_gpgme_status_code_map_St {
gpgme_status_code_t status;
const char *string;
} perl_gpgme_status_code_map_t;
typedef enum {
PERL_GPGME_CALLBACK_PARAM_TYPE_STR,
PERL_GPGME_CALLBACK_PARAM_TYPE_INT,
PERL_GPGME_CALLBACK_PARAM_TYPE_CHAR,
PERL_GPGME_CALLBACK_PARAM_TYPE_STATUS
} perl_gpgme_callback_param_type_t;
typedef enum {
PERL_GPGME_CALLBACK_RETVAL_TYPE_STR
} perl_gpgme_callback_retval_type_t;
typedef void * perl_gpgme_callback_retval_t;
typedef struct perl_gpgme_callback_St {
SV *func;
SV *data;
SV *obj;
int n_params;
perl_gpgme_callback_param_type_t *param_types;
int n_retvals;
perl_gpgme_callback_retval_type_t *retval_types;
void *priv;
} perl_gpgme_callback_t;
void _perl_gpgme_call_xs (pTHX_ void (*subaddr) (pTHX_ CV *cv), CV *cv, SV **mark);
SV *perl_gpgme_new_sv_from_ptr (void *ptr, const char *class);
void *perl_gpgme_get_ptr_from_sv (SV *sv, const char *class);
MAGIC *perl_gpgme_get_magic_from_sv (SV *sv, const char *class);
void perl_gpgme_assert_error (gpgme_error_t err);
perl_gpgme_callback_t *perl_gpgme_callback_new (SV *func, SV *data, SV *obj, int n_params, perl_gpgme_callback_param_type_t param_types[], int n_retvals, perl_gpgme_callback_retval_type_t retval_types[]);
void perl_gpgme_callback_destroy (perl_gpgme_callback_t *cb);
void perl_gpgme_callback_invoke (perl_gpgme_callback_t *cb, perl_gpgme_callback_retval_t *retvals, ...);
SV *perl_gpgme_protocol_to_string (gpgme_protocol_t protocol);
void perl_gpgme_hv_store (HV *hv, const char *key, I32 key_len, SV *val);
SV *perl_gpgme_hashref_from_engine_info (gpgme_engine_info_t info);
SV *perl_gpgme_hashref_from_subkey (gpgme_subkey_t subkey);
SV *perl_gpgme_hashref_from_uid (gpgme_user_id_t uid);
SV *perl_gpgme_avref_from_notation_flags (gpgme_sig_notation_flags_t flags);
SV *perl_gpgme_validity_to_string (gpgme_validity_t validity);
SV *perl_gpgme_array_ref_from_signatures (gpgme_key_sig_t sig);
SV *perl_gpgme_hashref_from_signature (gpgme_key_sig_t sig);
SV *perl_gpgme_array_ref_from_notations (gpgme_sig_notation_t notations);
SV *perl_gpgme_hashref_from_notation (gpgme_sig_notation_t notation);
SV *perl_gpgme_hashref_from_verify_result (gpgme_verify_result_t result);
SV *perl_gpgme_array_ref_from_verify_signatures (gpgme_signature_t sigs);
SV *perl_gpgme_hashref_from_verify_signature (gpgme_signature_t sig);
SV *perl_gpgme_sigsum_to_string (gpgme_sigsum_t summary);
SV *perl_gpgme_hash_algo_to_string (gpgme_hash_algo_t algo);
SV *perl_gpgme_hashref_from_trust_item (gpgme_trust_item_t item);
SV *perl_gpgme_sv_from_status_code (gpgme_status_code_t status);
SV *perl_gpgme_genkey_result_to_sv (gpgme_genkey_result_t result);
perl_glue/perl_gpgme_data.c view on Meta::CPAN
#include "perl_gpgme.h"
ssize_t
perl_gpgme_data_read (void *handle, void *buffer, size_t size) {
dSP;
ssize_t got_size;
int ret;
STRLEN buf_len;
char *buf_chr;
SV *sv_buffer;
sv_buffer = newSVpv ("", 0);
ENTER;
perl_glue/perl_gpgme_data.c view on Meta::CPAN
buffer = memcpy (buffer, buf_chr, buf_len);
PUTBACK;
FREETMPS;
LEAVE;
return got_size;
}
ssize_t
perl_gpgme_data_write (void *handle, const void *buffer, size_t size) {
dSP;
ssize_t got_size;
int ret;
ENTER;
SAVETMPS;
PUSHMARK (sp);
EXTEND (sp, 3);
perl_glue/perl_gpgme_data.c view on Meta::CPAN
got_size = POPi;
PUTBACK;
FREETMPS;
LEAVE;
return got_size;
}
off_t
perl_gpgme_data_seek (void *handle, off_t offset, int whence) {
dSP;
off_t seeked;
int ret;
ENTER;
SAVETMPS;
PUSHMARK (sp);
EXTEND (sp, 3);
perl_glue/perl_gpgme_data.c view on Meta::CPAN
seeked = POPi;
PUTBACK;
FREETMPS;
LEAVE;
return seeked;
}
void
perl_gpgme_data_release (void *handle) {
SvREFCNT_inc ((SV *)handle);
}
gpgme_data_t
perl_gpgme_data_new (SV *sv) {
gpgme_data_t data;
gpgme_error_t err;
static struct gpgme_data_cbs cbs;
static gpgme_data_cbs_t cbs_ptr = NULL;
if (!cbs_ptr) {
memset (&cbs, 0, sizeof (cbs));
cbs.read = perl_gpgme_data_read;
cbs.write = perl_gpgme_data_write;
cbs.seek = perl_gpgme_data_seek;
cbs.release = perl_gpgme_data_release;
cbs_ptr = &cbs;
}
SvREFCNT_inc (sv);
err = gpgme_data_new_from_cbs (&data, cbs_ptr, sv);
perl_gpgme_assert_error (err);
return data;
}
SV *
perl_gpgme_data_io_handle_from_scalar (SV *scalar) {
dSP;
SV *sv;
int ret;
ENTER;
SAVETMPS;
PUSHMARK (sp);
EXTEND (sp, 2);
perl_glue/perl_gpgme_data.c view on Meta::CPAN
SvREFCNT_inc (sv); /* why? */
PUTBACK;
FREETMPS;
LEAVE;
return sv;
}
SV *
perl_gpgme_data_to_sv (gpgme_data_t data) {
dSP;
SV *sv, *buffer;
char *buf;
int ret;
size_t len;
gpgme_data_seek (data, 0, SEEK_SET);
buf = gpgme_data_release_and_get_mem (data, &len);
if (!buf) {
buffer = newSV (0);
}
else {
buffer = newSVpv (buf, len);
}
gpgme_free (buf);
ENTER;
SAVETMPS;
PUSHMARK (sp);
EXTEND (sp, 2);
mPUSHp ("Crypt::GpgME::Data", 18);
PUSHs (newRV_inc (buffer));
perl_glue/perl_gpgme_data.c view on Meta::CPAN
sv = POPs;
SvREFCNT_inc (sv); /* why? */
PUTBACK;
FREETMPS;
LEAVE;
return sv;
}
gpgme_data_t
perl_gpgme_data_from_io_handle (SV *handle) {
return perl_gpgme_data_new (handle);
}
perl_glue/perl_gpgme_data.h view on Meta::CPAN
ssize_t perl_gpgme_data_read (void *handle, void *buffer, size_t size);
ssize_t perl_gpgme_data_write (void *handle, const void *buffer, size_t size);
off_t perl_gpgme_data_seek (void *handle, const off_t offset, int whence);
void perl_gpgme_data_release (void *handle);
gpgme_data_t perl_gpgme_data_new (SV *sv);
gpgme_data_t perl_gpgme_data_from_io_handle (SV *sv);
SV *perl_gpgme_data_io_handle_from_scalar (SV *scalar);
SV *perl_gpgme_data_to_sv (gpgme_data_t data);
t/00-load.t view on Meta::CPAN
#!perl
use Test::More tests => 1;
BEGIN {
use_ok( 'Crypt::GpgME' );
}
diag( "Testing Crypt::GpgME $Crypt::GpgME::VERSION, Perl $], $^X on gpgme " . Crypt::GpgME->GPGME_VERSION );
t/get_key.t view on Meta::CPAN
#!perl
use strict;
use warnings;
use Test::More tests => 7;
use Test::Exception;
delete $ENV{GPG_AGENT_INFO};
$ENV{GNUPGHOME} = 't/gpg';
BEGIN {
use_ok ('Crypt::GpgME');
}
my $fpr = '758E67AA4F0A13F7897AE49A1D57D5E006E16945';
my $ctx = Crypt::GpgME->new;
isa_ok ($ctx, 'Crypt::GpgME');
eval 'use Test::MockModule';
plan skip_all => 'Test::MockModule required' if $@;
plan tests => 15;
require Crypt::GpgME;
my $called = 0;
my $version = 'junk';
my $gpgme = Test::MockModule->new('Crypt::GpgME');
$gpgme->mock(check_version => sub ($;$) {
++$called;
$version = $_[1];
});
lives_ok (sub {
Crypt::GpgME->import;
}, 'import without arguments');
is ($called, 1, 'import without arguments called check_version');
is ($version, undef, 'import without arguments called check_version with undef');
t/keylist_mode.t view on Meta::CPAN
lives_ok (sub {
$keylist_mode = $ctx->get_keylist_mode;
}, 'getting keylist_mode');
is_deeply ($keylist_mode, [$mode], 'setting keylist_mode worked');
}
}
throws_ok(sub {
$ctx->set_keylist_mode(['opengpg']);
}, qr/^unknown keylist mode/, 'setting invalid keylist_mode');
throws_ok(sub {
$ctx->set_keylist_mode({});
}, qr/not an array reference/, 'calling with non-array-ref');
lives_ok (sub {
$ctx->set_keylist_mode;
}, 'setting keylist_mode without argument works');
t/passphrase_cb.t view on Meta::CPAN
use warnings;
use Test::More tests => 48;
use Test::Exception;
use IO::Scalar;
BEGIN {
use_ok( 'Crypt::GpgME' );
}
delete $ENV{GPG_AGENT_INFO};
$ENV{GNUPGHOME} = 't/gpg';
my $ctx;
lives_ok (sub {
$ctx = Crypt::GpgME->new;
}, 'create new context');
isa_ok ($ctx, 'Crypt::GpgME');
my $plain = IO::Scalar->new(\q/test test test/);
t/progress_cb.t view on Meta::CPAN
plan skip_all => 'Scalar::Util required' if $@;
plan tests => 24;
}
BEGIN {
use_ok( 'Crypt::GpgME' );
}
delete $ENV{GPG_AGENT_INFO};
$ENV{GNUPGHOME} = 't/gpg';
my $ctx;
lives_ok (sub {
$ctx = Crypt::GpgME->new;
}, 'create new context');
isa_ok ($ctx, 'Crypt::GpgME');
my $plain = IO::Scalar->new(\q/test test test/);
t/protocol.t view on Meta::CPAN
my $proto;
lives_ok (sub {
$proto = $ctx->get_protocol;
}, 'getting protocol');
is ($proto, 'OpenPGP', 'setting protocol worked');
}
throws_ok(sub {
$ctx->set_protocol('opengpg');
}, qr/^unknown protocol/, 'setting invalid protocol');
lives_ok (sub {
$ctx->set_protocol;
}, 'setting protocol without argument works');
{
my $proto;
lives_ok (sub {
use strict;
use warnings;
use Test::More tests => 10;
use Test::Exception;
BEGIN {
use_ok( 'Crypt::GpgME' );
}
delete $ENV{GPG_AGENT_INFO};
$ENV{GNUPGHOME} = 't/gpg';
my $ctx = Crypt::GpgME->new;
isa_ok ($ctx, 'Crypt::GpgME');
$ctx->set_passphrase_cb(sub { 'abc' });
my $data = 'test test test';
my $signed;
lives_ok (sub {
xs/GpgME.xs view on Meta::CPAN
#include "perl_gpgme.h"
gpgme_error_t
perl_gpgme_passphrase_cb (void *user_data, const char *uid_hint, const char *passphrase_info, int prev_was_bad, int fd) {
char *buf;
perl_gpgme_callback_retval_t retvals[1];
perl_gpgme_callback_t *cb = (perl_gpgme_callback_t *)user_data;
perl_gpgme_callback_invoke (cb, retvals, uid_hint, passphrase_info, prev_was_bad, fd);
buf = (char *)retvals[0];
write (fd, buf, strlen (buf));
write (fd, "\n", 1);
Safefree (buf);
return 0; /* FIXME */
}
void
perl_gpgme_progress_cb (void *user_data, const char *what, int type, int current, int total) {
perl_gpgme_callback_t *cb = (perl_gpgme_callback_t *)user_data;
perl_gpgme_callback_invoke (cb, NULL, what, type, current, total);
}
gpgme_error_t
perl_gpgme_edit_cb (void *user_data, gpgme_status_code_t status, const char *args, int fd) {
char *buf;
perl_gpgme_callback_retval_t retvals[1];
perl_gpgme_callback_t *cb = (perl_gpgme_callback_t *)user_data;
perl_gpgme_callback_invoke (cb, retvals, status, args);
buf = (char *)retvals[0];
write (fd, buf, strlen (buf));
write (fd, "\n", 1);
return 0; /* FIXME */
}
MODULE = Crypt::GpgME PACKAGE = Crypt::GpgME PREFIX = gpgme_
PROTOTYPES: ENABLE
gpgme_ctx_t
gpgme_new (class)
PREINIT:
gpgme_error_t err;
CODE:
err = gpgme_new (&RETVAL);
POSTCALL:
perl_gpgme_assert_error (err);
OUTPUT:
RETVAL
void
DESTROY (ctx)
gpgme_ctx_t ctx
PREINIT:
perl_gpgme_callback_t *cb = NULL;
gpgme_passphrase_cb_t pass_cb;
CODE:
gpgme_get_passphrase_cb (ctx, &pass_cb, (void **)&cb);
if (cb) {
perl_gpgme_callback_destroy (cb);
}
gpgme_release (ctx);
NO_OUTPUT gpgme_error_t
gpgme_set_protocol (ctx, proto=GPGME_PROTOCOL_OpenPGP)
gpgme_ctx_t ctx
gpgme_protocol_t proto
POSTCALL:
perl_gpgme_assert_error (RETVAL);
gpgme_protocol_t
gpgme_get_protocol (ctx)
gpgme_ctx_t ctx
void
gpgme_set_armor (ctx, armor)
gpgme_ctx_t ctx
int armor
int
gpgme_get_armor (ctx)
gpgme_ctx_t ctx
void
gpgme_set_textmode (ctx, textmode)
gpgme_ctx_t ctx
int textmode
int
gpgme_get_textmode (ctx)
gpgme_ctx_t ctx
void
gpgme_set_include_certs (ctx, nr_of_certs=GPGME_INCLUDE_CERTS_DEFAULT)
gpgme_ctx_t ctx
int nr_of_certs
int
gpgme_get_include_certs (ctx)
gpgme_ctx_t ctx
NO_OUTPUT gpgme_error_t
gpgme_set_keylist_mode (ctx, mode=GPGME_KEYLIST_MODE_LOCAL)
gpgme_ctx_t ctx
gpgme_keylist_mode_t mode
POSTCALL:
perl_gpgme_assert_error (RETVAL);
gpgme_keylist_mode_t
gpgme_get_keylist_mode (ctx)
gpgme_ctx_t ctx
void
gpgme_set_passphrase_cb (ctx, func, user_data=NULL)
SV *ctx
SV *func
SV *user_data
PREINIT:
perl_gpgme_callback_t *cb = NULL;
perl_gpgme_callback_param_type_t param_types[3];
perl_gpgme_callback_retval_type_t retval_types[1];
gpgme_ctx_t c_ctx;
gpgme_passphrase_cb_t pass_cb;
INIT:
param_types[0] = PERL_GPGME_CALLBACK_PARAM_TYPE_STR; /* uid_hint */
param_types[1] = PERL_GPGME_CALLBACK_PARAM_TYPE_STR; /* passphrase_info */
param_types[2] = PERL_GPGME_CALLBACK_PARAM_TYPE_INT; /* prev_was_bad */
retval_types[0] = PERL_GPGME_CALLBACK_RETVAL_TYPE_STR; /* password */
CODE:
c_ctx = (gpgme_ctx_t)perl_gpgme_get_ptr_from_sv (ctx, "Crypt::GpgME");
gpgme_get_passphrase_cb (c_ctx, &pass_cb, (void **)&cb);
if (cb) {
perl_gpgme_callback_destroy (cb);
}
cb = perl_gpgme_callback_new (func, user_data, ctx, 3, param_types, 1, retval_types);
gpgme_set_passphrase_cb (c_ctx, perl_gpgme_passphrase_cb, cb);
void
gpgme_set_progress_cb (ctx, func, user_data=NULL)
SV *ctx
SV *func
SV *user_data
PREINIT:
perl_gpgme_callback_t *cb = NULL;
perl_gpgme_callback_param_type_t param_types[4];
gpgme_ctx_t c_ctx;
gpgme_progress_cb_t prog_cb;
INIT:
param_types[0] = PERL_GPGME_CALLBACK_PARAM_TYPE_STR; /* what */
param_types[1] = PERL_GPGME_CALLBACK_PARAM_TYPE_CHAR; /* type */
param_types[2] = PERL_GPGME_CALLBACK_PARAM_TYPE_INT; /* current */
param_types[3] = PERL_GPGME_CALLBACK_PARAM_TYPE_INT; /* total */
CODE:
c_ctx = (gpgme_ctx_t)perl_gpgme_get_ptr_from_sv (ctx, "Crypt::GpgME");
gpgme_get_progress_cb (c_ctx, &prog_cb, (void **)&cb);
if (cb) {
perl_gpgme_callback_destroy (cb);
}
cb = perl_gpgme_callback_new (func, user_data, ctx, 4, param_types, 0, NULL);
gpgme_set_progress_cb (c_ctx, perl_gpgme_progress_cb, cb);
NO_OUTPUT gpgme_error_t
gpgme_set_locale (ctx, category, value)
perl_gpgme_ctx_or_null_t ctx
int category
const char *value
void
gpgme_get_engine_info (ctx)
perl_gpgme_ctx_or_null_t ctx
PREINIT:
gpgme_engine_info_t info, i;
PPCODE:
if (ctx == NULL) {
gpgme_error_t err;
err = gpgme_get_engine_info (&info);
perl_gpgme_assert_error (err);
}
else {
info = gpgme_ctx_get_engine_info (ctx);
}
for (i = info; i != NULL; i = i->next) {
SV *sv = perl_gpgme_hashref_from_engine_info (i);
sv_2mortal (sv);
XPUSHs (sv);
}
NO_OUTPUT gpgme_error_t
gpgme_set_engine_info (ctx, proto, file_name, home_dir)
perl_gpgme_ctx_or_null_t ctx
gpgme_protocol_t proto
const char *file_name
const char *home_dir
CODE:
if (ctx == NULL) {
RETVAL = gpgme_set_engine_info (proto, file_name, home_dir);
}
else {
RETVAL = gpgme_ctx_set_engine_info (ctx, proto, file_name, home_dir);
}
POSTCALL:
perl_gpgme_assert_error (RETVAL);
void
gpgme_signers_clear (ctx)
gpgme_ctx_t ctx
NO_OUTPUT gpgme_error_t
gpgme_signers_add (ctx, key)
gpgme_ctx_t ctx
const gpgme_key_t key
POSTCALL:
perl_gpgme_assert_error (RETVAL);
gpgme_key_t
gpgme_signers_enum (ctx, seq)
gpgme_ctx_t ctx
int seq
void
gpgme_sig_notation_clear (ctx)
gpgme_ctx_t ctx
NO_OUTPUT gpgme_error_t
gpgme_sig_notation_add (ctx, name, value, flags=0)
gpgme_ctx_t ctx
const char *name
const char *value
gpgme_sig_notation_flags_t flags
void
gpgme_sig_notation_get (ctx)
gpgme_ctx_t ctx
PREINIT:
gpgme_sig_notation_t notations, i;
PPCODE:
notations = gpgme_sig_notation_get (ctx);
for (i = notations; i != NULL; i = i->next) {
XPUSHs (sv_2mortal (perl_gpgme_hashref_from_notation (i)));
}
gpgme_key_t
gpgme_get_key (ctx, fpr, secret=0)
gpgme_ctx_t ctx
const char *fpr
int secret
PREINIT:
gpgme_error_t err;
CODE:
err = gpgme_get_key (ctx, fpr, &RETVAL, secret);
POSTCALL:
perl_gpgme_assert_error (err);
OUTPUT:
RETVAL
#NO_OUTPUT gpgme_error_t
#gpgme_cancel (ctx)
# gpgme_ctx_t ctx
# POSTCALL:
# perl_gpgme_assert_error (RETVAL);
void
gpgme_verify (ctx, sig, signed_text=NULL)
gpgme_ctx_t ctx
gpgme_data_t sig
gpgme_data_t signed_text
PREINIT:
gpgme_error_t err;
gpgme_data_t plain = NULL;
gpgme_verify_result_t result;
INIT:
gpgme_data_seek (sig, 0, SEEK_SET);
if (signed_text) {
gpgme_data_seek (signed_text, 0, SEEK_SET);
}
PPCODE:
if (!signed_text) {
err = gpgme_data_new (&plain);
perl_gpgme_assert_error (err);
}
err = gpgme_op_verify (ctx, sig, signed_text, plain);
perl_gpgme_assert_error (err);
result = gpgme_op_verify_result (ctx);
XPUSHs (sv_2mortal (perl_gpgme_hashref_from_verify_result (result)));
if (!signed_text) {
XPUSHs (sv_2mortal (perl_gpgme_data_to_sv (plain)));
}
gpgme_data_t
gpgme_sign (ctx, plain, mode=GPGME_SIG_MODE_NORMAL)
gpgme_ctx_t ctx
gpgme_data_t plain
gpgme_sig_mode_t mode
PREINIT:
gpgme_error_t err;
INIT:
err = gpgme_data_new (&RETVAL);
perl_gpgme_assert_error (err);
gpgme_data_seek (plain, 0, SEEK_SET);
CODE:
err = gpgme_op_sign (ctx, plain, RETVAL, mode);
POSTCALL:
perl_gpgme_assert_error (err);
gpgme_data_seek (RETVAL, 0, SEEK_SET);
OUTPUT:
RETVAL
#NO_OUTPUT gpgme_error_t
#gpgme_key_import (ctx, keydata)
# gpgme_ctx_t ctx
# gpgme_data_t keydata
# CODE:
# RETVAL = gpgme_op_import (ctx, keydata);
# POSTCALL:
# perl_gpgme_assert_error (RETVAL);
void
gpgme_genkey (ctx, parms)
gpgme_ctx_t ctx
const char *parms
PREINIT:
gpgme_error_t err;
gpgme_data_t pubkey, seckey;
gpgme_genkey_result_t result;
INIT:
switch (gpgme_get_protocol (ctx)) {
case GPGME_PROTOCOL_OpenPGP:
pubkey = NULL;
seckey = NULL;
break;
default:
err = gpgme_data_new (&pubkey);
perl_gpgme_assert_error (err);
err = gpgme_data_new (&seckey);
perl_gpgme_assert_error (err);
}
PPCODE:
err = gpgme_op_genkey (ctx, parms, pubkey, seckey);
perl_gpgme_assert_error (err);
result = gpgme_op_genkey_result (ctx);
EXTEND (sp, 3);
PUSHs (perl_gpgme_genkey_result_to_sv (result));
PUSHs (perl_gpgme_data_to_sv (pubkey));
PUSHs (perl_gpgme_data_to_sv (seckey));
NO_OUTPUT gpgme_error_t
gpgme_delete (ctx, key, allow_secret=0)
gpgme_ctx_t ctx
gpgme_key_t key
int allow_secret
CODE:
RETVAL = gpgme_op_delete (ctx, key, allow_secret);
POSTCALL:
perl_gpgme_assert_error (RETVAL);
gpgme_data_t
gpgme_edit (ctx, key, func, user_data=NULL)
SV *ctx
gpgme_key_t key
SV *func
SV *user_data
PREINIT:
perl_gpgme_callback_t *cb = NULL;
perl_gpgme_callback_param_type_t param_types[2];
perl_gpgme_callback_retval_type_t retval_types[1];
gpgme_ctx_t c_ctx;
INIT:
param_types[0] = PERL_GPGME_CALLBACK_PARAM_TYPE_STATUS; /* status */
param_types[1] = PERL_GPGME_CALLBACK_PARAM_TYPE_STR; /* args */
retval_types[0] = PERL_GPGME_CALLBACK_RETVAL_TYPE_STR; /* result */
CODE:
c_ctx = (gpgme_ctx_t)perl_gpgme_get_ptr_from_sv (ctx, "Crypt::GpgME");
cb = perl_gpgme_callback_new (func, user_data, ctx, 2, param_types, 1, retval_types);
gpgme_op_edit (c_ctx, key, perl_gpgme_edit_cb, cb, RETVAL);
perl_gpgme_callback_destroy (cb);
OUTPUT:
RETVAL
gpgme_data_t
gpgme_card_edit (ctx, key, func, user_data=NULL)
SV *ctx
gpgme_key_t key
SV *func
SV *user_data
PREINIT:
perl_gpgme_callback_t *cb = NULL;
perl_gpgme_callback_param_type_t param_types[2];
perl_gpgme_callback_retval_type_t retval_types[1];
gpgme_ctx_t c_ctx;
INIT:
param_types[0] = PERL_GPGME_CALLBACK_PARAM_TYPE_STATUS; /* status */
param_types[1] = PERL_GPGME_CALLBACK_PARAM_TYPE_STR; /* args */
retval_types[0] = PERL_GPGME_CALLBACK_RETVAL_TYPE_STR; /* result */
CODE:
c_ctx = (gpgme_ctx_t)perl_gpgme_get_ptr_from_sv (ctx, "Crypt::GpgME");
cb = perl_gpgme_callback_new (func, user_data, ctx, 2, param_types, 1, retval_types);
gpgme_op_card_edit (c_ctx, key, perl_gpgme_edit_cb, cb, RETVAL);
perl_gpgme_callback_destroy (cb);
OUTPUT:
RETVAL
void
gpgme_keylist (ctx, pattern, secret_only=0)
gpgme_ctx_t ctx
const char *pattern
int secret_only
PREINIT:
gpgme_error_t err;
gpgme_key_t key;
PPCODE:
err = gpgme_op_keylist_start (ctx, pattern, secret_only);
perl_gpgme_assert_error (err);
while ((err = gpgme_op_keylist_next (ctx, &key)) == GPG_ERR_NO_ERROR) {
XPUSHs (perl_gpgme_new_sv_from_ptr (key, "Crypt::GpgME::Key"));
}
if (gpg_err_code (err) != GPG_ERR_EOF) {
perl_gpgme_assert_error (err);
}
void
gpgme_trustlist (ctx, pattern, max_level)
gpgme_ctx_t ctx
const char *pattern
int max_level
PREINIT:
gpgme_error_t err;
gpgme_trust_item_t item;
PPCODE:
err = gpgme_op_trustlist_start (ctx, pattern, max_level);
perl_gpgme_assert_error (err);
while ((err = gpgme_op_trustlist_next (ctx, &item)) == GPG_ERR_NO_ERROR) {
XPUSHs (perl_gpgme_hashref_from_trust_item (item));
gpgme_trust_item_unref (item);
}
if (gpg_err_code (err) != GPG_ERR_EOF) {
perl_gpgme_assert_error (err);
}
gpgme_op_trustlist_end (ctx);
NO_OUTPUT gpgme_error_t
gpgme_engine_check_version (ctx, proto)
perl_gpgme_ctx_or_null_t ctx
gpgme_protocol_t proto
C_ARGS:
proto
POSTCALL:
perl_gpgme_assert_error (RETVAL);
const char *
GPGME_VERSION (class)
CODE:
RETVAL = GPGME_VERSION;
OUTPUT:
RETVAL
const char *
gpgme_check_version (class, version=NULL)
const char *version
C_ARGS:
version
POSTCALL:
if (!RETVAL) {
croak ("version requirement is not met");
}
BOOT:
PERL_GPGME_CALL_BOOT (boot_Crypt__GpgME__Key);
xs/GpgMEKey.xs view on Meta::CPAN
#include "perl_gpgme.h"
MODULE = Crypt::GpgME::Key PACKAGE = Crypt::GpgME::Key
PROTOTYPES: ENABLE
void
DESTROY (key)
gpgme_key_t key
CODE:
gpgme_key_unref (key);
unsigned int
revoked (key)
gpgme_key_t key
CODE:
RETVAL = key->revoked;
OUTPUT:
RETVAL
unsigned int
expired (key)
gpgme_key_t key
CODE:
RETVAL = key->expired;
OUTPUT:
RETVAL
unsigned int
disabled (key)
gpgme_key_t key
CODE:
RETVAL = key->disabled;
OUTPUT:
RETVAL
unsigned int
invalid (key)
gpgme_key_t key
CODE:
RETVAL = key->invalid;
OUTPUT:
RETVAL
unsigned int
can_encrypt (key)
gpgme_key_t key
CODE:
RETVAL = key->can_encrypt;
OUTPUT:
RETVAL
unsigned int
can_sign (key)
gpgme_key_t key
CODE:
RETVAL = key->can_sign;
OUTPUT:
RETVAL
unsigned int
can_certify (key)
gpgme_key_t key
CODE:
RETVAL = key->can_certify;
OUTPUT:
RETVAL
unsigned int
secret (key)
gpgme_key_t key
CODE:
RETVAL = key->secret;
OUTPUT:
RETVAL
unsigned int
can_authenticate (key)
gpgme_key_t key
CODE:
RETVAL = key->can_authenticate;
OUTPUT:
RETVAL
unsigned int
is_qualified (key)
gpgme_key_t key
CODE:
RETVAL = key->is_qualified;
OUTPUT:
RETVAL
gpgme_protocol_t
protocol (key)
gpgme_key_t key
CODE:
RETVAL = key->protocol;
OUTPUT:
RETVAL
#TODO: croak if field has no meaning with the current protocol?
char *
issuer_serial (key)
gpgme_key_t key
CODE:
RETVAL = key->issuer_serial;
OUTPUT:
RETVAL
char *
issuer_name (key)
gpgme_key_t key
CODE:
RETVAL = key->issuer_name;
OUTPUT:
RETVAL
char *
chain_id (key)
gpgme_key_t key
CODE:
RETVAL = key->chain_id;
OUTPUT:
RETVAL
gpgme_validity_t
owner_trust (key)
gpgme_key_t key
CODE:
RETVAL = key->owner_trust;
OUTPUT:
RETVAL
void
subkeys (key)
gpgme_key_t key
PREINIT:
gpgme_subkey_t i;
PPCODE:
for (i = key->subkeys; i != NULL; i = i->next) {
XPUSHs (sv_2mortal (perl_gpgme_hashref_from_subkey (i)));
}
void
uids (key)
gpgme_key_t key
PREINIT:
gpgme_user_id_t i;
PPCODE:
for (i = key->uids; i != NULL; i = i->next) {
XPUSHs (sv_2mortal (perl_gpgme_hashref_from_uid (i)));
}
gpgme_keylist_mode_t
keylist_mode (key)
gpgme_key_t key
CODE:
RETVAL = key->keylist_mode;
OUTPUT:
RETVAL
TYPEMAP
gpgme_ctx_t GPGME_CTX_T
perl_gpgme_ctx_or_null_t PERL_GPGME_CTX_OR_NULL_T
gpgme_protocol_t GPGME_PROTOCOL_T
gpgme_keylist_mode_t GPGME_KEYLIST_MODE_T
gpgme_data_t GPGME_DATA_T
gpgme_sig_mode_t GPGME_SIG_MODE_T
gpgme_key_t GPGME_KEY_T
const gpgme_key_t GPGME_KEY_T
gpgme_validity_t GPGME_VALIDITY_T
gpgme_sig_notation_flags_t GPGME_SIG_NOTATION_FLAGS_T
OUTPUT
GPGME_CTX_T
$arg = perl_gpgme_new_sv_from_ptr ($var, \"Crypt::GpgME\");
GPGME_PROTOCOL_T
$arg = perl_gpgme_protocol_to_string ($var);
GPGME_KEYLIST_MODE_T
{
AV *av = newAV ();
if ($var & GPGME_KEYLIST_MODE_LOCAL) {
av_push (av, newSVpvn (\"local\", 5));
}
if ($var & GPGME_KEYLIST_MODE_EXTERN) {
av_push (av, newSVpvn (\"extern\", 6));
av_push (av, newSVpvn (\"sig-notations\", 13));
}
if ($var & GPGME_KEYLIST_MODE_VALIDATE) {
av_push (av, newSVpvn (\"validate\", 8));
}
$arg = newRV_noinc ((SV *)av);
}
GPGME_DATA_T
$arg = perl_gpgme_data_to_sv ($var);
GPGME_VALIDITY_T
$arg = perl_gpgme_validity_to_string ($var);
GPGME_KEY_T
$arg = perl_gpgme_new_sv_from_ptr ($var, \"Crypt::GpgME::Key\");
INPUT
GPGME_CTX_T
$var = ($type)perl_gpgme_get_ptr_from_sv ($arg, \"Crypt::GpgME\");
PERL_GPGME_CTX_OR_NULL_T
if (!$arg || !SvOK ($arg) || !SvROK ($arg)) {
$var = NULL;
}
else {
$var = ($type)perl_gpgme_get_ptr_from_sv ($arg, \"Crypt::GpgME\");
}
GPGME_PROTOCOL_T
{
char *protocol = SvPV_nolen ($arg);
if (strcasecmp (protocol, \"openpgp\") == 0) {
$var = GPGME_PROTOCOL_OpenPGP;
}
else if (strcasecmp (protocol, \"cms\") == 0) {
}
}
}
GPGME_DATA_T
{
SV *tmp;
if (!SvROK ($arg)) {
tmp = perl_gpgme_data_io_handle_from_scalar ($arg);
}
else {
tmp = $arg;
}
if (tmp && SvOK (tmp) && sv_isobject (tmp) && sv_derived_from (tmp, \"IO::Handle\")) {
$var = ($type)perl_gpgme_data_from_io_handle (tmp);
}
else {
croak (\"not a valid IO::Handle\");
}
}
GPGME_SIG_MODE_T
{
char *sig_mode = SvPV_nolen ($arg);
}
else if (strcasecmp (sig_mode, \"clear\") == 0) {
$var = GPGME_SIG_MODE_CLEAR;
}
else {
croak (\"unknown sig mode\");
}
}
GPGME_KEY_T
$var = ($type)perl_gpgme_get_ptr_from_sv ($arg, \"Crypt::GpgME::Key\");
GPGME_SIG_NOTATION_FLAGS_T
if (!$arg || !SvOK ($arg) || !SvROK ($arg) || !(SvTYPE (SvRV ($arg)) != SVt_PVAV)) {
croak (\"not a valid flags array reference\");
}
{
AV *av;
SV **sv;
int i, len;
( run in 1.057 second using v1.01-cache-2.11-cpan-df04353d9ac )