File Coverage

blib/lib/Crypt/HashCash/Mint.pm

Criterion	Covered	Total	%
statement	9	11	81.8
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	13	15	86.6

# -*-cperl-*-
#
# Crypt::HashCash::Mint - Mint for HashCash Digital Cash
# Copyright (c) 2001-2017 Ashish Gulhati
#
# $Id: lib/Crypt/HashCash/Mint.pm v1.126 Sat Jun 24 02:15:18 PDT 2017 $

package Crypt::HashCash::Mint;

use 5.008001;
use warnings;
use strict;

use Crypt::RSA::Blind;
use Crypt::ECDSA::Blind;
use Compress::Zlib;
use Persistence::Object::Simple;
use vars qw( $VERSION $AUTOLOAD );
use DBI;

our ( $VERSION ) = '$Revision: 1.126 $' =~ /\s+([\d\.]+)/;

sub new {
  my $class = shift;
  my %arg = @_;
  my $self = bless { VERSION        =>   "Crypt::HashCash::Mint v$VERSION",
		     RSAB           =>   new Crypt::RSA::Blind,
		     ECDSAB         =>   new Crypt::ECDSA::Blind (Create => 1),
		     SIGSCHEME      =>   'ECDSA',
		     COMMENT        =>   '',
		     DEBUG          =>   $arg{Debug} || 0,
		     KEYSIZE        =>   1024,
		     KEYDB          =>   $arg{KeyDB} || '/tmp/vault.key',
		     DENOMS         =>   [qw(100 200 500 1000 2000 5000 10000 20000 50000 100000 200000
					     500000 1000000 2000000 5000000 10000000 20000000 50000000
					     100000000 200000000 500000000 1000000000)],
		     DB             =>   $arg{DB}
		   }, $class;
  return unless my $keydb = new Persistence::Object::Simple ('__Fn' => $self->keydb); $self->keydb($keydb);
  my $db = $self->db;
  unless ($db) {
    unlink $arg{SpentDB} if defined $arg{SpentDB} and $arg{SpentDB} ne ':memory:' and $arg{Clobber};
    return unless $db = DBI->connect("dbi:SQLite:dbname=$arg{SpentDB}", undef, undef, {AutoCommit => 1});
    $self->{DB} = $db;
  }
  my @tables = $db->tables('%','%','spent','TABLE');
  unless ($tables[0]) {
    if ($arg{Create}) {
      return undef unless $db->do('CREATE TABLE spent (id text NOT NULL,
                                                       denom int NOT NULL,
		                                       spent int NOT NULL
		                                      );');
      return undef unless $db->do('CREATE INDEX idx_spent_id ON spent(id);');
    }
    else {
      return undef;
    }
  }
  return $self;
}

sub keygen {
  my $self = shift;
  $self->_diag("MINT: keygen\n");
  my (%skey, %pkey);
  for (@{$self->denoms}) {
    $self->_diag("MINT: keygen for denom $_\n");
    my ($pk, $sk) = $self->signer->keygen (
					   Identity  => "HashCash $_",
					   Size      => $self->keysize,
					   Verbosity => $self->debug,
					  ) or die "Error creating key for denomination $_";
      $skey{$_} = $sk; $pkey{$_} = $pk;
      $self->keydb->{sec}->{$_} = $sk->as_hex; $self->keydb->{pub}->{$_} = $pk->as_hex;
  }
  $self->keydb->commit;
  $self->skeys(\%skey); $self->pkeys(\%pkey);
}

sub loadkeys {
  my $self = shift;
  $self->_diag("MINT: loadkeys\n");
  my (%skey, %pkey);
  my $sigmod = 'Crypt::' . $self->sigscheme . '::Blind';
  no strict 'refs';
  for (@{$self->denoms}) {
    $skey{$_} = &{$sigmod.'::SecKey::from_hex'}($self->keydb->{sec}->{$_});
    $pkey{$_} = &{$sigmod.'::PubKey::from_hex'}($self->keydb->{pub}->{$_});
  }
  $self->skeys(\%skey); $self->pkeys(\%pkey);
}

