Crypt-HashCash

 view release on metacpan or  search on metacpan

bin/hashcash.pl  view on Meta::CPAN

		    gr => [qw(0008 0408)],
		    hi => [qw(0039 0439)],
		    it => [qw(0010 0410 0810)],
		    ja => [qw(0011 0411)],
		    kr => [qw(0012 0412)],
		    ru => [qw(0019 0819 0419)],
		    zh => [qw(0004 7804 0804 1004 7c04 0c04 1404 0404)]
		  );
    require Win32::API;
    Win32::API->Import('kernel32', 'int GetUserDefaultLCID()');
    my $langid = GetUserDefaultLCID();
    for my $l (keys %winlang) {
      $lang = $l, last if grep { sprintf("%04x",$langid) eq $_ } @{$winlang{$l}};
    }
#    print STDERR "$lang\n";
  }
  else {
    $lang = $ENV{LC_ALL} || $ENV{LANG};
  }
  $lang = 'en' unless defined $lang;
  $lang = 'en' if $lang =~ /^C|POSIX/;
  $lang = substr($lang, 0, 2) || 'en';
  return ($lang, %lang);

lib/Crypt/HashCash/Client.pm  view on Meta::CPAN

  return unless ref $coin eq 'Crypt::HashCash::Coin';
  $self->_diag ("coin: $coin->{Z}\nX: $coin->{X}\nD: $coin->{D}\n");
  my $signer = $self->sigscheme eq 'RSA' ? $self->rsab : $self->ecdsab;
  $signer->verify(Key => $self->mintkeys->{$coin->{D}}, Signature => $coin->{Z}, Message => $coin->{X});
}

sub turingimg {         # Get turing image
  my $self = shift;
  my $res = $self->msgvault('hi');
  return undef if !$res or $res =~ /^-ERR/;
  my ($turingid, $turing) = split / /, $res;
  $self->turingid($turingid);
  my $turingimage = pack('H*',$turing);
}

sub cancelturing {
  my $self = shift;
  $self->msgvault('dt ' . $self->turingid);
}

sub getaddress {
  my ($self, %arg) = @_;
  my $res = $self->msgvault('id ' . $self->turingid . " $arg{Turing} $arg{Amt} $arg{Numcoins}");
  return undef if !$res or $res =~ /^-ERR/;
  return $res;
}

sub initbuy {           # Initializa a buy
  my ($self, %arg) = @_;
  my $res = $self->msgvault("id $arg{Address} $arg{Amt} $arg{Numcoins}");
  return undef if !$res or $res =~ /^-ERR/;
  return $res if $res =~ /^-E/;
  my $inits = [ split / /, $res ]

lib/Crypt/HashCash/Client.pm  view on Meta::CPAN

}

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 =~ /^(vaultconf|vaultkey|mintkeys|xsize|debug|version|hash|rsab|ecdsab|denoms|keydb|sigscheme|turingid|frame|offline)$/x) {
    $self->{"\U$auto"} = shift if (defined $_[0]);
    return $self->{"\U$auto"};
  }
  else {
    die "Could not AUTOLOAD method $auto.";
  }
}

1; # End of Crypt::HashCash::Client

lib/Crypt/HashCash/Vault/Bitcoin.pm  view on Meta::CPAN

                                                                    type TEXT,
		                                                    amount INTEGER NOT NULL,
                                                                    reqid INTEGER UNIQUE,
		                                                    timestamp INTEGER NOT NULL,
                                                                    fee INT
		                                                   );');
  }
  @tables = $bizbtc->db->tables('%','%','turingtests','TABLE');
  unless ($tables[0]) {
    return undef unless $bizbtc->db->do('CREATE TABLE turingtests (
		                                                   turingid INTEGER UNIQUE,
                                                                   string TEXT
		                                                  );');
  }
  @tables = $bizbtc->db->tables('%','%','exchanges','TABLE');
  unless ($tables[0]) {
    return undef unless $bizbtc->db->do('CREATE TABLE exchanges (
		                                                 init TEXT UNIQUE,
                                                                 params TEXT
		                                                );');
  }

lib/Crypt/HashCash/Vault/Bitcoin.pm  view on Meta::CPAN

  $keydb->{vaultsec} = unpack('H*',$sk);
  $keydb->{vaultpub} = $vaultcfg->{vaultpub} = unpack('H*',$pk);
  $keydb->{id} = $vaultcfg->{id} = "$vaultid";
  $keydb->{fees} = $vaultcfg->{fees} = $arg{Fees};
  $keydb->commit; $vaultcfg->commit;
}

sub turingimg {
  my $self = shift;
  my $turing = new Authen::TuringImage; my ($img, $string) = $turing->challenge;
  my $turingid = makerandom( Size => 32, Strength => 0 );

  $self->_diag("INSERT INTO turingtests values ('$turingid', '$string');");
  unless ($self->bizbtc->db->do("INSERT INTO turingtests values ($turingid, '$string');")) {
    $self->_diag("INSERT INTO turingtests values ('$turingid', '$string');");
    # TODO: log an error and tx details
  }
  return ($turingid, $img);
}

sub predeposit {
  my ($self, %arg) = @_;
  my $query = "SELECT string from turingtests WHERE turingid='$arg{TuringID}';";
  return '-ENOTURING' unless my ($string) = $self->bizbtc->db->selectrow_array($query);
  $self->bizbtc->db->do("DELETE FROM turingtests WHERE turingid='$arg{TuringID}';");
  return '-ETURINGMISMATCH' unless $string eq $arg{TuringString};
  my $btcreq = $self->bizbtc->request(Amount => $arg{Amount});
  return $btcreq->address;
}

sub initdeposit {
  my ($self, %arg) = @_;
  return '-ENOADDRESS' unless $arg{Address};
  return '-EADDRESS' unless my $btcreq = $self->bizbtc->findreq(Address => $arg{Address});
  return '-EVERIFY' unless ($arg{Offline} ? $btcreq->verify_serial : $btcreq->verify);

lib/Crypt/HashCash/Vault/Bitcoin.pm  view on Meta::CPAN

  return $ret;
}

sub process_request {                                 # Hande a request from a client
  my ($self, $ret, $preret, $sendto, $sendamt) = (shift);
  $_ = shift; my $offline = shift;
  if (/^ping$/) {                                     # Ping
    $ret = 'pong';
  }
  elsif (/^hi$/) {                                    # Handshake to begin Deposit ( BTC > [#] ) - Send Turing Image
    my ($turingid, $turingimg) = $self->turingimg;
    $ret = $turingid . ' ' . (unpack 'H*',$turingimg->png);
  }
  elsif (/^dt (\d+)$/) {
    $ret = $self->predeposit(TuringID => $1, TuringString => '');
  }
  elsif (/^id (\d+) (\S+) (\d+) (\d+)$/) {            # Pre-Init Deposit ( BTC > [#] ) - Check Turing string, send BTC address
    $ret = $self->predeposit(TuringID => $1, TuringString => $2, Amount => $3, NumCoins => $4);
  }
  elsif (/^id (\S+) (\d+) (\d+)$/) {                  # Initialise Deposit - Check deposit, send init vectors
    if (my $inits = $self->initdeposit(Address => $1, Amount => $2, NumCoins => $3, Offline => $offline)) {
      $ret = $inits =~ /^-E/ ? $inits : "@$inits";