@@ -266,7 +266,7 @@ The main text of this comment, formatted in C<$file_format>. =item userid -The (8-byte) "nice_id" of the comment poster. +The (8-byte) id of the comment poster. =item format lib/Angerwhale/Content/Filesystem/Item.pm @@ -14,13 +14,11 @@ Adds author information. sub filter { return sub { - my $self = shift; - my $context = shift; - my $item = shift; + my ( $self, $context, $item ) = @_; my $id = $item->metadata->{raw_author} = $item->metadata->{author}; my $author = eval { - $context->model('UserStore')->get_user_by_nice_id($id) + $context->model('UserStore')->get_user_by_id($id) if $id; }; $author ||= Angerwhale::User::Anonymous->new; lib/Angerwhale/Content/Filter/Author.pm @@ -3,7 +3,7 @@ package Angerwhale::Content::Filter::PGP; use Angerwhale::Signature; -use Crypt::OpenPGP; +use Crypt::GpgME; use Encode; use strict; use warnings; @@ -21,9 +21,7 @@ appropriately. sub filter { return sub { - my $self = shift; - my $context = shift; - my $item = shift; + my ( $self, $context, $item ) = @_; my $text; eval { @@ -42,23 +40,16 @@ sub filter { return $item; # we're done. nothing to do. } - if($item->metadata->{raw_author} && - $item->metadata->{signed} eq 'yes'){ + if($item->metadata->{raw_author} && $item->metadata->{signed} eq 'yes') { # signature is cached, so restore user without checking sig - $item->metadata->{author} = - $context->model('UserStore')-> - get_user_by_nice_id($item->metadata->{raw_author}); - - $item->metadata->{signor} = - pack( "H*", $item->metadata->{raw_author}); + $item->metadata->{author} = $context->model('UserStore')->get_user_by_id($item->metadata->{raw_author}); + $item->metadata->{signor} = $item->metadata->{raw_author}; } else { # no cached signature, check the signature - my $author = - get_user_signature($item->metadata->{raw_text}, - $context->model('UserStore')); + my $author = get_user_signature($item->metadata->{raw_text}); - if(!$author){ + if(!$author) { # bad signature! $item->metadata->{author} = Angerwhale::User::Anonymous->new; } @@ -66,14 +57,11 @@ sub filter { # good signature # cache the signature so we don't have to verify again $item->store_attribute('signed', 'yes'); - $item->store_attribute('author', unpack( "H*", $author)); + $item->store_attribute('author', $author); $item->metadata->{raw_author} = $item->metadata->{author}; # setup the "inflated" author - $item->metadata->{author} = - $context->model('UserStore')-> - get_user_by_real_id($author); - + $item->metadata->{author} = $context->model('UserStore')->get_user_by_id($author); $item->metadata->{signor} = $author; } } @@ -89,18 +77,12 @@ Returns keyid of signature, or false if the signature is invalid. =cut sub get_user_signature { - my ($message, $userstore) = @_; - my $keyserver = $userstore->keyserver; - my $pgp = Crypt::OpenPGP->new( - KeyServer => $keyserver, - AutoKeyRetrieve => 1 - ); - - my ( $id, $sig ) = $pgp->verify( Signature => $message ); + my $message = shift; + + my ( $result, $plain ) = eval { Crypt::GpgME->new->verify( $message ) }; - die $pgp->errstr if !defined $id; - return $sig->key_id if $id; - return 0; # otherwise + die "$@" if !defined $plain or $@; + return $plain ? lc($result->{signatures}->[0]->{fpr}) : 0; } 1; lib/Angerwhale/Content/Filter/PGP.pm @@ -145,7 +145,7 @@ sub post : Local { my $captcha = $c->request->param('captcha'); my $user = $c->stash->{user}; - my $uid = $user->nice_id if ( $user && $user->can('nice_id') ); + my $uid = $user->id if ( $user && $user->can('id') ); my $comment = $c->model('Articles')->preview({ title => $title, body => $body, type => $type, lib/Angerwhale/Controller/Comments.pm @@ -4,7 +4,7 @@ use strict; use warnings; use base 'Catalyst::Controller'; use Angerwhale::Challenge; -use Crypt::OpenPGP; +use Crypt::GpgME; use YAML::Syck; # XXX: HACK, HACK, HACK ... ! @@ -61,22 +61,18 @@ sub process : Local { $c->detach(); } - my $pgp = Crypt::OpenPGP->new( - KeyServer => $keyserver, - AutoKeyRetrieve => 1 - ); - my ( $long_id, $sig ) = $pgp->verify( Signature => $input ); - if ( !$nonce_data || !$sig ) { + my ( $result, $plain ) = Crypt::GpgME->new->verify( $input ); + + if ( !$nonce_data || !$plain ) { $c->flash( error => 'There was a problem verifying the signature.' ); $c->res->redirect( $c->uri_for('/login') ); $c->detach(); } - my $sig_ok = $sig && $long_id; - my $key_id = $sig->key_id; - my $nice_key_id = "0x" . substr( unpack( "H*", $key_id ), -8, 8 ); + my $sig_ok = $result && $plain; + my $id = $result->{signatures}->[0]->{fpr}; - $c->log->debug("keyid $nice_key_id ($long_id) is presumably logging in"); + $c->log->debug("keyid $id is presumably logging in"); eval { my $challenge = Load($nonce_data) @@ -85,9 +81,9 @@ sub process : Local { $c->session->{nonce} = undef; my $nonce_ok = ( $nonce == $challenge ); - $c->log->debug("$nice_key_id: nonce verified OK (was $challenge)") + $c->log->debug("$id: nonce verified OK (was $challenge)") if $nonce_ok; - $c->log->debug("$nice_key_id: Signature was valid") + $c->log->debug("$id: Signature was valid") if $sig_ok; die "bad nonce" if !$nonce_ok; @@ -95,14 +91,14 @@ sub process : Local { }; if ($@) { - $c->log->debug("Failed login for $nice_key_id: $@"); - $c->response->body("You cheating scum! You are NOT $nice_key_id!"); + $c->log->debug("Failed login for $id: $@"); + $c->response->body("You cheating scum! You are NOT $id!"); return; } my $user; eval { - $user = $c->model('UserStore')->get_user_by_real_id($key_id); + $user = $c->model('UserStore')->get_user_by_id($id); $c->model('UserStore')->refresh_user($user); }; if ($@) { @@ -117,7 +113,7 @@ sub process : Local { $c->session->{user} = $user; $c->log->debug( - "successful login for " . $user->fullname . "($nice_key_id)" ); + "successful login for " . $user->fullname . "($id)" ); $c->flash( message => "You are now logged in as ". $user->fullname ); $c->response->redirect( $c->uri_for('/') ); } lib/Angerwhale/Controller/Login.pm @@ -45,12 +45,12 @@ Return information about the current user sub current : Local { my ( $self, $c ) = @_; - my $user = $c->stash->{user}; # XXX: user + my $user = $c->stash->{user}; $user = Angerwhale::User::Anonymous->new if !$user; $c->{stash} = {}; - $c->stash->{user_id} = $user->nice_id; + $c->stash->{user_id} = $user->id; $c->stash->{fullname} = $user->fullname; $c->stash->{email} = $user->email; $c->stash->{login_uri}= q{}.$c->uri_for('/login'); lib/Angerwhale/Controller/Users.pm @@ -7,8 +7,6 @@ use YAML::Syck qw(LoadFile DumpFile); use Angerwhale::User; use File::Slurp qw(read_file write_file); use Carp; -use Crypt::OpenPGP::KeyRing; -use Crypt::OpenPGP::KeyServer; =head1 NAME @@ -18,10 +16,6 @@ Angerwhale::Model::UserStore - Manages Blog users. Keeps track of the blog's users. - my $pgp_id = "cafebabe"; - my $user = $c->model('UserStore')->get_user_by_nice_id($pgp_id); - print "$pgp_id is ". $user->fullname; - See also L<Angerwhale::User|Angerwhale::User>. Note that users are cached; they are refreshed from the keyserver according to the config's C<update_interval> in seconds. Defaults to one hour. @@ -54,9 +48,6 @@ Called by Catalyst to create and initialize userstore. =cut -# XXX: TODO: allow for storing duplicate keyids. keyids don't have to -# be unique. - sub new { my ( $self, $c ) = @_; $self = $self->next::method(@_); @@ -79,58 +70,33 @@ sub new { return $self; } -=head2 create_user_by_real_id - -=head2 create_user_by_nice_id +=head2 create_user_by_id -Creates a new user in the user store (by the OpenPGP keyid "cafebabe" -[nice] or the Crypt::OpenPGP representation of that number [real]). +Creates a new user in the user store Returns the C<Angerwhale::User> on success, exception on failure. =cut -sub create_user_by_real_id { - my $self = shift; - my $real_id = shift; - my $nice_id = unpack( 'H*', $real_id ); - - return $self->create_user_by_nice_id($nice_id); -} - -sub create_user_by_nice_id { - my $self = shift; - my $nice_id = shift; - return $self->get_user_by_nice_id($nice_id); +sub create_user_by_id { + my ( $self, $id ) = @_; + return $self->get_user_by_id($id); } -=head2 get_user_by_real_id - -=head2 get_user_by_nice_id +=head2 get_user_by_id Retrieves the user, creating it if necessary. =cut -sub get_user_by_real_id { - my $self = shift; - my $real_id = shift; - my $nice_id = unpack( 'H*', $real_id ); - - return $self->get_user_by_nice_id($nice_id); -} - -sub get_user_by_nice_id { - my $self = shift; - my $nice_id = shift; - my $real_id = pack( 'H*', $nice_id ); +sub get_user_by_id { + my ( $self, $id ) = @_; my $dir = $self->{users}; - my $base = "$dir/$nice_id"; + my $base = "$dir/$id"; my $user = {}; my $last_updated = 0; - $user->{nice_id} = $nice_id; - eval { $user->{public_key} = read_file("$base/key") }; + $user->{id} = $id; eval { $user->{fullname} = read_file("$base/fullname") }; eval { $user->{fingerprint} = read_file("$base/fingerprint") }; eval { $user->{email} = read_file("$base/email") }; @@ -142,7 +108,6 @@ sub get_user_by_nice_id { eval { _user_ok($user); }; if ( !$@ && !$outdated ) { - # refreshed OK return $user; } @@ -150,7 +115,6 @@ sub get_user_by_nice_id { # create a user if the data was bad # or it's time to update eval { - delete $user->{public_key}; delete $user->{fullname}; delete $user->{fingerprint}; delete $user->{email}; @@ -159,7 +123,7 @@ sub get_user_by_nice_id { _user_ok($user); }; - warn "could not refresh or retrieve user 0x$nice_id: $@" if $@; + warn "could not refresh or retrieve user $id: $@" if $@; die "user isnta a user" if !$user->isa('Angerwhale::User'); return $user; @@ -168,9 +132,8 @@ sub get_user_by_nice_id { sub _user_ok { my $user = shift; die "no name" if !$user->fullname; - die "no key" if !$user->public_key; die "no email" if !$user->email; - die "no fingerprint" if !$user->key_fingerprint; + die "no fingerprint" if !$user->id; return 1; } @@ -181,8 +144,7 @@ Refresh the user's details from the keyserver =cut sub refresh_user { - my $self = shift; - my $user = shift; + my ( $self, $user ) = @_; $user->refresh; $self->store_user($user); @@ -197,26 +159,23 @@ offline. =cut -# stores by nice id sub store_user { - my $self = shift; - my $user = shift; + my ( $self, $user ) = @_; my $dir = $self->{users}; - my $uid = $user->nice_id; + my $uid = $user->id; my $base = "$dir/$uid"; - mkdir $base if !-d $base; + mkdir $base if !-d $base; die "couldn't create userdir $base for $uid" if !-d $base; eval { - write_file( "$base/key", $user->public_key ); write_file( "$base/fullname", $user->fullname ); - write_file( "$base/fingerprint", $user->key_fingerprint ); + write_file( "$base/fingerprint", $user->id ); write_file( "$base/email", $user->email ); write_file( "$base/last_updated", time() ); }; if ($@) { - die "Error writing user: $!"; + die "Error writing user: $@"; } return 1; @@ -229,10 +188,10 @@ Returns the time of the most recent refresh of all users. =cut sub last_updated { - my $self = shift; - my $user = shift; + my ( $self, $user ) = @_; + my $dir = $self->{users}; - my $uid = $user->nice_id; + my $uid = $user->id; my $base = "$dir/$uid"; my $updated; @@ -249,13 +208,14 @@ about. The users are refreshed if they've expired. sub users { my $self = shift; + my $dir = $self->{users}; my @users; opendir( my $dirhandle, $dir ) or die "Couldn't open $dir for reading"; while ( my $uid = readdir $dirhandle ) { next if $uid =~ /^[.][.]?$/; # .. and . aren't users :) eval { - my $user = $self->get_user_by_nice_id($uid); + my $user = $self->get_user_by_id($uid); push @users, $user; }; } lib/Angerwhale/Model/UserStore.pm @@ -4,8 +4,7 @@ package Angerwhale::Signature; use strict; use warnings; -use Crypt::OpenPGP; -use Crypt::OpenPGP::Message; +use Crypt::GpgME; use Angerwhale::User::Anonymous; use File::Attributes qw(get_attribute set_attribute); use Carp; @@ -22,8 +21,8 @@ signed. sub signor { my $self = shift; - my ( $data, $sig ) = $self->_signed_text( $self->raw_text(1) ); - return $sig->key_id; + my ( $result, $plain ) = $self->_signed_text( $self->raw_text(1) ); + return lc($result->{signatures}->[0]->{fpr}); } =head2 signed @@ -61,7 +60,6 @@ sub signed { my $result = eval { - # XXX: Crypt::OpenPGP is really really slow, so cache the result my $signed = $self->_cached_signature; if ( defined $signed && $signed eq "yes" ) { @@ -82,36 +80,26 @@ sub signed { die "Bad signature"; } }; - if ($@) { - - #"Problem checking signature on ". $self->uri. ": $@"; - return 0; - } + return 0 if $@; return $result; } =head2 _check_signature($message) -Checks the OpenPGP signature on $message. Returns the real (binary) -key id if the signature is valid. Raises an exception on error. - -B<Warning: slow.> It is best to cache the result, if possible. +Checks the pgp signature on $message. Returns the fingerprint +if the signature is valid. Raises an exception on error. =cut sub _check_signature { my ( $self, $message ) = @_; - my $keyserver = $self->userstore->keyserver; - my $pgp = Crypt::OpenPGP->new( - KeyServer => $keyserver, - AutoKeyRetrieve => 1 - ); - my ( $id, $sig ) = $pgp->verify( Signature => $message ); - - die $pgp->errstr if !defined $id; - return $sig->key_id if $id; - return 0; # otherwise + + my ( $result, $plain ) = eval { Crypt::GpgME->new->verify( $message ) }; + + die "$@" if !defined $plain or $@; + + return $plain ? lc($result->{signatures}->[0]->{fpr}) : 0; } =head2 signed_text($message) @@ -119,41 +107,20 @@ sub _check_signature { Given PGP-signed $message, returns the plaintext of that message. Throws an exception on error. -In array context, returns an list (data, signature), where data is a -Crypt::OpenPGP::PlainText and signature isa Crypt::OpenPGP::Signature -ora Crypt::OpenPGP::OnePassSig. +In array context, returns an list (plain, result), where plain is a +plaintext representtion of $message and result is a hash containing +signature information =cut sub _signed_text { my ( $self, $message ) = @_; - my ( $data, $sig ); - - my $msg = Crypt::OpenPGP::Message->new( Data => $message ) - or croak "Reading message failed: " . Crypt::OpenPGP::Message->errstr; - - my @pieces = $msg->pieces; - if ( ref( $pieces[0] ) eq 'Crypt::OpenPGP::Compressed' ) { - $data = $pieces[0]->decompress - or die "Decompression error: " . $pieces[0]->errstr; - $msg = Crypt::OpenPGP::Message->new( Data => $data ) - or die "Reading decompressed data failed: " - . Crypt::OpenPGP::Message->errstr; - @pieces = $msg->pieces; - } - - if ( ref( $pieces[0] ) eq 'Crypt::OpenPGP::OnePassSig' ) { - ( $data, $sig ) = @pieces[ 1, 2 ]; - } - elsif ( ref( $pieces[0] ) eq 'Crypt::OpenPGP::Signature' ) { - ( $sig, $data ) = @pieces[ 0, 1 ]; - } - else { - croak "unable to read signature"; - } - - return ( $data, $sig ) if wantarray; - return $data->{data}; # otherwise, just the data + + my ( $result, $plain ) = eval { Crypt::GpgME->new->verify( $message ) }; + + croak "$@" if !defined $plain or $@; + + return wantarray ? ( $plain, $result ) : $plain; } =head1 _cached_signature @@ -185,11 +152,9 @@ sub _cache_signature { # and base the author on the signature sub _fix_author { - my $self = shift; - my $id = shift; - my $nice_key_id = unpack( "H*", $id ); + my ( $self, $id ) = @_; - set_attribute( $self->location, 'author', $nice_key_id ); + set_attribute( $self->location, 'author', $id ); } 1; lib/Angerwhale/Signature.pm @@ -4,8 +4,7 @@ package Angerwhale::User; use strict; use warnings; -use Crypt::OpenPGP::KeyServer; -use Crypt::OpenPGP::KeyRing; +use Crypt::GpgME; use Carp; =head1 SYNOPSIS @@ -24,20 +23,7 @@ the binary representation of that integer as a string of eight bytes) sub id { my $self = shift; - my $id = pack( 'H*', $self->nice_id ); -} - -=head2 nice_id - -Returns the ID of the key as a 64-bit hexadecimal representation -(i.e. 0x0f00b412cafebabe). The last four octets are what users think -the OpenPGP key id is. - -=cut - -sub nice_id { - my $self = shift; - return $self->{nice_id}; + return $self->{id}; } =head2 _keyserver @@ -54,60 +40,6 @@ sub _keyserver { return $self->{keyserver}; } -=head2 key - -Returns the Crypt::OpenPGP::Keyblock representing the user's public -key. - -B<NOTE>: Using this causes crashes, at least on my system during -testing. Be careful. - -=cut - -sub key { - my $self = shift; - my $ks = Crypt::OpenPGP::KeyServer->new( Server => $self->_keyserver ); - my $kb = $ks->find_keyblock_by_keyid( $self->id ); - - # try to get the key if we don't have it - - if ( !$kb ) { - carp "No public key found for " . $self->nice_id; - } - - return $kb; -} - -=head2 public_key - -Returns the ACSII-armoured OpenPGP public key block. - -=cut - -sub public_key { - my $self = shift; - my $key = shift; - - return $self->{public_key} if $self->{public_key}; - return $key->save_armoured; -} - -=head2 key_fingerprint - -Returns the 160-bit key fingerprint as a lowercase hex string. (Same -as what keyservers and GPG call the fingerprint.) - -=cut - -sub key_fingerprint { - my $self = shift; - my $key = shift; - return $self->{fingerprint} if $self->{fingerprint}; - - my $signer = $key->signing_key; - return unpack 'H*', $signer->fingerprint; -} - =head2 fullname Returns the full name associated with the primary UID. @@ -115,19 +47,14 @@ Returns the full name associated with the primary UID. =cut sub fullname { - my $self = shift; - my $key = shift; + my ( $self, $id ) = @_; + return $self->{fullname} if $self->{fullname}; - my $name = eval { - my @uids = @{ $key->{pkt}->{'Crypt::OpenPGP::UserID'} }; - my $uid = $uids[0]->id; # XXX: best idea? - $uid =~ s/\s*<.+>\s*//g; - $uid =~ s/\s*[(].+[)]\s*//g; - return ( $self->{fullname} = $uid ); - }; - return "Unknown Name" if ($@); - return $name; + $id ||= $self->{id}; + my $name = eval { return ( $self->{fullname} = [grep { !$_->{invalid} && !$_->{revoked} } Crypt::GpgME->new->get_key($id)->uids]->[0]->{name} ) }; + + return $@ ? 'Unknown Name' : $name; } =head2 email @@ -137,14 +64,14 @@ Returns the e-mail address associated with the primary UID. =cut sub email { - my $self = shift; - my $key = shift; + my ( $self, $id ) = @_; + return $self->{email} if defined $self->{email}; - my @uids = @{ $key->{pkt}->{"Crypt::OpenPGP::UserID"} }; - my $uid = $uids[0]->id; # XXX: best idea? - $uid =~ s/<(.+)>//g; - return $1; + $id ||= $self->{id}; + my $email = eval { return ( $self->{email} = [grep { !$_->{invalid} && !$_->{revoked} } Crypt::GpgME->new->get_key($id)->uids]->[0]->{email} ) }; + + return $@ ? 'Unknown Email' : $email; } =head2 photo @@ -164,16 +91,13 @@ Refreshes the key from the network. =cut sub refresh { - - # doesn't do anything anymore my $self = shift; - my $key = $self->key; # throws a good error on E_KEYNOTFOUND - $self->{public_key} = $self->public_key($key); - $self->{fullname} = $self->fullname($key); - $self->{email} = $self->email($key); - $self->{fingerprint} = $self->key_fingerprint($key); - # $self->{photo} = $self->photo($key); + my $id = $self->id; + $self->{fullname} = $self->fullname($id); + $self->{email} = $self->email($id); + $self->{fingerprint} = $self->id; +# $self->{photo} = $self->photo($id); } # only for testing @@ -181,7 +105,7 @@ sub _new { my ( $class, $id ) = @_; my $user = {}; die 'specify id' if !$id; - $user->{nice_id} = unpack( 'H*', $id ); + $user->{id} = $id; $user = bless $user, $class; $user->_keyserver('stinkfoot.org'); $user->refresh; lib/Angerwhale/User.pm @@ -20,10 +20,6 @@ User that is un authenticated, like slashdot's Anonymous Coward. Create a new user -=head2 nice_id - -0 - =head2 id 0 @@ -45,10 +41,6 @@ sub new { return bless $self, $class; } -sub nice_id { - return 0; -} - sub id { return 0; } lib/Angerwhale/User/Anonymous.pm @@ -101,7 +101,7 @@ sub serialize_item { $data->{author} = { name => $author->fullname, email => $author->email, - keyid => $author->nice_id, + keyid => $author->id, }; $data->{title} = $item->title; lib/Angerwhale/View/Feed.pm e7fbe33ce9b4de4b89735f2d9fc15d5aaed6bd77 arcanez justin.d.hunter@gmail.com http://github.com/arcanez/angerwhale/commit/5180f75e250d2c2106aa946bcac2854975557559 5180f75e250d2c2106aa946bcac2854975557559 2009-05-03T00:08:50-07:00 2009-05-03T00:08:50-07:00 move from Crypt::OpenPGP to Crypt::GpgME ** CAVEAT ** .users are stored against their fingerprint instead of $real_id or $nice_id you can remove your .users directory (and any .attributes in posts) and it should regenerate them downside is you will lose tags, but a perl -p -i -e could search/replace the old 'id' to the new one 342b106cd7923bf9bf216532f540becff6a7c4c7 arcanez justin.d.hunter@gmail.com