sub init {
  my $self = shift;
  $self->_diag("MINT: init\n");
  $self->signer->init;
}

sub mint_coin {
  my ($self,$req) = @_;
  return unless $req; return unless defined $self->skeys->{$req->{D}};
  $self->_diag ("MINT: mint_coin\nD: $req->{D}\n");
  return unless my $coin = $self->signer->sign(Key => $self->skeys->{$req->{D}}, Message => $req->{R}, Init => $req->{Init});
  $self->_diag ("req: $req->{R}\ncoin: $coin\n");
  return ( bless { C => "$coin", D => $req->{D}, Init => $req->{Init} }, 'Crypt::HashCash::Coin::Blinded' );
}

sub verify_coin {
  my ($self, $coin) = @_;
  return unless ref $coin eq 'Crypt::HashCash::Coin' and defined $self->pkeys->{$coin->{D}};
  $self->_diag ("MINT: verify_coin\ncoin: $coin->{Z}\nX: $coin->{X}\nD: $coin->{D}\n");
  # Check if coin already spent, and if signature is valid
  return 0 if $self->db->selectcol_arrayref("SELECT spent from spent WHERE id='$coin->{X}' and denom='$coin->{D}';")->[0];
  return 0 unless $self->signer->verify(Key => $self->pkeys->{$coin->{D}}, Signature => $coin->{Z}, Message => $coin->{X});
  # Valid, unspent coin
  return 1;
}

sub spend_coin {
  my ($self, $coin) = @_;
  return unless ref $coin eq 'Crypt::HashCash::Coin' and $coin->is_valid and defined $self->pkeys->{$coin->{D}};
  $self->_diag ("MINT: spend_coin\ncoin: $coin->{Z}\nX: $coin->{X}\nD: $coin->{D}\n");
  my $timestamp = time;
  $self->db->begin_work;
  # First check if coin already spent, so we don't waste time verifying if double-spend
  $self->db->rollback, return 0 if $self->db->selectcol_arrayref("SELECT spent from spent WHERE id='$coin->{X}' and denom='$coin->{D}';")->[0];
  # Unspent coin, add to DB
  $self->db->do("INSERT INTO spent values ('$coin->{X}', '$coin->{D}', '$timestamp');");
  # Verify coin
  $self->db->rollback, return 0 unless $self->signer->verify(Key => $self->pkeys->{$coin->{D}}, Signature => $coin->{Z}, Message => $coin->{X});
  $self->db->commit;
  return 1;
}

sub unspend_coin {
  my ($self, $coin) = @_;
  return unless ref $coin eq 'Crypt::HashCash::Coin' and $coin->is_valid and defined $self->pkeys->{$coin->{D}};
  $self->_diag ("MINT: unspend_coin\ncoin: $coin->{Z}\nX: $coin->{X}\nD: $coin->{D}\n");
  $self->db->do("DELETE from spent WHERE id='$coin->{X}' and denom='$coin->{D}';");
}

sub _diag {
  my $self = shift;
  print STDERR @_ if $self->debug;
}

sub AUTOLOAD {
  my $self = shift; (my $auto = $AUTOLOAD) =~ s/.*:://;
  return if $auto eq 'DESTROY';
  if ($auto =~ /^((s|p)keys|rsab|ecdsab|keysize|debug|version|comment|spentdb|keydb|units|sigscheme)$/x) {
    $self->{"\U$auto"} = shift if (defined $_[0]);
  }
  if ($auto =~ /^((s|p)keys|rsab|ecdsab|keysize|debug|version|comment|spentdb|keydb|units|denoms|db|sigscheme)$/x) {
    return $self->{"\U$auto"};
  }
  if ($auto eq 'signer') {
    $self->sigscheme eq 'RSA' ? $self->rsab : $self->ecdsab;
  }
  else {
    die "Could not AUTOLOAD method $auto.";
  }
}

sub Crypt::RSA::Key::Private::as_hex {
  unpack('H*', compress(shift->serialize));
}

sub Crypt::RSA::Key::Public::as_hex {
  unpack('H*', compress(shift->serialize));
}

1;

__END__