File Coverage

blib/lib/Crypt/DSA.pm
Criterion Covered Total %
statement 28 85 32.9
branch 0 24 0.0
condition 0 6 0.0
subroutine 10 15 66.6
pod 4 4 100.0
total 42 134 31.3


line stmt bran cond sub pod time code
1             package Crypt::DSA;
2              
3 3     3   52298 use 5.006;
  3         13  
  3         118  
4 3     3   18 use strict;
  3         4  
  3         113  
5 3     3   2981 use Digest::SHA1 qw( sha1 );
  3         3044  
  3         400  
6 3     3   19 use Carp qw( croak );
  3         6  
  3         317  
7 3     3   1751 use Crypt::DSA::KeyChain;
  3         10  
  3         184  
8 3     3   19 use Crypt::DSA::Key;
  3         6  
  3         59  
9 3     3   2445 use Crypt::DSA::Signature;
  3         8  
  3         99  
10 3     3   29 use Crypt::DSA::Util qw( bitsize bin2mp mod_inverse mod_exp makerandom );
  3         4  
  3         210  
11              
12 3     3   16 use vars qw( $VERSION );
  3         7  
  3         112  
13             BEGIN {
14 3     3   2534 $VERSION = '1.17';
15             }
16              
17             sub new {
18 0     0 1   my $class = shift;
19 0           my $dsa = bless { @_ }, $class;
20 0           $dsa->{_keychain} = Crypt::DSA::KeyChain->new(@_);
21 0           $dsa;
22             }
23              
24             sub keygen {
25 0     0 1   my $dsa = shift;
26 0           my $key = $dsa->{_keychain}->generate_params(@_);
27 0           $dsa->{_keychain}->generate_keys($key);
28 0           $key;
29             }
30              
31             sub sign {
32 0     0 1   my $dsa = shift;
33 0           my %param = @_;
34 0           my($key, $dgst);
35 0 0         croak __PACKAGE__, "->sign: Need a Key" unless $key = $param{Key};
36 0 0         unless ($dgst = $param{Digest}) {
37 0 0         croak __PACKAGE__, "->sign: Need either Message or Digest"
38             unless $param{Message};
39 0           $dgst = sha1($param{Message});
40             }
41 0           my $dlen = length $dgst;
42              
43 0           my $i = bitsize($key->q) / 8;
44 0 0 0       croak "Data too large for key size"
45             if $dlen > $i || $dlen > 50;
46              
47 0 0 0       $dsa->_sign_setup($key)
48             unless $key->kinv && $key->r;
49              
50 0           my $m = bin2mp($dgst);
51 0           my $xr = ($key->priv_key * $key->r) % $key->q;
52 0           my $s = $xr + $m;
53 0 0         $s -= $key->q if $s > $key->q;
54 0           $s = ($s * $key->kinv) % $key->q;
55              
56 0           my $sig = Crypt::DSA::Signature->new;
57 0           $sig->r($key->r);
58 0           $sig->s($s);
59 0           $sig;
60             }
61              
62             sub _sign_setup {
63 0     0     my $dsa = shift;
64 0           my $key = shift;
65 0           my($k, $r);
66             {
67 0           $k = makerandom(Size => bitsize($key->q));
  0            
68 0 0         $k -= $key->q if $k >= $key->q;
69 0 0         redo if $k == 0;
70             }
71 0           $r = mod_exp($key->g, $k, $key->p);
72 0           $r %= $key->q;
73 0           my $kinv = mod_inverse($k, $key->q);
74 0           $key->r($r);
75 0           $key->kinv($kinv);
76             }
77              
78             sub verify {
79 0     0 1   my $dsa = shift;
80 0           my %param = @_;
81 0           my($key, $dgst, $sig);
82 0 0         croak __PACKAGE__, "->verify: Need a Key" unless $key = $param{Key};
83 0 0         unless ($dgst = $param{Digest}) {
84 0 0         croak __PACKAGE__, "->verify: Need either Message or Digest"
85             unless $param{Message};
86 0           $dgst = sha1($param{Message});
87             }
88 0 0         croak __PACKAGE__, "->verify: Need a Signature"
89             unless $sig = $param{Signature};
90 0           my $u2 = mod_inverse($sig->s, $key->q);
91 0           my $u1 = bin2mp($dgst);
92 0           $u1 = ($u1 * $u2) % $key->q;
93 0           $u2 = ($sig->r * $u2) % $key->q;
94 0           my $t1 = mod_exp($key->g, $u1, $key->p);
95 0           my $t2 = mod_exp($key->pub_key, $u2, $key->p);
96 0           $u1 = ($t1 * $t2) % $key->p;
97 0           $u1 %= $key->q;
98 0           $u1 == $sig->r;
99             }
100              
101             1;
102              
103             __END__