diff options
Diffstat (limited to 'lib/GnuPG')
| -rw-r--r-- | lib/GnuPG/Fingerprint.pm | 93 | ||||
| -rw-r--r-- | lib/GnuPG/Handles.pm | 185 | ||||
| -rw-r--r-- | lib/GnuPG/HashInit.pm | 12 | ||||
| -rw-r--r-- | lib/GnuPG/Interface.pm | 1477 | ||||
| -rw-r--r-- | lib/GnuPG/Key.pm | 274 | ||||
| -rw-r--r-- | lib/GnuPG/Options.pm | 378 | ||||
| -rw-r--r-- | lib/GnuPG/PrimaryKey.pm | 143 | ||||
| -rw-r--r-- | lib/GnuPG/PublicKey.pm | 53 | ||||
| -rw-r--r-- | lib/GnuPG/Revoker.pm | 157 | ||||
| -rw-r--r-- | lib/GnuPG/SecretKey.pm | 53 | ||||
| -rw-r--r-- | lib/GnuPG/Signature.pm | 169 | ||||
| -rw-r--r-- | lib/GnuPG/SubKey.pm | 107 | ||||
| -rw-r--r-- | lib/GnuPG/UserAttribute.pm | 118 | ||||
| -rw-r--r-- | lib/GnuPG/UserId.pm | 148 |
14 files changed, 3367 insertions, 0 deletions
diff --git a/lib/GnuPG/Fingerprint.pm b/lib/GnuPG/Fingerprint.pm new file mode 100644 index 0000000..81c38a7 --- /dev/null +++ b/lib/GnuPG/Fingerprint.pm @@ -0,0 +1,93 @@ +# Fingerprint.pm +# - providing an object-oriented approach to GnuPG key fingerprints +# +# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org> +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: Fingerprint.pm,v 1.8 2001/08/21 13:31:50 ftobin Exp $ +# + +package GnuPG::Fingerprint; +use Moo; +use MooX::late; +with qw(GnuPG::HashInit); + +has as_hex_string => ( + isa => 'Any', + is => 'rw', +); + +sub compare { + my ($self, $other) = @_; + return 0 unless $other->isa('GnuPG::Fingerprint'); + return $self->as_hex_string() eq $other->as_hex_string(); +} + +# DEPRECATED +sub hex_data +{ + my ( $self, $v ) = @_; + $self->as_hex_string( $v ) if defined $v; + return $self->as_hex_string(); +} + +1; + +__END__ + +=head1 NAME + +GnuPG::Fingerprint - GnuPG Fingerprint Objects + +=head1 SYNOPSIS + + # assumes a GnuPG::Key in $key + my $fingerprint = $key->fingerprint->as_hex_string(); + +=head1 DESCRIPTION + +GnuPG::Fingerprint objects are generally part of GnuPG::Key +objects, and are not created on their own. + +=head1 OBJECT METHODS + +=head2 Initialization Methods + +=over 4 + +=item new( I<%initialization_args> ) + +This methods creates a new object. The optional arguments are +initialization of data members. + +=item hash_init( I<%args> ). + +=item compare( I<$other> ) + +Returns non-zero only when this fingerprint is identical to the other +GnuPG::Fingerprint. + +=back + +=head1 OBJECT DATA MEMBERS + +=over 4 + +=item as_hex_string + +This is the hex value of the fingerprint that the object embodies, +in string format. + +=back + +=head1 SEE ALSO + +L<GnuPG::Key>, + +=cut diff --git a/lib/GnuPG/Handles.pm b/lib/GnuPG/Handles.pm new file mode 100644 index 0000000..3eee0e3 --- /dev/null +++ b/lib/GnuPG/Handles.pm @@ -0,0 +1,185 @@ +# Handles.pm +# - interface to the handles used by GnuPG::Interface +# +# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org> +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: Handles.pm,v 1.8 2001/12/09 02:24:10 ftobin Exp $ +# + +package GnuPG::Handles; +use Moo; +use MooX::late; +with qw(GnuPG::HashInit); + +use constant HANDLES => qw( + stdin + stdout + stderr + status + logger + passphrase + command +); + +has "$_" => ( + isa => 'Any', + is => 'rw', + clearer => 'clear_' . $_, +) for HANDLES; + +has _options => ( + isa => 'HashRef', + is => 'rw', + lazy_build => 1, +); + +sub options { + my $self = shift; + my $key = shift; + + return $self->_options->{$key}; +} + +sub _build__options { {} } + +sub BUILD { + my ( $self, $args ) = @_; + + # This is done for the user's convenience so that they don't + # have to worry about undefined hashrefs + $self->_options->{$_} = {} for HANDLES; + $self->hash_init(%$args); +} + +1; + +=head1 NAME + +GnuPG::Handles - GnuPG handles bundle + +=head1 SYNOPSIS + + use IO::Handle; + my ( $stdin, $stdout, $stderr, + $status_fh, $logger_fh, $passphrase_fh, + ) + = ( IO::Handle->new(), IO::Handle->new(), IO::Handle->new(), + IO::Handle->new(), IO::Handle->new(), IO::Handle->new(), + ); + + my $handles = GnuPG::Handles->new + ( stdin => $stdin, + stdout => $stdout, + stderr => $stderr, + status => $status_fh, + logger => $logger_fh, + passphrase => $passphrase_fh, + ); + +=head1 DESCRIPTION + +GnuPG::Handles objects are generally instantiated +to be used in conjunction with methods of objects +of the class GnuPG::Interface. GnuPG::Handles objects +represent a collection of handles that are used to +communicate with GnuPG. + +=head1 OBJECT METHODS + +=head2 Initialization Methods + +=over 4 + +=item new( I<%initialization_args> ) + +This methods creates a new object. The optional arguments are +initialization of data members. + +=item hash_init( I<%args> ). + + +=back + +=head1 OBJECT DATA MEMBERS + +=over 4 + +=item stdin + +This handle is connected to the standard input of a GnuPG process. + +=item stdout + +This handle is connected to the standard output of a GnuPG process. + +=item stderr + +This handle is connected to the standard error of a GnuPG process. + +=item status + +This handle is connected to the status output handle of a GnuPG process. + +=item logger + +This handle is connected to the logger output handle of a GnuPG process. + +=item passphrase + +This handle is connected to the passphrase input handle of a GnuPG process. + +=item command + +This handle is connected to the command input handle of a GnuPG process. + +=item options + +This is a hash of hashrefs of settings pertaining to the handles +in this object. The outer-level hash is keyed by the names of the +handle the setting is for, while the inner is keyed by the setting +being referenced. For example, to set the setting C<direct> to true +for the filehandle C<stdin>, the following code will do: + + # assuming $handles is an already-created + # GnuPG::Handles object, this sets all + # options for the filehandle stdin in one blow, + # clearing out all others + $handles->options( 'stdin', { direct => 1 } ); + + # this is useful to just make one change + # to the set of options for a handle + $handles->options( 'stdin' )->{direct} = 1; + + # and to get the setting... + $setting = $handles->options( 'stdin' )->{direct}; + + # and to clear the settings for stdin + $handles->options( 'stdin', {} ); + +The currently-used settings are as follows: + +=over 4 + +=item direct + +If the setting C<direct> is true for a handle, the GnuPG +process spawned will access the handle directly. This is useful for +having the GnuPG process read or write directly to or from +an already-opened file. + +=back + +=back + +=head1 SEE ALSO + +L<GnuPG::Interface>, + +=cut diff --git a/lib/GnuPG/HashInit.pm b/lib/GnuPG/HashInit.pm new file mode 100644 index 0000000..a278b09 --- /dev/null +++ b/lib/GnuPG/HashInit.pm @@ -0,0 +1,12 @@ +package GnuPG::HashInit; +use Moo::Role; + +sub hash_init { + my ($self, %args) = @_; + while ( my ( $method, $value ) = each %args ) { + $self->$method($value); + } +} + +1; +__END__ diff --git a/lib/GnuPG/Interface.pm b/lib/GnuPG/Interface.pm new file mode 100644 index 0000000..13b313e --- /dev/null +++ b/lib/GnuPG/Interface.pm @@ -0,0 +1,1477 @@ +# Interface.pm +# - providing an object-oriented approach to interacting with GnuPG +# +# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org> +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# + +package GnuPG::Interface; +use Moo; +use MooX::late; +with qw(GnuPG::HashInit); + +use English qw( -no_match_vars ); +use Carp; +use Fcntl; +use vars qw( $VERSION ); +use Fatal qw( open close pipe fcntl ); +use Class::Struct; +use IO::Handle; + +use Math::BigInt try => 'GMP'; +use GnuPG::Options; +use GnuPG::Handles; +use Scalar::Util 'tainted'; + +$VERSION = '1.01'; + +has passphrase => ( + isa => 'Any', + is => 'rw', + clearer => 'clear_passphrase', +); + +has call => ( + isa => 'Any', + is => 'rw', + trigger => 1, + clearer => 'clear_call', +); + +# NB: GnuPG versions +# +# There are now two supported versions of GnuPG: legacy 1.4 and stable 2.2 +# They are detected and each behave slightly differently. +# +# When using features specific to branches, check that the system's +# version of gpg corresponds to the branch. +# +# legacy: 1.4 +# stable: >= 2.2 +# +# You can find examples of version comparison in the tests. +has version => ( + isa => 'Str', + is => 'ro', + reader => 'version', + writer => '_set_version', +); + +has options => ( + isa => 'GnuPG::Options', + is => 'rw', + lazy_build => 1, +); + +sub _build_options { GnuPG::Options->new() } + +# deprecated! +sub gnupg_call { shift->call(@_); } + +sub BUILD { + my ( $self, $args ) = @_; + $self->hash_init( call => 'gpg', %$args ); +} + +struct( + fh_setup => { + parent_end => '$', child_end => '$', + direct => '$', is_std => '$', + parent_is_source => '$', name_shows_dup => '$', + } +); + +# Update version if "call" is updated +sub _trigger_call { + my ( $self, $gpg ) = @_; + $self->_set_version( $self->_version() ); +} + +################################################################# +# real worker functions + +# This function does any 'extra' stuff that the user might +# not want to handle himself, such as passing in the passphrase +sub wrap_call( $% ) { + my ( $self, %args ) = @_; + + my $handles = $args{handles} + or croak 'error: no handles defined'; + + $handles->stdin('<&STDIN') unless $handles->stdin(); + $handles->stdout('>&STDOUT') unless $handles->stdout(); + $handles->stderr('>&STDERR') unless $handles->stderr(); + + $self->passphrase("\n") unless $self->passphrase(); + + my $needs_passphrase_handled + = ( $self->passphrase() =~ m/\S/ and not $handles->passphrase() ) ? 1 : 0; + + if ($needs_passphrase_handled) { + $handles->passphrase( IO::Handle->new() ); + } + + my $pid = $self->fork_attach_exec(%args); + + if ($needs_passphrase_handled) { + my $passphrase_handle = $handles->passphrase(); + print $passphrase_handle $self->passphrase(); + close $passphrase_handle; + + # We put this in in case the user wants to re-use this object + $handles->clear_passphrase(); + } + + return $pid; +} + +# does does command-line creation, forking, and execcing +# the reasing cli creation is done here is because we should +# fork before finding the fd's for stuff like --status-fd +sub fork_attach_exec( $% ) { + my ( $self, %args ) = @_; + + my $handles = $args{handles} or croak 'no GnuPG::Handles passed'; + my $use_loopback_pinentry = 0; + + # Don't use loopback pintentry for legacy (1.4) GPG + # + # Check that $version is populated before running cmp_version. If + # we are invoked as part of BUILD to populate $version, then any + # methods that depend on $version will fail. We don't care about + # loopback when we're called just to check gpg version. + $use_loopback_pinentry = 1 + if ($handles->passphrase() && $self->version && $self->cmp_version($self->version, '2.2') > 0 ); + + # deprecation support + $args{commands} ||= $args{gnupg_commands}; + + my @commands + = ref $args{commands} ? @{ $args{commands} } : ( $args{commands} ) + or croak "no gnupg commands passed"; + + # deprecation support + $args{command_args} ||= $args{gnupg_command_args}; + + my @command_args + = ref $args{command_args} + ? @{ $args{command_args} } + : ( $args{command_args} || () ); + unshift @command_args, "--" + if @command_args and $command_args[0] ne "--"; + + my %fhs; + foreach my $fh_name ( + qw( stdin stdout stderr status + logger passphrase command + ) + ) { + my $fh = $handles->$fh_name() or next; + $fhs{$fh_name} = fh_setup->new(); + $fhs{$fh_name}->parent_end($fh); + } + + foreach my $fh_name (qw( stdin stdout stderr )) { + $fhs{$fh_name}->is_std(1); + } + + foreach my $fh_name (qw( stdin passphrase command )) { + my $entry = $fhs{$fh_name} or next; + $entry->parent_is_source(1); + } + + # Below is code derived heavily from + # Marc Horowitz's IPC::Open3, a base Perl module + foreach my $fh_name ( keys %fhs ) { + my $entry = $fhs{$fh_name}; + + my $parent_end = $entry->parent_end(); + my $name_shows_dup = ( $parent_end =~ s/^[<>]&// ); + $entry->parent_end($parent_end); + + $entry->name_shows_dup($name_shows_dup); + + $entry->direct( $name_shows_dup + || $handles->options($fh_name)->{direct} + || 0 ); + } + + foreach my $fh_name ( keys %fhs ) { + $fhs{$fh_name}->child_end( IO::Handle->new() ); + } + + foreach my $fh_name ( keys %fhs ) { + my $entry = $fhs{$fh_name}; + next if $entry->direct(); + + my $reader_end; + my $writer_end; + if ( $entry->parent_is_source() ) { + $reader_end = $entry->child_end(); + $writer_end = $entry->parent_end(); + } + else { + $reader_end = $entry->parent_end(); + $writer_end = $entry->child_end(); + } + + pipe $reader_end, $writer_end; + } + + my $pid = fork; + + die "fork failed: $ERRNO" unless defined $pid; + + if ( $pid == 0 ) # child + { + + # these are for safety later to help lessen autovifying, + # speed things up, and make the code smaller + my $stdin = $fhs{stdin}; + my $stdout = $fhs{stdout}; + my $stderr = $fhs{stderr}; + + # Paul Walmsley says: + # Perl 5.6's POSIX.pm has a typo in it that prevents us from + # importing STDERR_FILENO. So we resort to requiring it. + require POSIX; + + my $standard_out + = IO::Handle->new_from_fd( &POSIX::STDOUT_FILENO, 'w' ); + my $standard_in + = IO::Handle->new_from_fd( &POSIX::STDIN_FILENO, 'r' ); + + # Paul Walmsley says: + # this mess is due to a typo in POSIX.pm on Perl 5.6 + my $stderr_fd = eval {&POSIX::STDERR_FILENO}; + $stderr_fd = 2 unless defined $stderr_fd; + my $standard_err = IO::Handle->new_from_fd( $stderr_fd, 'w' ); + + # If she wants to dup the kid's stderr onto her stdout I need to + # save a copy of her stdout before I put something else there. + if ( $stdout->parent_end() ne $stderr->parent_end() + and $stderr->direct() + and my_fileno( $stderr->parent_end() ) + == my_fileno($standard_out) ) { + my $tmp = IO::Handle->new(); + open $tmp, '>&' . my_fileno( $stderr->parent_end() ); + $stderr->parent_end($tmp); + } + + if ( $stdin->direct() ) { + open $standard_in, '<&' . my_fileno( $stdin->parent_end() ) + unless my_fileno($standard_in) + == my_fileno( $stdin->parent_end() ); + } + else { + close $stdin->parent_end(); + open $standard_in, '<&=' . my_fileno( $stdin->child_end() ); + } + + if ( $stdout->direct() ) { + open $standard_out, '>&' . my_fileno( $stdout->parent_end() ) + unless my_fileno($standard_out) + == my_fileno( $stdout->parent_end() ); + } + else { + close $stdout->parent_end(); + open $standard_out, '>&=' . my_fileno( $stdout->child_end() ); + } + + if ( $stdout->parent_end() ne $stderr->parent_end() ) { + + # I have to use a fileno here because in this one case + # I'm doing a dup but the filehandle might be a reference + # (from the special case above). + if ( $stderr->direct() ) { + open $standard_err, '>&' . my_fileno( $stderr->parent_end() ) + unless my_fileno($standard_err) + == my_fileno( $stderr->parent_end() ); + } + else { + close $stderr->parent_end(); + open $standard_err, '>&=' . my_fileno( $stderr->child_end() ); + } + } + else { + open $standard_err, '>&STDOUT' + unless my_fileno($standard_err) == my_fileno($standard_out); + } + + foreach my $fh_name ( keys %fhs ) { + my $entry = $fhs{$fh_name}; + next if $entry->is_std(); + + my $parent_end = $entry->parent_end(); + my $child_end = $entry->child_end(); + + if ( $entry->direct() ) { + if ( $entry->name_shows_dup() ) { + my $open_prefix + = $entry->parent_is_source() ? '<&' : '>&'; + open $child_end, $open_prefix . $parent_end; + } + else { + $child_end = $parent_end; + $entry->child_end($child_end); + } + } + else { + close $parent_end; + } + + # we want these fh's to stay open after the exec + fcntl $child_end, F_SETFD, 0; + + # now set the options for the call to GnuPG + my $fileno = my_fileno($child_end); + my $option = $fh_name . '_fd'; + $self->options->$option($fileno); + } + + my @args = $self->options->get_args(); + push @args, '--pinentry-mode', 'loopback' + if $use_loopback_pinentry; + + my @command = ( + $self->call(), @args, + @commands, @command_args + ); + + local $ENV{PATH} if tainted $ENV{PATH}; + exec @command or die "exec() error: $ERRNO"; + } + + # parent + + # close the child end of any pipes (non-direct stuff) + foreach my $fh_name ( keys %fhs ) { + my $entry = $fhs{$fh_name}; + close $entry->child_end() unless $entry->direct(); + } + + foreach my $fh_name ( keys %fhs ) { + my $entry = $fhs{$fh_name}; + next unless $entry->parent_is_source(); + + my $parent_end = $entry->parent_end(); + + # close any writing handles if they were a dup + #any real reason for this? It bombs if we're doing + #the automagic >& stuff. + #close $parent_end if $entry->direct(); + + # unbuffer pipes + select( ( select($parent_end), $OUTPUT_AUTOFLUSH = 1 )[0] ) + if $parent_end; + } + + return $pid; +} + +sub my_fileno { + no strict 'refs'; + my ($fh) = @_; + croak "fh is undefined" unless defined $fh; + return $1 if $fh =~ /^=?(\d+)$/; # is it a fd in itself? + my $fileno = fileno $fh; + croak "error determining fileno for $fh: $ERRNO" unless defined $fileno; + return $fileno; +} + + +sub unescape_string { + my($str) = splice(@_); + $str =~ s/\\x(..)/chr(hex($1))/eg; + return $str; +} + +################################################################### + +sub get_public_keys ( $@ ) { + my ( $self, @key_ids ) = @_; + + return $self->get_keys( + commands => ['--list-public-keys'], + command_args => [@key_ids], + ); +} + +sub get_secret_keys ( $@ ) { + my ( $self, @key_ids ) = @_; + + return $self->get_keys( + commands => ['--list-secret-keys'], + command_args => [@key_ids], + ); +} + +sub get_public_keys_with_sigs ( $@ ) { + my ( $self, @key_ids ) = @_; + + return $self->get_keys( + commands => ['--check-sigs'], + command_args => [@key_ids], + ); +} + +sub get_keys { + my ( $self, %args ) = @_; + + my $saved_options = $self->options(); + my $new_options = $self->options->copy(); + $self->options($new_options); + $self->options->push_extra_args( + '--with-colons', + '--fixed-list-mode', + '--with-fingerprint', + '--with-fingerprint', + '--with-key-data', + ); + + my $stdin = IO::Handle->new(); + my $stdout = IO::Handle->new(); + + my $handles = GnuPG::Handles->new( + stdin => $stdin, + stdout => $stdout, + ); + + my $pid = $self->wrap_call( + handles => $handles, + %args, + ); + + my @returned_keys; + my $current_primary_key; + my $current_signed_item; + my $current_key; + + require GnuPG::PublicKey; + require GnuPG::SecretKey; + require GnuPG::SubKey; + require GnuPG::Fingerprint; + require GnuPG::UserId; + require GnuPG::UserAttribute; + require GnuPG::Signature; + require GnuPG::Revoker; + + while (<$stdout>) { + my $line = $_; + chomp $line; + my @fields = split ':', $line, -1; + next unless @fields > 3; + + my $record_type = $fields[0]; + + if ( $record_type eq 'pub' or $record_type eq 'sec' ) { + push @returned_keys, $current_primary_key + if $current_primary_key; + + my ( + $user_id_validity, $key_length, $algo_num, $hex_key_id, + $creation_date, $expiration_date, + $local_id, $owner_trust, $user_id_string, + $sigclass, #unused + $usage_flags, + ) = @fields[ 1 .. $#fields ]; + + # --fixed-list-mode uses epoch time for creation and expiration date strings. + # For backward compatibility, we convert them back using GMT; + my $expiration_date_string; + if ($expiration_date eq '') { + $expiration_date = undef; + } else { + $expiration_date_string = $self->_downrez_date($expiration_date); + } + my $creation_date_string = $self->_downrez_date($creation_date); + + $current_primary_key = $current_key + = $record_type eq 'pub' + ? GnuPG::PublicKey->new() + : GnuPG::SecretKey->new(); + + $current_primary_key->hash_init( + length => $key_length, + algo_num => $algo_num, + hex_id => $hex_key_id, + local_id => $local_id, + owner_trust => $owner_trust, + creation_date => $creation_date, + expiration_date => $expiration_date, + creation_date_string => $creation_date_string, + expiration_date_string => $expiration_date_string, + usage_flags => $usage_flags, + ); + + $current_signed_item = $current_primary_key; + } + elsif ( $record_type eq 'fpr' ) { + my $hex = $fields[9]; + my $f = GnuPG::Fingerprint->new( as_hex_string => $hex ); + $current_key->fingerprint($f); + } + elsif ( $record_type eq 'sig' or + $record_type eq 'rev' + ) { + my ( + $validity, + $algo_num, $hex_key_id, + $signature_date, + $expiration_date, + $user_id_string, + $sig_type, + ) = @fields[ 1, 3 .. 6, 9, 10 ]; + + my $expiration_date_string; + if ($expiration_date eq '') { + $expiration_date = undef; + } else { + $expiration_date_string = $self->_downrez_date($expiration_date); + } + my $signature_date_string = $self->_downrez_date($signature_date); + + my ($sig_class, $is_exportable); + if ($sig_type =~ /^([[:xdigit:]]{2})([xl])$/ ) { + $sig_class = hex($1); + $is_exportable = ('x' eq $2); + } + + my $signature = GnuPG::Signature->new( + validity => $validity, + algo_num => $algo_num, + hex_id => $hex_key_id, + date => $signature_date, + date_string => $signature_date_string, + expiration_date => $expiration_date, + expiration_date_string => $expiration_date_string, + user_id_string => unescape_string($user_id_string), + sig_class => $sig_class, + is_exportable => $is_exportable, + ); + + if ( $current_signed_item->isa('GnuPG::Key') || + $current_signed_item->isa('GnuPG::UserId') || + $current_signed_item->isa('GnuPG::Revoker') || + $current_signed_item->isa('GnuPG::UserAttribute')) { + if ($record_type eq 'sig') { + $current_signed_item->push_signatures($signature); + } elsif ($record_type eq 'rev') { + $current_signed_item->push_revocations($signature); + } + } else { + warn "do not know how to handle signature line: $line\n"; + } + } + elsif ( $record_type eq 'uid' ) { + my ( $validity, $user_id_string ) = @fields[ 1, 9 ]; + + $current_signed_item = GnuPG::UserId->new( + validity => $validity, + as_string => unescape_string($user_id_string), + ); + + $current_primary_key->push_user_ids($current_signed_item); + } + elsif ( $record_type eq 'uat' ) { + my ( $validity, $subpacket ) = @fields[ 1, 9 ]; + + my ( $subpacket_count, $subpacket_total_size ) = split(/ /,$subpacket); + + $current_signed_item = GnuPG::UserAttribute->new( + validity => $validity, + subpacket_count => $subpacket_count, + subpacket_total_size => $subpacket_total_size, + ); + + $current_primary_key->push_user_attributes($current_signed_item); + } + elsif ( $record_type eq 'sub' or $record_type eq 'ssb' ) { + my ( + $validity, $key_length, $algo_num, $hex_id, + $creation_date, $expiration_date, + $local_id, + $dummy0, $dummy1, $dummy2, #unused + $usage_flags, + ) = @fields[ 1 .. 11 ]; + + my $expiration_date_string; + if ($expiration_date eq '') { + $expiration_date = undef; + } else { + $expiration_date_string = $self->_downrez_date($expiration_date); + } + my $creation_date_string = $self->_downrez_date($creation_date); + + $current_signed_item = $current_key + = GnuPG::SubKey->new( + validity => $validity, + length => $key_length, + algo_num => $algo_num, + hex_id => $hex_id, + creation_date => $creation_date, + expiration_date => $expiration_date, + creation_date_string => $creation_date_string, + expiration_date_string => $expiration_date_string, + local_id => $local_id, + usage_flags => $usage_flags, + ); + + $current_primary_key->push_subkeys($current_signed_item); + } + elsif ($record_type eq 'rvk') { + my ($algo_num, $fpr, $class) = @fields[ 3,9,10 ]; + my $rvk = GnuPG::Revoker->new( + fingerprint => GnuPG::Fingerprint->new( as_hex_string => $fpr ), + algo_num => ($algo_num + 0), + class => hex($class), + ); + # pushing to either primary key or subkey, to handle + # designated revokers to the subkeys too: + $current_key->push_revokers($rvk); + # revokers should be bound to the key with signatures: + $current_signed_item = $rvk; + } + elsif ($record_type eq 'pkd') { + my ($pos, $size, $data) = @fields[ 1,2,3 ]; + $current_key->pubkey_data->[$pos+0] = Math::BigInt->from_hex('0x'.$data); + } + elsif ( $record_type ne 'tru' and $record_type ne 'grp' ) { + warn "unknown record type $record_type"; + } + } + + waitpid $pid, 0; + + push @returned_keys, $current_primary_key + if $current_primary_key; + + $self->options($saved_options); + + return @returned_keys; +} + +sub _downrez_date { + my $self = shift; + my $date = shift; + if ($date =~ /^\d+$/) { + my ($year,$month,$day) = (gmtime($date))[5,4,3]; + $year += 1900; + $month += 1; + return sprintf('%04d-%02d-%02d', $year, $month, $day); + } + return $date; +} + + +################################################################ + +sub list_public_keys { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--list-public-keys'], + ); +} + +sub list_sigs { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--list-sigs'], + ); +} + +sub list_secret_keys { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--list-secret-keys'], + ); +} + +sub encrypt( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--encrypt'] + ); +} + +sub encrypt_symmetrically( $% ) { + my ( $self, %args ) = @_; + # Strip the homedir and put it back after encrypting; + my $homedir = $self->options->homedir; + $self->options->clear_homedir + unless $self->cmp_version($self->version, '2.2') >= 0; + my $pid = $self->wrap_call( + %args, + commands => ['--symmetric'] + ); + $self->options->homedir($homedir) + unless $self->cmp_version($self->version, '2.2') >= 0; + return $pid; +} + +sub sign( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--sign'] + ); +} + +sub clearsign( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args,, + commands => ['--clearsign'] + ); +} + +sub detach_sign( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--detach-sign'] + ); +} + +sub sign_and_encrypt( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => [ + '--sign', + '--encrypt' + ] + ); +} + +sub decrypt( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--decrypt'] + ); +} + +sub verify( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--verify'] + ); +} + +sub import_keys( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--import'] + ); +} + +sub export_keys( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--export'] + ); +} + +sub recv_keys( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--recv-keys'] + ); +} + +sub send_keys( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--send-keys'] + ); +} + +sub search_keys( $% ) { + my ( $self, %args ) = @_; + return $self->wrap_call( + %args, + commands => ['--search-keys'] + ); +} + +sub _version { + my ( $self ) = @_; + + my $out = IO::Handle->new; + my $handles = GnuPG::Handles->new( stdout => $out ); + my $pid = $self->wrap_call( commands => [ '--no-options', '--version' ], handles => $handles ); + my $line = $out->getline; + $line =~ /(\d+\.\d+\.\d+)/; + + my $version = $1; + unless ($self->cmp_version($version, '2.2') >= 0 or + ($self->cmp_version($version, '1.4') >= 0 and $self->cmp_version($version, '1.5') < 0 )) { + croak "GnuPG Version 1.4 or 2.2+ required"; + } + waitpid $pid, 0; + + return $version; +} + +sub cmp_version($$) { + my ( $self, $a, $b ) = (@_); + my @a = split '\.', $a; + my @b = split '\.', $b; + @a > @b + ? push @b, (0) x (@a-@b) + : push @a, (0) x (@b-@a); + for ( my $i = 0; $i < @a; $i++ ) { + return $a[$i] <=> $b[$i] if $a[$i] <=> $b[$i]; + } + return 0; +} + +sub test_default_key_passphrase() { + my ($self) = @_; + + # We can't do something like let the user pass + # in a passphrase handle because we don't exist + # anymore after the user runs off with the + # attachments + croak 'No passphrase defined to test!' + unless defined $self->passphrase(); + + 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 + ); + + # save this setting since we need to be in non-interactive mode + my $saved_meta_interactive_option = $self->options->meta_interactive(); + $self->options->clear_meta_interactive(); + + my $pid = $self->sign( handles => $handles ); + + close $stdin; + + # restore this setting to its original setting + $self->options->meta_interactive($saved_meta_interactive_option); + + # all we realy want to check is the status fh + while (<$status>) { + if (/^\[GNUPG:\]\s*(GOOD_PASSPHRASE|SIG_CREATED)/) { + waitpid $pid, 0; + return 1; + } + } + + # If we didn't catch the regexp above, we'll assume + # that the passphrase was incorrect + waitpid $pid, 0; + return 0; +} + +1; + +############################################################## + +=head1 NAME + +GnuPG::Interface - Perl interface to GnuPG + +=head1 SYNOPSIS + + # A simple example + use IO::Handle; + use GnuPG::Interface; + + # setting up the situation + my $gnupg = GnuPG::Interface->new(); + $gnupg->options->hash_init( armor => 1, + homedir => '/home/foobar' ); + + # Note you can set the recipients even if you aren't encrypting! + $gnupg->options->push_recipients( 'ftobin@cpan.org' ); + $gnupg->options->meta_interactive( 0 ); + + # how we create some handles to interact with GnuPG + my $input = IO::Handle->new(); + my $output = IO::Handle->new(); + my $handles = GnuPG::Handles->new( stdin => $input, + stdout => $output ); + + # Now we'll go about encrypting with the options already set + my @plaintext = ( 'foobar' ); + my $pid = $gnupg->encrypt( handles => $handles ); + + # Now we write to the input of GnuPG + print $input @plaintext; + close $input; + + # now we read the output + my @ciphertext = <$output>; + close $output; + + waitpid $pid, 0; + +=head1 DESCRIPTION + +GnuPG::Interface and its associated modules are designed to +provide an object-oriented method for interacting with GnuPG, +being able to perform functions such as but not limited +to encrypting, signing, +decryption, verification, and key-listing parsing. + +=head2 How Data Member Accessor Methods are Created + +Each module in the GnuPG::Interface bundle relies +on Moo to generate the get/set methods +used to set the object's data members. +I<This is very important to realize.> This means that +any data member which is a list has special +methods assigned to it for pushing, popping, and +clearing the list. + +=head2 Understanding Bidirectional Communication + +It is also imperative to realize that this package +uses interprocess communication methods similar to +those used in L<IPC::Open3> +and L<perlipc/"Bidirectional Communication with Another Process">, +and that users of this package +need to understand how to use this method because this package +does not abstract these methods for the user greatly. +This package is not designed +to abstract this away entirely (partly for security purposes), but rather +to simply help create 'proper', clean calls to GnuPG, and to implement +key-listing parsing. +Please see L<perlipc/"Bidirectional Communication with Another Process"> +to learn how to deal with these methods. + +Using this package to do message processing generally +invovlves creating a GnuPG::Interface object, creating +a GnuPG::Handles object, +setting some options in its B<options> data member, +and then calling a method which invokes GnuPG, such as +B<clearsign>. One then interacts with with the handles +appropriately, as described in +L<perlipc/"Bidirectional Communication with Another Process">. + +=head1 GnuPG Versions + +As of this version of GnuPG::Interface, there are two supported +versions of GnuPG: 1.4.x and 2.2.x. The +L<GnuPG download page|https://gnupg.org/download/index.html> has +updated information on the currently supported versions. + +GnuPG released 2.0 and 2.1 versions in the past and some packaging +systems may still provide these if you install the default C<gpg>, +C<gnupg>, C<gnupg2>, etc. packages. This modules supports only +version 2.2.x, so you may need to find additional package +repositories or build from source to get the updated version. + +=head1 OBJECT METHODS + +=head2 Initialization Methods + +=over 4 + +=item new( I<%initialization_args> ) + +This methods creates a new object. The optional arguments are +initialization of data members. + +=item hash_init( I<%args> ). + + +=back + +=head2 Object Methods which use a GnuPG::Handles Object + +=over 4 + +=item list_public_keys( % ) + +=item list_sigs( % ) + +=item list_secret_keys( % ) + +=item encrypt( % ) + +=item encrypt_symmetrically( % ) + +=item sign( % ) + +=item clearsign( % ) + +=item detach_sign( % ) + +=item sign_and_encrypt( % ) + +=item decrypt( % ) + +=item verify( % ) + +=item import_keys( % ) + +=item export_keys( % ) + +=item recv_keys( % ) + +=item send_keys( % ) + +=item search_keys( % ) + +These methods each correspond directly to or are very similar +to a GnuPG command described in L<gpg>. Each of these methods +takes a hash, which currently must contain a key of B<handles> +which has the value of a GnuPG::Handles object. +Another optional key is B<command_args> which should have the value of an +array reference; these arguments will be passed to GnuPG as command arguments. +These command arguments are used for such things as determining the keys to +list in the B<export_keys> method. I<Please note that GnuPG command arguments +are not the same as GnuPG options>. To understand what are options and +what are command arguments please read L<gpg/"COMMANDS"> and L<gpg/"OPTIONS">. + +Each of these calls returns the PID for the resulting GnuPG process. +One can use this PID in a C<waitpid> call instead of a C<wait> call +if more precise process reaping is needed. + +These methods will attach the handles specified in the B<handles> object +to the running GnuPG object, so that bidirectional communication +can be established. That is, the optionally-defined B<stdin>, +B<stdout>, B<stderr>, B<status>, B<logger>, and +B<passphrase> handles will be attached to +GnuPG's input, output, standard error, +the handle created by setting B<status-fd>, the handle created by setting B<logger-fd>, and the handle created by setting +B<passphrase-fd> respectively. +This tying of handles of similar to the process +done in I<IPC::Open3>. + +If you want the GnuPG process to read or write directly to an already-opened +filehandle, you cannot do this via the normal I<IPC::Open3> mechanisms. +In order to accomplish this, set the appropriate B<handles> data member +to the already-opened filehandle, and then set the option B<direct> to be true +for that handle, as described in L<GnuPG::Handles/options>. For example, +to have GnuPG read from the file F<input.txt> and write to F<output.txt>, +the following snippet may do: + + my $infile = IO::File->new( 'input.txt' ); + my $outfile = IO::File->new( '>output.txt' ); + my $handles = GnuPG::Handles->new( stdin => $infile, + stdout => $outfile, + ); + $handles->options( 'stdin' )->{direct} = 1; + $handles->options( 'stdout' )->{direct} = 1; + +If any handle in the B<handles> object is not defined, GnuPG's input, output, +and standard error will be tied to the running program's standard error, +standard output, or standard error. If the B<status> or B<logger> handle +is not defined, this channel of communication is never established with GnuPG, +and so this information is not generated and does not come into play. + +If the B<passphrase> data member handle of the B<handles> object +is not defined, but the the B<passphrase> data member handle of GnuPG::Interface +object is, GnuPG::Interface will handle passing this information into GnuPG +for the user as a convenience. Note that this will result in +GnuPG::Interface storing the passphrase in memory, instead of having +it simply 'pass-through' to GnuPG via a handle. + +If neither the B<passphrase> data member of the GnuPG::Interface nor +the B<passphrase> data member of the B<handles> object is defined, +then GnuPG::Interface assumes that access and control over the secret +key will be handled by the running gpg-agent process. This represents +the simplest mode of operation with the GnuPG "stable" suite (version +2.2 and later). It is also the preferred mode for tools intended to +be user-facing, since the user will be prompted directly by gpg-agent +for use of the secret key material. Note that for programmatic use, +this mode requires the gpg-agent and pinentry to already be correctly +configured. + +=back + +=head2 Other Methods + +=over 4 + +=item get_public_keys( @search_strings ) + +=item get_secret_keys( @search_strings ) + +=item get_public_keys_with_sigs( @search_strings ) + +These methods create and return objects of the type GnuPG::PublicKey +or GnuPG::SecretKey respectively. This is done by parsing the output +of GnuPG with the option B<with-colons> enabled. The objects created +do or do not have signature information stored in them, depending +if the method ends in I<_sigs>; this separation of functionality is there +because of performance hits when listing information with signatures. + +=item test_default_key_passphrase() + +This method will return a true or false value, depending +on whether GnuPG reports a good passphrase was entered +while signing a short message using the values of +the B<passphrase> data member, and the default +key specified in the B<options> data member. + +=item version() + +Returns the version of GnuPG that GnuPG::Interface is running. + +=back + + +=head1 Invoking GnuPG with a custom call + +GnuPG::Interface attempts to cover a lot of the commands +of GnuPG that one would want to perform; however, there may be a lot +more calls that GnuPG is and will be capable of, so a generic command +interface is provided, C<wrap_call>. + +=over 4 + +=item wrap_call( %args ) + +Call GnuPG with a custom command. The %args hash must contain +at least the following keys: + +=over 4 + +=item commands + +The value of this key in the hash must be a reference to a a list of +commands for GnuPG, such as C<[ qw( --encrypt --sign ) ]>. + +=item handles + +As with most other GnuPG::Interface methods, B<handles> +must be a GnuPG::Handles object. + +=back + +The following keys are optional. + +=over 4 + +=item command_args + +As with other GnuPG::Interface methods, the value in hash +for this key must be a reference to a list of arguments +to be passed to the GnuPG command, such as which +keys to list in a key-listing. + +=back + +=back + + +=head1 OBJECT DATA MEMBERS + +=over 4 + +=item call + +This defines the call made to invoke GnuPG. Defaults to 'gpg'; this +should be changed if 'gpg' is not in your path, or there is a different +name for the binary on your system. + +=item passphrase + +In order to lessen the burden of using handles by the user of this package, +setting this option to one's passphrase for a secret key will allow +the package to enter the passphrase via a handle to GnuPG by itself +instead of leaving this to the user. See also L<GnuPG::Handles/passphrase>. + +=item options + +This data member, of the type GnuPG::Options; the setting stored in this +data member are used to determine the options used when calling GnuPG +via I<any> of the object methods described in this package. +See L<GnuPG::Options> for more information. + +=back + +=head1 EXAMPLES + +The following setup can be done before any of the following examples: + + use IO::Handle; + use GnuPG::Interface; + + my @original_plaintext = ( "How do you doo?" ); + my $passphrase = "Three Little Pigs"; + + my $gnupg = GnuPG::Interface->new(); + + $gnupg->options->hash_init( armor => 1, + recipients => [ 'ftobin@uiuc.edu', + '0xABCD1234ABCD1234ABCD1234ABCD1234ABCD1234' ], + meta_interactive => 0 , + ); + + $gnupg->options->debug_level(4); + + $gnupg->options->logger_file("/tmp/gnupg-$$-decrypt-".time().".log"); + + +=head2 Encrypting + + # We'll let the standard error of GnuPG pass through + # to our own standard error, by not creating + # a stderr-part of the $handles object. + my ( $input, $output ) = ( IO::Handle->new(), + IO::Handle->new() ); + + my $handles = GnuPG::Handles->new( stdin => $input, + stdout => $output ); + + # this sets up the communication + # Note that the recipients were specified earlier + # in the 'options' data member of the $gnupg object. + my $pid = $gnupg->encrypt( handles => $handles ); + + # this passes in the plaintext + print $input @original_plaintext; + + # this closes the communication channel, + # indicating we are done + close $input; + + my @ciphertext = <$output>; # reading the output + + waitpid $pid, 0; # clean up the finished GnuPG process + +=head2 Signing + + # This time we'll catch the standard error for our perusing + my ( $input, $output, $error ) = ( IO::Handle->new(), + IO::Handle->new(), + IO::Handle->new(), + ); + + my $handles = GnuPG::Handles->new( stdin => $input, + stdout => $output, + stderr => $error, + ); + + # indicate our pasphrase through the + # convenience method + $gnupg->passphrase( $passphrase ); + + # this sets up the communication + my $pid = $gnupg->sign( handles => $handles ); + + # this passes in the plaintext + print $input @original_plaintext; + + # this closes the communication channel, + # indicating we are done + close $input; + + my @ciphertext = <$output>; # reading the output + my @error_output = <$error>; # reading the error + + close $output; + close $error; + + waitpid $pid, 0; # clean up the finished GnuPG process + +=head2 Decryption + + # This time we'll catch the standard error for our perusing + # as well as passing in the passphrase manually + # as well as the status information given by GnuPG + my ( $input, $output, $error, $passphrase_fh, $status_fh ) + = ( IO::Handle->new(), + IO::Handle->new(), + IO::Handle->new(), + IO::Handle->new(), + IO::Handle->new(), + ); + + my $handles = GnuPG::Handles->new( stdin => $input, + stdout => $output, + stderr => $error, + passphrase => $passphrase_fh, + status => $status_fh, + ); + + # this time we'll also demonstrate decrypting + # a file written to disk + # Make sure you "use IO::File" if you use this module! + my $cipher_file = IO::File->new( 'encrypted.gpg' ); + + # this sets up the communication + my $pid = $gnupg->decrypt( handles => $handles ); + + # This passes in the passphrase + print $passphrase_fh $passphrase; + close $passphrase_fh; + + # this passes in the plaintext + print $input $_ while <$cipher_file>; + + # this closes the communication channel, + # indicating we are done + close $input; + close $cipher_file; + + my @plaintext = <$output>; # reading the output + my @error_output = <$error>; # reading the error + my @status_info = <$status_fh>; # read the status info + + # clean up... + close $output; + close $error; + close $status_fh; + + waitpid $pid, 0; # clean up the finished GnuPG process + +=head2 Printing Keys + + # This time we'll just let GnuPG print to our own output + # and read from our input, because no input is needed! + my $handles = GnuPG::Handles->new(); + + my @ids = ( 'ftobin', '0xABCD1234ABCD1234ABCD1234ABCD1234ABCD1234' ); + + # this time we need to specify something for + # command_args because --list-public-keys takes + # search ids as arguments + my $pid = $gnupg->list_public_keys( handles => $handles, + command_args => [ @ids ] ); + + waitpid $pid, 0; + +=head2 Creating GnuPG::PublicKey Objects + + my @ids = [ 'ftobin', '0xABCD1234ABCD1234ABCD1234ABCD1234ABCD1234' ]; + + my @keys = $gnupg->get_public_keys( @ids ); + + # no wait is required this time; it's handled internally + # since the entire call is encapsulated + +=head2 Custom GnuPG call + + # assuming $handles is a GnuPG::Handles object + my $pid = $gnupg->wrap_call + ( commands => [ qw( --list-packets ) ], + command_args => [ qw( test/key.1.asc ) ], + handles => $handles, + ); + + my @out = <$handles->stdout()>; + waitpid $pid, 0; + + +=head1 FAQ + +=over 4 + +=item How do I get GnuPG::Interface to read/write directly from +a filehandle? + +You need to set GnuPG::Handles B<direct> option to be true for the +filehandles in concern. See L<GnuPG::Handles/options> and +L<"Object Methods which use a GnuPG::Handles Object"> for more +information. + +=item Why do you make it so difficult to get GnuPG to write/read +from a filehandle? In the shell, I can just call GnuPG +with the --outfile option! + +There are lots of issues when trying to tell GnuPG to read/write +directly from a file, such as if the file isn't there, or +there is a file, and you want to write over it! What do you +want to happen then? Having the user of this module handle +these questions beforehand by opening up filehandles to GnuPG +lets the user know fully what is going to happen in these circumstances, +and makes the module less error-prone. + +=item When having GnuPG process a large message, sometimes it just +hanges there. + +Your problem may be due to buffering issues; when GnuPG reads/writes +to B<non-direct> filehandles (those that are sent to filehandles +which you read to from into memory, not that those access the disk), +buffering issues can mess things up. I recommend looking into +L<GnuPG::Handles/options>. + +=back + +=head1 NOTES + +This package is the successor to PGP::GPG::MessageProcessor, +which I found to be too inextensible to carry on further. +A total redesign was needed, and this is the resulting +work. + +After any call to a GnuPG-command method of GnuPG::Interface +in which one passes in the handles, +one should all B<wait> to clean up GnuPG from the process table. + + +=head1 BUGS + +=head2 Large Amounts of Data + +Currently there are problems when transmitting large quantities +of information over handles; I'm guessing this is due +to buffering issues. This bug does not seem specific to this package; +IPC::Open3 also appears affected. + +=head2 OpenPGP v3 Keys + +I don't know yet how well this module handles parsing OpenPGP v3 keys. + +=head2 RHEL 7 Test Failures + +Testing with the updates for version 1.00 we saw intermittent test failures +on RHEL 7 with GnuPG version 2.2.20. In some cases the tests would all pass +for several runs, then one would fail. We're unable to reliably reproduce +this so we would be interested in feedback from other users. + +=head1 SEE ALSO + +L<GnuPG::Options>, +L<GnuPG::Handles>, +L<GnuPG::PublicKey>, +L<GnuPG::SecretKey>, +L<gpg>, +L<perlipc/"Bidirectional Communication with Another Process"> + +=head1 LICENSE + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=head1 AUTHOR + +GnuPG::Interface is currently maintained by Best Practical Solutions <BPS@cpan.org>. + +Frank J. Tobin, ftobin@cpan.org was the original author of the package. + +=cut + +1; + diff --git a/lib/GnuPG/Key.pm b/lib/GnuPG/Key.pm new file mode 100644 index 0000000..e8d743b --- /dev/null +++ b/lib/GnuPG/Key.pm @@ -0,0 +1,274 @@ +# Key.pm +# - providing an object-oriented approach to GnuPG keys +# +# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org> +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: Key.pm,v 1.10 2001/12/10 01:29:27 ftobin Exp $ +# + +package GnuPG::Key; +use Moo; +use MooX::late; +with qw(GnuPG::HashInit); + +has [ + qw( length + algo_num + hex_id + hex_data + creation_date + expiration_date + creation_date_string + expiration_date_string + fingerprint + usage_flags + ) + ] => ( + isa => 'Any', + is => 'rw', + ); + +has [ + qw( + signatures + revokers + revocations + pubkey_data + )] => ( + isa => 'ArrayRef', + is => 'rw', + default => sub { [] }, +); + +sub push_signatures { + my $self = shift; + push @{ $self->signatures }, @_; +} + +sub push_revocations { + my $self = shift; + push @{ $self->revocations }, @_; +} + +sub push_revokers { + my $self = shift; + push @{ $self->revokers }, @_; +} + +sub short_hex_id { + my ($self) = @_; + return substr $self->hex_id(), -8; +} + +sub compare { + my ($self, $other, $deep) = @_; + + my @string_comparisons = qw( + length + algo_num + hex_id + creation_date + creation_date_string + usage_flags + ); + + my $field; + foreach $field (@string_comparisons) { + return 0 unless $self->$field eq $other->$field; + } + + my @can_be_undef = qw( + hex_data + expiration_date + expiration_date_string + local_id + ); + foreach $field (@can_be_undef) { + return 0 unless ((defined $self->$field && ( $self->$field ne '') ) == (defined $other->$field && ( $other->$field ne ''))); + if (defined $self->$field && ( $self->$field ne '') ) { + return 0 unless ($self->$field eq $other->$field); + } + } + my @objs = qw( + fingerprint + ); + foreach $field (@objs) { + return 0 unless $self->$field->compare($other->$field, $deep); + } + + if (defined $deep && $deep) { + my @lists = qw( + signatures + revokers + revocations + ); + my $i; + foreach my $list (@lists) { + return 0 unless @{$self->$list} == @{$other->$list}; + for ( $i = 0; $i < scalar(@{$self->$list}); $i++ ) { + return 0 + unless $self->$list->[$i]->compare($other->$list->[$i], $deep); + } + } + + return 0 unless @{$self->pubkey_data} == @{$other->pubkey_data}; + for ( $i = 0; $i < scalar(@{$self->pubkey_data}); $i++ ) { + return 0 unless (0 == $self->pubkey_data->[$i]->bcmp($other->pubkey_data->[$i])); + } + } + return 1; +} + +1; + +__END__ + +=head1 NAME + +GnuPG::Key - GnuPG Key Object + +=head1 SYNOPSIS + + # assumes a GnuPG::Interface object in $gnupg + my @keys = $gnupg->get_public_keys( 'ftobin' ); + + # now GnuPG::PublicKey objects are in @keys + +=head1 DESCRIPTION + +GnuPG::Key objects are generally not instantiated on their +own, but rather used as a superclass of GnuPG::PublicKey, +GnuPG::SecretKey, or GnuPG::SubKey objects. + +=head1 OBJECT METHODS + +=head2 Initialization Methods + +=over 4 + +=item new( I<%initialization_args> ) + +This methods creates a new object. The optional arguments are +initialization of data members. + +=item hash_init( I<%args> ). + + +=item short_hex_id + +This returns the commonly-used short, 8 character short hex id +of the key. + +=item compare( I<$other>, I<$deep> ) + +Returns non-zero only when this Key is identical to the other +GnuPG::Key. If $deep is present and non-zero, the key's associated +signatures, revocations, and revokers will also be compared. + +=back + +=head1 OBJECT DATA MEMBERS + +=over 4 + +=item length + +Number of bits in the key. + +=item algo_num + +They algorithm number that the Key is used for. + +=item usage_flags + +The Key Usage flags associated with this key, represented as a string +of lower-case letters. Possible values include: (a) authenticate, (c) +certify, (e) encrypt, and (s) sign. + +A key may have any combination of them in any order. In addition to +these letters, the primary key has uppercase versions of the letters +to denote the _usable_ capabilities of the entire key, and a potential +letter 'D' to indicate a disabled key. + +See "key capabilities" DETAILS from the GnuPG sources for more +details. + +=item hex_data + +The data of the key. WARNING: this seems to have never been +instantiated, and should always be undef. + +=item pubkey_data + +A list of Math::BigInt objects that correspond to the public key +material for the given key. This member is empty on secret keys in +GnuPG 1.4. It is populated on secret keys In GnuPG >= 2.2.0. + +For DSA keys, the values are: prime (p), group order (q), group generator (g), y + +For RSA keys, the values are: modulus (n), exponent (e) + +For El Gamal keys, the values are: prime (p), group generator (g), y + +For more details, see: http://tools.ietf.org/html/rfc4880#page-42 + +=item hex_id + +The long hex id of the key. This is not the fingerprint nor +the short hex id, which is 8 hex characters. + +=item creation_date_string + +=item expiration_date_string + +Formatted date of the key's creation and expiration. If the key has +no expiration, expiration_date_string will return undef. + +=item creation_date + +=item expiration_date + +Date of the key's creation and expiration, stored as the number of +seconds since midnight 1970-01-01 UTC. If the key has no expiration, +expiration_date will return undef. + +=item fingerprint + +A GnuPG::Fingerprint object. + +=item signatures + +A list of GnuPG::Signature objects embodying the signatures on this +key. For subkeys, the signatures are usually subkey-binding +signatures. For primary keys, the signatures are statements about the +key itself. + +=item revocations + +A list of revocations associated with this key, stored as +GnuPG::Signature objects (since revocations are a type of +certification as well). Note that a revocation of a primary key has a +different semantic meaning than a revocation associated with a subkey. + +=item revokers + +A list of GnuPG::Revoker objects associated with this key, indicating +other keys which are allowed to revoke certifications made by this +key. + +=back + +=head1 SEE ALSO + +L<GnuPG::Fingerprint>, +L<GnuPG::Signature>, +L<GnuPG::Revoker>, + +=cut diff --git a/lib/GnuPG/Options.pm b/lib/GnuPG/Options.pm new file mode 100644 index 0000000..9b94653 --- /dev/null +++ b/lib/GnuPG/Options.pm @@ -0,0 +1,378 @@ +# Options.pm +# - providing an object-oriented approach to GnuPG's options +# +# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org> +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: Options.pm,v 1.14 2001/08/21 13:31:50 ftobin Exp $ +# + +package GnuPG::Options; +use Moo; +use MooX::late; +use MooX::HandlesVia; +with qw(GnuPG::HashInit); + +use constant BOOLEANS => qw( + armor + no_greeting + verbose + no_verbose + quiet + batch + always_trust + rfc1991 + openpgp + force_v3_sigs + no_options + textmode + meta_pgp_5_compatible + meta_pgp_2_compatible + meta_interactive + ignore_mdc_error + keyring + no_default_keyring +); + +use constant SCALARS => qw( + homedir + default_key + comment + status_fd + logger_fd + passphrase_fd + command_fd + compress_algo + options + meta_signing_key + meta_signing_key_id + debug_level + logger_file +); + +use constant LISTS => qw( + encrypt_to + recipients + meta_recipients_keys + meta_recipients_key_ids + extra_args +); + +has $_ => ( + isa => 'Bool', + is => 'rw', + clearer => 'clear_' . $_, +) for BOOLEANS; + +has $_ => ( + isa => 'Any', + is => 'rw', + clearer => 'clear_' . $_, +) for SCALARS; + +for my $list (LISTS) { + my $ref = $list . "_ref"; + has $ref => ( + handles_via => 'Array', + is => 'rw', + lazy => 1, + clearer => "clear_$list", + default => sub { [] }, + handles => { + "push_$list" => 'push', + }, + ); + + no strict 'refs'; + *{$list} = sub { + my $self = shift; + return wantarray ? @{$self->$ref(@_)} : $self->$ref(@_); + }; +} + +sub BUILD { + my ( $self, $args ) = @_; + # Newer GnuPG will force failure for old ciphertext unless set + $args->{ignore_mdc_error} //= 1; + + $self->hash_init( meta_interactive => 1 ); + $self->hash_init(%$args); +} + +sub copy { + my ($self) = @_; + + my $new = ( ref $self )->new(); + + foreach my $field ( BOOLEANS, SCALARS, LISTS ) { + my $value = $self->$field(); + next unless defined $value; + $new->$field($value); + } + + return $new; +} + +sub get_args { + my ($self) = @_; + + return ( + $self->get_meta_args(), + $self->get_option_args(), + $self->extra_args(), + ); +} + +sub get_option_args { + my ($self) = @_; + + my @args = (); + + push @args, '--homedir', $self->homedir() if $self->homedir(); + push @args, '--options', $self->options() if $self->options(); + push @args, '--no-options' if $self->no_options(); + push @args, '--armor' if $self->armor(); + push @args, '--textmode' if $self->textmode(); + push @args, '--default-key', $self->default_key() if $self->default_key(); + push @args, '--no-greeting' if $self->no_greeting(); + push @args, '--verbose' if $self->verbose(); + push @args, '--no-verbose' if $self->no_verbose(); + push @args, '--quiet' if $self->quiet(); + push @args, '--batch' if $self->batch(); + push @args, '--trust-model=always' if $self->always_trust(); + push @args, '--comment', $self->comment() if defined $self->comment(); + push @args, '--force-v3-sigs' if $self->force_v3_sigs(); + push @args, '--rfc1991' if $self->rfc1991; + push @args, '--openpgp' if $self->openpgp(); + push @args, '--compress-algo', $self->compress_algo() + if defined $self->compress_algo(); + + push @args, '--status-fd', $self->status_fd() + if defined $self->status_fd(); + push @args, '--logger-fd', $self->logger_fd() + if defined $self->logger_fd(); + push @args, '--passphrase-fd', $self->passphrase_fd() + if defined $self->passphrase_fd(); + push @args, '--command-fd', $self->command_fd() + if defined $self->command_fd(); + + push @args, map { ( '--recipient', $_ ) } $self->recipients(); + push @args, map { ( '--encrypt-to', $_ ) } $self->encrypt_to(); + + push @args, '--debug-level', $self->debug_level() if ($self->debug_level); + push @args, '--logger-file', $self->logger_file() if ($self->logger_file()); + + push @args, '--ignore-mdc-error' if ($self->ignore_mdc_error()); + push @args, '--keyring' if ( $self->keyring() ); + push @args, '--no-default-keyring' if ( $self->no_default_keyring() ); + + return @args; +} + +sub get_meta_args { + my ($self) = @_; + + my @args = (); + + push @args, '--compress-algo', 1, '--force-v3-sigs' + if $self->meta_pgp_5_compatible(); + push @args, '--rfc1991' if $self->meta_pgp_2_compatible(); + push @args, '--batch', '--no-tty' if not $self->meta_interactive(); + + # To eliminate confusion, we'll move to having any options + # that deal with keys end in _id(s) if they only take + # an id; otherwise we assume that a GnuPG::Key + push @args, '--default-key', $self->meta_signing_key_id() + if $self->meta_signing_key_id(); + push @args, '--default-key', $self->meta_signing_key()->hex_id() + if $self->meta_signing_key(); + + push @args, + map { ( '--recipient', $_ ) } $self->meta_recipients_key_ids(); + push @args, + map { ( '--recipient', $_->hex_id() ) } $self->meta_recipients_keys(); + + return @args; +} + +1; + +__END__ + +=head1 NAME + +GnuPG::Options - GnuPG options embodiment + +=head1 SYNOPSIS + + # assuming $gnupg is a GnuPG::Interface object + $gnupg->options->armor( 1 ); + $gnupg->options->push_recipients( 'ftobin', '0xABCD1234ABCD1234ABCD1234ABCD1234ABCD1234' ); + +=head1 DESCRIPTION + +GnuPG::Options objects are generally not instantiated on their +own, but rather as part of a GnuPG::Interface object. + +=head1 OBJECT METHODS + +=over 4 + +=item new( I<%initialization_args> ) + +This methods creates a new object. The optional arguments are +initialization of data members. + +=item hash_init( I<%args> ). + + +=item copy + +Returns a copy of this object. Useful for 'saving' options. + +=item get_args + +Returns a list of arguments to be passed to GnuPG based +on data members which are 'meta_' options, regular options, +and then I<extra_args>, in that order. + +=back + +=head1 OBJECT DATA MEMBERS + +=over 4 + +=item homedir + +=item armor + +=item textmode + +=item default_key + +=item no_greeting + +=item verbose + +=item no_verbose + +=item quiet + +=item batch + +=item always_trust + +=item comment + +=item status_fd + +=item logger_fd + +=item passphrase_fd + +=item compress_algo + +=item force_v3_sigs + +=item rfc1991 + +=item openpgp + +=item options + +=item no_options + +=item encrypt_to + +=item recipients + +=back + +These options correlate directly to many GnuPG options. For those that +are boolean to GnuPG, simply that argument is passed. For those +that are associated with a scalar, that scalar is passed passed +as an argument appropriate. For those that can be specified more +than once, such as B<recipients>, those are considered lists +and passed accordingly. Each are undefined or false to begin. + +=head2 Meta Options + +Meta options are those which do not correlate directly to any +option in GnuPG, but rather are generally a bundle of options +used to accomplish a specific goal, such as obtaining +compatibility with PGP 5. The actual arguments each of these +reflects may change with time. Each defaults to false unless +otherwise specified. + +These options are being designed and to provide a non-GnuPG-specific +abstraction, to help create compatibility with a possible +PGP::Interface module. + +To help avoid confusion, methods with take a form of a key as +an object shall be prepended with I<_id(s)> if they only +take an id; otherwise assume an object of type GnuPG::Key +is required. + +=over 4 + +=item meta_pgp_5_compatible + +If true, arguments are generated to try to be compatible with PGP 5.x. + +=item meta_pgp_2_compatible + +If true, arguments are generated to try to be compatible with PGP 2.x. + +=item meta_interactive + +If false, arguments are generated to try to help the using program +use GnuPG in a non-interactive environment, such as CGI scripts. +Default is true. + +=item meta_signing_key_id + +This scalar reflects the key used to sign messages. +Currently this is synonymous with I<default-key>. + +=item meta_signing_key + +This GnuPG::Key object reflects the key used to sign messages. + +=item meta_recipients_key_ids + +This list of scalar key ids are used to generate the +appropriate arguments having these keys as recipients. + +=item meta_recipients_keys + +This list of keys of the type GnuPG::Key are used to generate the +appropriate arguments having these keys as recipients. +You probably want to have this list be of the inherited class +GnuPG::SubKey, as in most instances, OpenPGP keypairs have +the encyrption key as the subkey of the primary key, which is +used for signing. + +=back + +=head2 Other Data Members + +=over 4 + +=item extra_args + +This is a list of any other arguments used to pass to GnuPG. +Useful to pass an argument not yet covered in this package. + +=back + +=head1 SEE ALSO + +L<GnuPG::Interface>, + +=cut diff --git a/lib/GnuPG/PrimaryKey.pm b/lib/GnuPG/PrimaryKey.pm new file mode 100644 index 0000000..e26cdc7 --- /dev/null +++ b/lib/GnuPG/PrimaryKey.pm @@ -0,0 +1,143 @@ +# PrimaryKey.pm +# - objectified GnuPG primary keys (can have subkeys) +# +# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org> +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: PrimaryKey.pm,v 1.4 2001/09/14 12:34:36 ftobin Exp $ +# + +package GnuPG::PrimaryKey; +use Moo; +use MooX::late; +use MooX::HandlesVia; + +BEGIN { extends qw( GnuPG::Key ) } + +for my $list (qw(user_ids subkeys user_attributes)) { + my $ref = $list . "_ref"; + has $ref => ( + handles_via => 'Array', + is => 'rw', + default => sub { [] }, + handles => { + "push_$list" => 'push', + }, + ); + + no strict 'refs'; + *{$list} = sub { + my $self = shift; + return wantarray ? @{$self->$ref(@_)} : $self->$ref(@_); + }; +} + +has $_ => ( + isa => 'Any', + is => 'rw', + clearer => 'clear_' . $_, +) for qw( local_id owner_trust ); + + +sub compare { + my ($self, $other, $deep) = @_; + + my @comparison_fields = qw ( + owner_trust + ); + + foreach my $field (@comparison_fields) { + return 0 unless $self->$field eq $other->$field; + } + + if (defined $deep && $deep) { + my @lists = qw( + user_ids + subkeys + user_attributes + ); + + foreach my $list (@lists) { + return 0 unless @{$self->$list} == @{$other->$list}; + for ( my $i = 0; $i < scalar(@{$self->$list}); $i++ ) { + return 0 + unless $self->$list->[$i]->compare($other->$list->[$i], 1); + } + } + } + + return $self->SUPER::compare($other, $deep); +} + +1; + +__END__ + +=head1 NAME + +GnuPG::PrimaryKey - GnuPG Primary Key Objects + +=head1 SYNOPSIS + + # assumes a GnuPG::Interface object in $gnupg + my @keys = $gnupg->get_public_keys( 'ftobin' ); + + # or + + my @keys = $gnupg->get_secret_keys( 'ftobin' ); + + # now GnuPG::PrimaryKey objects are in @keys + +=head1 DESCRIPTION + +GnuPG::PrimaryKey objects are generally instantiated +as GnuPG::PublicKey or GnuPG::SecretKey objects +through various methods of GnuPG::Interface. +They embody various aspects of a GnuPG primary key. + +This package inherits data members and object methods +from GnuPG::Key, which is not described here, but rather +in L<GnuPG::Key>. + +=head1 OBJECT DATA MEMBERS + +=over 4 + +=item user_ids + +A list of GnuPG::UserId objects associated with this key. + +=item user_attributes + +A list of GnuPG::UserAttribute objects associated with this key. + +=item subkeys + +A list of GnuPG::SubKey objects associated with this key. + +=item local_id + +WARNING: DO NOT USE. This used to mean GnuPG's local id for the key, +but modern versions of GnuPG do not produce it. Expect this to be the +empty string or undef. + +=item owner_trust + +The scalar value GnuPG reports as the ownertrust for this key. +See GnuPG's DETAILS file for details. + +=back + +=head1 SEE ALSO + +L<GnuPG::Key>, +L<GnuPG::UserId>, +L<GnuPG::SubKey>, + +=cut diff --git a/lib/GnuPG/PublicKey.pm b/lib/GnuPG/PublicKey.pm new file mode 100644 index 0000000..62a7963 --- /dev/null +++ b/lib/GnuPG/PublicKey.pm @@ -0,0 +1,53 @@ +# PublicKey.pm +# - providing an object-oriented approach to GnuPG public keys +# +# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org> +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: PublicKey.pm,v 1.9 2001/09/14 12:34:36 ftobin Exp $ +# + +package GnuPG::PublicKey; +use Moo; + +BEGIN { extends qw( GnuPG::PrimaryKey ) } + +1; + +__END__ + +=head1 NAME + +GnuPG::PublicKey - GnuPG Public Key Objects + +=head1 SYNOPSIS + + # assumes a GnuPG::Interface object in $gnupg + my @keys = $gnupg->get_public_keys( 'ftobin' ); + + # now GnuPG::PublicKey objects are in @keys + +=head1 DESCRIPTION + +GnuPG::PublicKey objects are generally instantiated +through various methods of GnuPG::Interface. +They embody various aspects of a GnuPG public key. + +This package inherits data members and object methods +from GnuPG::PrimaryKey, which is not described here, but rather +in L<GnuPG::PrimaryKey>. + +Currently, this package is functionally no different +from GnuPG::PrimaryKey. + +=head1 SEE ALSO + +L<GnuPG::PrimaryKey>, + +=cut diff --git a/lib/GnuPG/Revoker.pm b/lib/GnuPG/Revoker.pm new file mode 100644 index 0000000..0bd79dd --- /dev/null +++ b/lib/GnuPG/Revoker.pm @@ -0,0 +1,157 @@ +# Revoker.pm +# - providing an object-oriented approach to GnuPG key revokers +# +# Copyright (C) 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net> +# (derived from Signature.pm, Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>) +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: Signature.pm,v 1.4 2001/08/21 13:31:50 ftobin Exp $ +# + +package GnuPG::Revoker; +use Moo; +use MooX::late; + +has [qw( + algo_num + class + )] => ( + isa => 'Int', + is => 'rw', +); + +has fingerprint => ( + isa => 'GnuPG::Fingerprint', + is => 'rw', + ); + +has signatures => ( + isa => 'ArrayRef', + is => 'rw', + default => sub { [] }, +); + +sub push_signatures { + my $self = shift; + push @{ $self->signatures }, @_; +} + +sub is_sensitive { + my $self = shift; + return $self->class & 0x40; +} + +sub compare { + my ( $self, $other, $deep ) = @_; + + my @comparison_ints = qw( class algo_num ); + + foreach my $field ( @comparison_ints ) { + return 0 unless $self->$field() == $other->$field(); + } + + return 0 unless $self->fingerprint->compare($other->fingerprint); + + # FIXME: is it actually wrong if the associated signatures come out + # in a different order on the two compared designated revokers? + if (defined $deep && $deep) { + return 0 unless @{$self->signatures} == @{$other->signatures}; + for ( my $i = 0; $i < scalar(@{$self->signatures}); $i++ ) { + return 0 + unless $self->signatures->[$i]->compare($other->signatures->[$i], 1); + } + } + + return 1; +} + +1; + +__END__ + +=head1 NAME + +GnuPG::Revoker - GnuPG Key Revoker Objects + +=head1 SYNOPSIS + + # assumes a GnuPG::PrimaryKey object in $key + my $revokerfpr = $key->revokers->[0]->fingerprint(); + +=head1 DESCRIPTION + +GnuPG::Revoker objects are generally not instantiated on their own, +but rather as part of GnuPG::Key objects. They represent a statement +that another key is designated to revoke certifications made by the +key in question. + +=head1 OBJECT METHODS + +=over 4 + +=item new( I<%initialization_args> ) + +This methods creates a new object. The optional arguments are +initialization of data members. + +=item is_sensitive() + +Returns 0 if the revoker information can be freely distributed. +If this is non-zero, the information should be treated as "sensitive". + +Please see http://tools.ietf.org/html/rfc4880#section-5.2.3.15 for +more explanation. + +=item compare( I<$other>, I<$deep> ) + +Returns non-zero only when this designated revoker is identical to the +other GnuPG::Revoker. If $deep is present and non-zero, the revokers' +signatures will also be compared. + + +=back + +=head1 OBJECT DATA MEMBERS + +=over 4 + +=item fingerprint + +A GnuPG::Fingerprint object indicating the fingerprint of the +specified revoking key. (Note that this is *not* the fingerprint of +the key whose signatures can be revoked by this revoker). + +=item algo_num + +The numeric identifier of the algorithm of the revoker's key. + +=item signatures + +A list of GnuPG::Signature objects which cryptographically bind the +designated revoker to the primary key. If the material was +instantiated using the *_with_sigs() functions from GnuPG::Interface, +then a valid revoker designation should have a valid signature +associated with it from the relevant key doing the designation (not +from the revoker's key). + +Note that designated revoker certifications are themselves +irrevocable, so there is no analogous list of revocations in a +GnuPG::Revoker object. + +=back + +=head1 SEE ALSO + +L<GnuPG::Interface>, +L<GnuPG::Fingerprint>, +L<GnuPG::Key>, +L<GnuPG::Signature>, +L<http://tools.ietf.org/html/rfc4880#section-5.2.3.15> + +=cut diff --git a/lib/GnuPG/SecretKey.pm b/lib/GnuPG/SecretKey.pm new file mode 100644 index 0000000..eead427 --- /dev/null +++ b/lib/GnuPG/SecretKey.pm @@ -0,0 +1,53 @@ +# SecretKey.pm +# - providing an object-oriented approach to GnuPG secret keys +# +# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org> +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: SecretKey.pm,v 1.9 2001/09/14 12:34:36 ftobin Exp $ +# + +package GnuPG::SecretKey; +use Moo; + +BEGIN { extends qw( GnuPG::PrimaryKey ) } + +1; + +__END__ + +=head1 NAME + +GnuPG::SecretKey - GnuPG Secret Key Objects + +=head1 SYNOPSIS + + # assumes a GnuPG::Interface object in $gnupg + my @keys = $gnupg->get_secret_keys( 'ftobin' ); + + # now GnuPG::SecretKey objects are in @keys + +=head1 DESCRIPTION + +GnuPG::SecretKey objects are generally instantiated +through various methods of GnuPG::Interface. +They embody various aspects of a GnuPG secret key. + +This package inherits data members and object methods +from GnuPG::PrimaryKey, which is described here, but rather +in L<GnuPG::PrimaryKey>. + +Currently, this package is functionally no different +from GnuPG::PrimaryKey. + +=head1 SEE ALSO + +L<GnuPG::PrimaryKey>, + +=cut diff --git a/lib/GnuPG/Signature.pm b/lib/GnuPG/Signature.pm new file mode 100644 index 0000000..5020bb7 --- /dev/null +++ b/lib/GnuPG/Signature.pm @@ -0,0 +1,169 @@ +# Signature.pm +# - providing an object-oriented approach to GnuPG key signatures +# +# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org> +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: Signature.pm,v 1.4 2001/08/21 13:31:50 ftobin Exp $ +# + +package GnuPG::Signature; +use Moo; +use MooX::late; + +has [qw( + validity + algo_num + hex_id + user_id_string + date + date_string + expiration_date + expiration_date_string + sig_class + is_exportable + )] => ( + isa => 'Any', + is => 'rw', +); + +sub is_valid { + my $self = shift; + return $self->validity eq '!'; +} + +sub compare { + my ($self, $other) = @_; + + my @compared_fields = qw( + validity + algo_num + hex_id + date + date_string + sig_class + is_exportable + ); + + foreach my $field ( @compared_fields ) { + return 0 unless $self->$field eq $other->$field; + } + # check for expiration if present? + return 0 unless (defined $self->expiration_date) == (defined $other->expiration_date); + if (defined $self->expiration_date) { + return 0 unless (($self->expiration_date == $other->expiration_date) || + ($self->expiration_date_string eq $other->expiration_date_string)); + } + return 1; +} + +1; + +__END__ + +=head1 NAME + +GnuPG::Signature - GnuPG Key Signature Objects + +=head1 SYNOPSIS + + # assumes a GnuPG::Key or GnuPG::UserID or GnuPG::UserAttribute object in $signed + my $signing_id = $signed->signatures->[0]->hex_id(); + +=head1 DESCRIPTION + +GnuPG::Signature objects are generally not instantiated +on their own, but rather as part of GnuPG::Key objects. +They embody various aspects of a GnuPG signature on a key. + +=head1 OBJECT METHODS + +=over 4 + +=item new( I<%initialization_args> ) + +This methods creates a new object. The optional arguments are +initialization of data members. + +=item is_valid() + +Returns 1 if GnuPG was able to cryptographically verify the signature, +otherwise 0. + +=item compare( I<$other> ) + +Returns non-zero only when this Signature is identical to the other +GnuPG::Signature. + +=back + +=head1 OBJECT DATA MEMBERS + +=over 4 + +=item validity + +A character indicating the cryptographic validity of the key. GnuPG +uses at least the following characters: "!" means valid, "-" means not +valid, "?" means unknown (e.g. if the supposed signing key is not +present in the local keyring), and "%" means an error occurred (e.g. a +non-supported algorithm). See the documentation for --check-sigs in +gpg(1). + +=item algo_num + +The number of the algorithm used for the signature. + +=item hex_id + +The hex id of the signing key. + +=item user_id_string + +The first user id string on the key that made the signature. +This may not be defined if the signing key is not on the local keyring. + +=item sig_class + +Signature class. This is the numeric value of the class of signature. + +A table of possible classes of signatures and their numeric types can +be found at http://tools.ietf.org/html/rfc4880#section-5.2.1 + +=item is_exportable + +returns 0 for local-only signatures, non-zero for exportable +signatures. + +=item date_string + +The formatted date the signature was performed on. + +=item date + +The date the signature was performed, represented as the number of +seconds since midnight 1970-01-01 UTC. + +=item expiration_date_string + +The formatted date the signature will expire (signatures without +expiration return undef). + +=item expiration_date + +The date the signature will expire, represented as the number of +seconds since midnight 1970-01-01 UTC (signatures without expiration +return undef) + +=back + +=head1 SEE ALSO + + +=cut diff --git a/lib/GnuPG/SubKey.pm b/lib/GnuPG/SubKey.pm new file mode 100644 index 0000000..f5d7872 --- /dev/null +++ b/lib/GnuPG/SubKey.pm @@ -0,0 +1,107 @@ +# SubKey.pm +# - providing an object-oriented approach to GnuPG sub keys +# +# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org> +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: SubKey.pm,v 1.9 2001/09/14 12:34:36 ftobin Exp $ +# + +package GnuPG::SubKey; +use Carp; +use Moo; +use MooX::late; +BEGIN { extends qw( GnuPG::Key ) } + +has [qw( validity owner_trust local_id )] => ( + isa => 'Any', + is => 'rw', +); + +# DEPRECATED! +# return the last signature, if present. Or push in a new signature, +# if one is supplied. +sub signature { + my $self = shift; + my $argcount = @_; + + if ($argcount) { + @{$self->signatures} = (); + $self->push_signatures(@_); + } else { + my $sigcount = @{$self->signatures}; + if ($sigcount) { + return $self->signatures->[$sigcount-1]; + } else { + return undef; + } + } +} + +1; + +__END__ + +=head1 NAME + +GnuPG::SubKey - GnuPG Sub Key objects + +=head1 SYNOPSIS + + # assumes a GnuPG::PublicKey object in $key + my @subkeys = $key->subkeys(); + + # now GnuPG::SubKey objects are in @subkeys + +=head1 DESCRIPTION + +GnuPG::SubKey objects are generally instantiated +through various methods of GnuPG::Interface. +They embody various aspects of a GnuPG sub key. + +This package inherits data members and object methods +from GnuPG::Key, which are not described here, but rather +in L<GnuPG::Key>. + +=head1 OBJECT DATA MEMBERS + +=over 4 + +=item validity + +A scalar holding the value GnuPG reports for the trust of authenticity +(a.k.a.) validity of a key. +See GnuPG's DETAILS file for details. + +=item local_id + +GnuPG's local id for the key. + +=item owner_trust + +The scalar value GnuPG reports as the ownertrust for this key. +See GnuPG's DETAILS file for details. + +=item signature + +* DEPRECATED* + +A GnuPG::Signature object holding the representation of the signature +on this key. Please use signatures (see L<GnuPG::Key>) instead of +signature. Using signature, you will get an arbitrary signature from +the set of available signatures. + +=back + +=head1 SEE ALSO + +L<GnuPG::Key>, +L<GnuPG::Signature>, + +=cut diff --git a/lib/GnuPG/UserAttribute.pm b/lib/GnuPG/UserAttribute.pm new file mode 100644 index 0000000..ddc7ead --- /dev/null +++ b/lib/GnuPG/UserAttribute.pm @@ -0,0 +1,118 @@ +# UserAttribute.pm +# - providing an object-oriented approach to GnuPG user attributes +# +# Copyright (C) 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net> +# (derived from UserId.pm, Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>) +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: UserId.pm,v 1.7 2001/08/21 13:31:50 ftobin Exp $ +# + +package GnuPG::UserAttribute; +use Moo; +use MooX::late; + +has [qw( validity subpacket_count subpacket_total_size )] => ( + isa => 'Any', + is => 'rw', +); + +has signatures => ( + isa => 'ArrayRef', + is => 'rw', + default => sub { [] }, +); +has revocations => ( + isa => 'ArrayRef', + is => 'rw', + default => sub { [] }, +); + +sub push_signatures { + my $self = shift; + push @{ $self->signatures }, @_; +} +sub push_revocations { + my $self = shift; + push @{ $self->revocations }, @_; +} + +1; + +__END__ + +=head1 NAME + +GnuPG::UserAttribute - GnuPG User Attribute Objects + +=head1 SYNOPSIS + + # assumes a GnuPG::PublicKey object in $publickey + my $jpgs_size = $publickey->user_attributes->[0]->subpacket_total_size(); + +=head1 DESCRIPTION + +GnuPG::UserAttribute objects are generally not instantiated on their +own, but rather as part of GnuPG::PublicKey or GnuPG::SecretKey +objects. + +=head1 OBJECT METHODS + +=over 4 + +=item new( I<%initialization_args> ) + +This methods creates a new object. The optional arguments are +initialization of data members; + +=back + +=head1 OBJECT DATA MEMBERS + +=over 4 + +=item validity + +A scalar holding the value GnuPG reports for the calculated validity +of the binding between this User Attribute packet and its associated +primary key. See GnuPG's DETAILS file for details. + +=item subpacket_count + +A scalar holding the number of attribute subpackets. This is usually +1, as most UATs seen in the wild contain a single image in JPEG +format. + +=item subpacket_total_size + +A scalar holding the total byte count of all attribute subpackets. + +=item signatures + +A list of GnuPG::Signature objects embodying the signatures +on this user attribute. + +=item revocations + +A list of revocations associated with this User Attribute, stored as +GnuPG::Signature objects (since revocations are a type of +certification as well). + +=back + +=head1 BUGS + +No useful information about the embedded attributes is provided yet. +It would be nice to be able to get ahold of the raw JPEG material. + +=head1 SEE ALSO + +L<GnuPG::Signature>, + +=cut diff --git a/lib/GnuPG/UserId.pm b/lib/GnuPG/UserId.pm new file mode 100644 index 0000000..8c4124f --- /dev/null +++ b/lib/GnuPG/UserId.pm @@ -0,0 +1,148 @@ +# UserId.pm +# - providing an object-oriented approach to GnuPG user ids +# +# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org> +# +# This module is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# $Id: UserId.pm,v 1.7 2001/08/21 13:31:50 ftobin Exp $ +# + +package GnuPG::UserId; +use Moo; +use MooX::late; + +has [qw( validity as_string )] => ( + isa => 'Any', + is => 'rw', +); + +has signatures => ( + isa => 'ArrayRef', + is => 'rw', + default => sub { [] }, +); +has revocations => ( + isa => 'ArrayRef', + is => 'rw', + default => sub { [] }, +); + +sub push_signatures { + my $self = shift; + push @{ $self->signatures }, @_; +} +sub push_revocations { + my $self = shift; + push @{ $self->revocations }, @_; +} + +sub compare { + my ( $self, $other, $deep ) = @_; + + my @comparison_ints = qw( validity as_string ); + + foreach my $field ( @comparison_ints ) { + return 0 unless $self->$field() eq $other->$field(); + } + + return 0 unless @{$self->signatures} == @{$other->signatures}; + return 0 unless @{$self->revocations} == @{$other->revocations}; + + # FIXME: is it actually wrong if the associated signatures come out + # in a different order on the two compared designated revokers? + if (defined $deep && $deep) { + for ( my $i = 0; $i < scalar(@{$self->signatures}); $i++ ) { + return 0 + unless $self->signatures->[$i]->compare($other->signatures->[$i], 1); + } + for ( my $i = 0; $i < scalar(@{$self->revocations}); $i++ ) { + return 0 + unless $self->revocations->[$i]->compare($other->revocations->[$i], 1); + } + } + + return 1; +} + + +# DEPRECATED +sub user_id_string { + my ( $self, $v ) = @_; + $self->as_string($v) if defined $v; + return $self->as_string(); +} + +1; + +__END__ + +=head1 NAME + +GnuPG::UserId - GnuPG User ID Objects + +=head1 SYNOPSIS + + # assumes a GnuPG::PublicKey object in $publickey + my $user_id = $publickey->user_ids_ref->[0]->as_string; + +=head1 DESCRIPTION + +GnuPG::UserId objects are generally not instantiated on their +own, but rather as part of GnuPG::PublicKey or GnuPG::SecretKey +objects. + +=head1 OBJECT METHODS + +=over 4 + +=item new( I<%initialization_args> ) + +This methods creates a new object. The optional arguments are +initialization of data members; + +=item compare( I<$other>, I<$deep> ) + +Returns non-zero only when this User ID is identical to the other +GnuPG::UserID. If $deep is present and non-zero, the User ID's +signatures and revocations will also be compared. + +=back + +=head1 OBJECT DATA MEMBERS + +=over 4 + +=item as_string + +A string of the user id. + +=item validity + +A scalar holding the value GnuPG reports for the trust of authenticity +(a.k.a.) validity of a key. +See GnuPG's DETAILS file for details. + +=item signatures + +A list of GnuPG::Signature objects embodying the signatures +on this user id. + +=item revocations + +A list of revocations associated with this User ID, stored as +GnuPG::Signature objects (since revocations are a type of +certification as well). + +=back + +=head1 SEE ALSO + +L<GnuPG::Signature>, + +=cut |