util/hmac_sha1.pl

   1 #!/usr/bin/env perl
   2 #
   3 # Copyright (c) 2011 The OpenSSL Project.
   4 #
   5 ######################################################################
   6 #
   7 # SHA1 and HMAC in Perl by <appro@openssl.org>.
   8 #
   9 { package SHA1;
  10   use integer;
  11
  12     {
  13     ################################### SHA1 block code generator
  14     my @V = ('$A','$B','$C','$D','$E');
  15     my $i;
  16
  17     sub XUpdate {
  18       my $ret;
  19         $ret="(\$T=\$W[($i-16)%16]^\$W[($i-14)%16]^\$W[($i-8)%16]^\$W[($i-3)%16],\n\t";
  20         if ((1<<31)<<1) {
  21             $ret.="    \$W[$i%16]=((\$T<<1)|(\$T>>31))&0xffffffff)\n\t  ";
  22         } else {
  23             $ret.="    \$W[$i%16]=(\$T<<1)|((\$T>>31)&1))\n\t  ";
  24         }
  25     }
  26     sub tail {
  27       my ($a,$b,$c,$d,$e)=@V;
  28       my $ret;
  29         if ((1<<31)<<1) {
  30             $ret.="(($a<<5)|($a>>27));\n\t";
  31             $ret.="$b=($b<<30)|($b>>2); $e&=0xffffffff; #$b&=0xffffffff;\n\t";
  32         } else {
  33             $ret.="(($a<<5)|($a>>27)&0x1f);\n\t";
  34             $ret.="$b=($b<<30)|($b>>2)&0x3fffffff;\n\t";
  35         }
  36       $ret;
  37     }
  38     sub BODY_00_15 {
  39         my ($a,$b,$c,$d,$e)=@V;
  40         "$e+=\$W[$i]+0x5a827999+((($c^$d)&$b)^$d)+".tail();
  41     }
  42     sub BODY_16_19 {
  43         my ($a,$b,$c,$d,$e)=@V;
  44         "$e+=".XUpdate()."+0x5a827999+((($c^$d)&$b)^$d)+".tail();
  45     }
  46     sub BODY_20_39 {
  47         my ($a,$b,$c,$d,$e)=@V;
  48         "$e+=".XUpdate()."+0x6ed9eba1+($b^$c^$d)+".tail();
  49     }
  50     sub BODY_40_59 {
  51         my ($a,$b,$c,$d,$e)=@V;
  52         "$e+=".XUpdate()."+0x8f1bbcdc+(($b&$c)|(($b|$c)&$d))+".tail();
  53     }
  54     sub BODY_60_79 {
  55         my ($a,$b,$c,$d,$e)=@V;
  56         "$e+=".XUpdate()."+0xca62c1d6+($b^$c^$d)+".tail();
  57     }
  58
  59     my $sha1_impl =
  60     'sub block {
  61         my $self = @_[0];
  62         my @W    = unpack("N16",@_[1]);
  63         my ($A,$B,$C,$D,$E,$T) = @{$self->{H}};
  64         ';
  65
  66         $sha1_impl.='
  67         $A &= 0xffffffff;
  68         $B &= 0xffffffff;
  69         ' if ((1<<31)<<1);
  70
  71         for($i=0;$i<16;$i++){ $sha1_impl.=BODY_00_15(); unshift(@V,pop(@V)); }
  72         for(;$i<20;$i++)    { $sha1_impl.=BODY_16_19(); unshift(@V,pop(@V)); }
  73         for(;$i<40;$i++)    { $sha1_impl.=BODY_20_39(); unshift(@V,pop(@V)); }
  74         for(;$i<60;$i++)    { $sha1_impl.=BODY_40_59(); unshift(@V,pop(@V)); }
  75         for(;$i<80;$i++)    { $sha1_impl.=BODY_60_79(); unshift(@V,pop(@V)); }
  76
  77         $sha1_impl.='
  78         $self->{H}[0]+=$A;      $self->{H}[1]+=$B;      $self->{H}[2]+=$C;
  79         $self->{H}[3]+=$D;      $self->{H}[4]+=$E;      }';
  80
  81     #print $sha1_impl,"\n";
  82     eval($sha1_impl);           # generate code
  83     }
  84
  85     sub Init {
  86         my $class = shift;      # multiple instances...
  87         my $self  = {};
  88
  89         bless $self,$class;
  90         $self->{H} = [0x67452301,0xefcdab89,0x98badcfe,0x10325476,0xc3d2e1f0];
  91         $self->{N} = 0;
  92         return $self;
  93     }
  94
  95     sub Update {
  96         my $self = shift;
  97         my $msg;
  98
  99         foreach $msg (@_) {
 100             my $len  = length($msg);
 101             my $num  = length($self->{buf});
 102             my $off  = 0;
 103
 104             $self->{N} += $len;
 105
 106             if (($num+$len)<64)
 107             {   $self->{buf} .= $msg; next;     }
 108             elsif ($num)
 109             {   $self->{buf} .= substr($msg,0,($off=64-$num));
 110                 $self->block($self->{buf});
 111             }
 112
 113             while(($off+64) <= $len)
 114             {   $self->block(substr($msg,$off,64));
 115                 $off += 64;
 116             }
 117
 118             $self->{buf} = substr($msg,$off);
 119         }
 120         return $self;
 121     }
 122
 123     sub Final {
 124         my $self = shift;
 125         my $num  = length($self->{buf});
 126
 127         $self->{buf} .= chr(0x80); $num++;
 128         if ($num>56)
 129         {   $self->{buf} .= chr(0)x(64-$num);
 130             $self->block($self->{buf});
 131             $self->{buf}=undef;
 132             $num=0;
 133         }
 134         $self->{buf} .= chr(0)x(56-$num);
 135         $self->{buf} .= pack("N2",($self->{N}>>29)&0x7,$self->{N}<<3);
 136         $self->block($self->{buf});
 137
 138         return pack("N*",@{$self->{H}});
 139     }
 140
 141     sub Selftest {
 142         my $hash;
 143
 144         $hash=SHA1->Init()->Update('abc')->Final();
 145         die "SHA1 test#1" if (unpack("H*",$hash) ne 'a9993e364706816aba3e25717850c26c9cd0d89d');
 146
 147         $hash=SHA1->Init()->Update('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq')->Final();
 148         die "SHA1 test#2" if (unpack("H*",$hash) ne '84983e441c3bd26ebaae4aa1f95129e5e54670f1');
 149
 150         #$hash=SHA1->Init()->Update('a'x1000000)->Final();
 151         #die "SHA1 test#3" if (unpack("H*",$hash) ne '34aa973cd4c4daa4f61eeb2bdbad27316534016f');
 152     }
 153 }
 154
 155 { package HMAC;
 156
 157     sub Init {
 158         my $class = shift;
 159         my $key   = shift;
 160         my $self  = {};
 161
 162         bless $self,$class;
 163
 164         if (length($key)>64) {
 165             $key = SHA1->Init()->Update($key)->Final();
 166         }
 167         $key .= chr(0x00)x(64-length($key));
 168
 169         my @ikey = map($_^=0x36,unpack("C*",$key));
 170         ($self->{hash} = SHA1->Init())->Update(pack("C*",@ikey));
 171          $self->{okey} = pack("C*",map($_^=0x36^0x5c,@ikey));
 172
 173         return $self;
 174     }
 175
 176     sub Update {
 177         my $self = shift;
 178         $self->{hash}->Update(@_);
 179         return $self;
 180     }
 181
 182     sub Final {
 183         my $self  = shift;
 184         my $ihash = $self->{hash}->Final();
 185         return SHA1->Init()->Update($self->{okey},$ihash)->Final();
 186     }
 187
 188     sub Selftest {
 189         my $hmac;
 190
 191         $hmac = HMAC->Init('0123456789:;<=>?@ABC')->Update('Sample #2')->Final();
 192         die "HMAC test" if (unpack("H*",$hmac) ne '0922d3405faa3d194f82a45830737d5cc6c75d24');
 193     }
 194 }
 195
 196 1;