Authen::TypeKey - TypeKey authentication verification

    use CGI;
    use Authen::TypeKey;
    my $q = CGI->new;
    my $tk = Authen::TypeKey->new;
    $tk->token('typekey-token');
    my $res = $tk->verify($q) or die $tk->errstr;

# $Id: TypeKey.pm 1915 2006-02-06 06:26:33Z btrott $

package Authen::TypeKey;
use strict;
use base qw( Class::ErrorHandler );

use Math::BigInt lib => 'GMP,Pari';
use MIME::Base64 qw( decode_base64 );
use Digest::SHA1 qw( sha1 );
use LWP::UserAgent;
use HTTP::Status qw( RC_NOT_MODIFIED );

our $VERSION = '0.05';

sub new {
    my $class = shift;
    my $tk = bless { }, $class;
    $tk->skip_expiry_check(0);
    $tk->expires(600);
    $tk->key_url('http://www.typekey.com/extras/regkeys.txt');
    $tk->version(1.1);
    $tk->token('');
    $tk;
}

sub _var {
    my $tk = shift;
    my $var = shift;
    $tk->{$var} = shift if @_;
    $tk->{$var};
}

sub key_cache         { shift->_var('key_cache',         @_) }
sub skip_expiry_check { shift->_var('skip_expiry_check', @_) }
sub expires           { shift->_var('expires',           @_) }
sub key_url           { shift->_var('key_url',           @_) }
sub token             { shift->_var('token',             @_) }
sub version           { shift->_var('version',           @_) }
sub ua                { shift->_var('ua',                @_) }

sub verify {
    my $tk = shift;
    my($email, $username, $name, $ts, $sig);
    if (@_ == 1) {
        my $q = $_[0];
        if (ref $q eq 'HASH') {
            ($email, $username, $name, $ts, $sig) = map $_[0]->{$_},
                qw( email name nick ts sig );
        } else {
            ($email, $username, $name, $ts, $sig) = map $q->param($_),
                qw( email name nick ts sig );
        }
    } else {
        ## Later we could process arguments passed in a hash.
        return $tk->error("usage: verify(\$query)");
    }
    for ($email, $sig) {
        tr/ /+/;
    }
    return $tk->error("TypeKey data has expired")
        unless $tk->skip_expiry_check || $ts + $tk->expires >= time;
    my $key = $tk->_fetch_key($tk->key_url) or return;
    my($r, $s) = split /:/, $sig;
    return $tk->error("Invalid signature $sig") unless $r && $s;
    $sig = {};
    $sig->{r} = Math::BigInt->new("0b" . unpack("B*", decode_base64($r)));
    $sig->{s} = Math::BigInt->new("0b" . unpack("B*", decode_base64($s)));
    my $msg = join '::', $email, $username, $name, $ts,
        $tk->version >= 1.1 ? ($tk->token) : ();
    unless ($tk->_verify($msg, $key, $sig)) {
        return $tk->error("TypeKey signature verification failed");
    }
    { name => $username,
      nick => $name,
      email => $email,
      ts => $ts };
}

sub _verify {
    my $tk = shift;
    my($msg, $key, $sig) = @_;
    my $u1 = Math::BigInt->new("0b" . unpack("B*", sha1($msg)));
    $sig->{s}->bmodinv($key->{q});
    $u1 = ($u1 * $sig->{s}) % $key->{q};
    $sig->{s} = ($sig->{r} * $sig->{s}) % $key->{q};
    $key->{g}->bmodpow($u1, $key->{p});
    $key->{pub_key}->bmodpow($sig->{s}, $key->{p});
    $u1 = ($key->{g} * $key->{pub_key}) % $key->{p};
    $u1 %= $key->{q};
    $u1 == $sig->{r};
}

sub _fetch_key {
    my $tk = shift;
    my($uri) = @_;
    my $cache = $tk->key_cache;
    ## If it's a callback, call it and return the return value.
    return $cache->($tk, $uri) if $cache && ref($cache) eq 'CODE';
    ## Otherwise, load the key.
    my $data;
    my $ua = $tk->ua || LWP::UserAgent->new;
    if ($cache) {
        my $res = $ua->mirror($uri, $cache);
        return $tk->error("Failed to fetch key: " . $res->status_line)
            unless $res->is_success || $res->code == RC_NOT_MODIFIED;
        open my $fh, $cache
            or return $tk->error("Can't open $cache: $!");
        $data = do { local $/; <$fh> };
        close $fh;
    } else {
        my $res = $ua->get($uri);
        return $tk->error("Failed to fetch key: " . $res->status_line)
            unless $res->is_success;
        $data = $res->content;
    }
    chomp $data;
    my $key = {};
    for my $f (split /\s+/, $data) {
        my($k, $v) = split /=/, $f, 2;
        $key->{$k} = Math::BigInt->new($v);
    }
    $key;
}

1;
__END__