Girocco/HashUtil.pm

   1 # Girocco::HashUtil.pm -- HMAC SHA-1 Utility Functions
   2 # Copyright (C) 2013,2020,2021 Kyle J. McKay.
   3 # All rights reserved.
   4
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 package Girocco::HashUtil;
  20
  21 use strict;
  22 use warnings;
  23
  24 use base qw(Exporter);
  25 our @EXPORT;
  26 our $VERSION;
  27
  28 BEGIN {
  29         @EXPORT = qw(hmac_sha1 crypt_sha1 scrypt_sha1);
  30         *VERSION = \'1.0';
  31 }
  32
  33 use MIME::Base64;
  34 my $have_sha_hmac_sha1;
  35 BEGIN {
  36         eval {
  37                 require Digest::SHA;
  38                 Digest::SHA->import(
  39                         qw(sha1 hmac_sha1)
  40         );$have_sha_hmac_sha1=1;1} ||
  41         eval {
  42                 require Digest::SHA1;
  43                 Digest::SHA1->import(
  44                         qw(sha1)
  45         );1} ||
  46         eval {
  47                 require Digest::SHA::PurePerl;
  48                 Digest::SHA::PurePerl->import(
  49                         qw(sha1)
  50         );1} ||
  51         die "One of Digest::SHA or Digest::SHA1 or Digest::SHA::PurePerl "
  52         . "must be available\n";
  53 }
  54
  55 # Like MIME::Base64::encode except that the crypt Base64 string is used
  56 # instead and no \n or = characters are generated and each 4-character output
  57 # sequence is reversed.  To make the input an even multiple of 3-character
  58 # sequences, the first 1 or 2 bytes of it may be repeated on the end.
  59 sub _encode_base64_alt {
  60         use bytes;
  61         my $val = defined($_[0]) ? $_[0] : '';
  62         my $l = length($val);
  63         my $r;
  64         $l == 1 and $val .= $val.$val;
  65         $l > 1 and $r = $l % 3 and $val .= substr($val,0,3-$r);
  66         my $b64 = encode_base64($val, '');
  67         # convert standard base 64 encoding to the alternate crypt encoding
  68         $b64 =~ tr{ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/}
  69                   {./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz};
  70         my $out = '';
  71         $l = length($b64);
  72         my $i = 0;
  73         $out .= reverse(substr($b64,$i,4)), $i += 4 while $i < $l;
  74         return $out;
  75 }
  76
  77 sub _xor36 {use bytes; $_[0]=~tr
  78 {\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff}
  79 {\x36\x37\x34\x35\x32\x33\x30\x31\x3e\x3f\x3c\x3d\x3a\x3b\x38\x39\x26\x27\x24\x25\x22\x23\x20\x21\x2e\x2f\x2c\x2d\x2a\x2b\x28\x29\x16\x17\x14\x15\x12\x13\x10\x11\x1e\x1f\x1c\x1d\x1a\x1b\x18\x19\x06\x07\x04\x05\x02\x03\x00\x01\x0e\x0f\x0c\x0d\x0a\x0b\x08\x09\x76\x77\x74\x75\x72\x73\x70\x71\x7e\x7f\x7c\x7d\x7a\x7b\x78\x79\x66\x67\x64\x65\x62\x63\x60\x61\x6e\x6f\x6c\x6d\x6a\x6b\x68\x69\x56\x57\x54\x55\x52\x53\x50\x51\x5e\x5f\x5c\x5d\x5a\x5b\x58\x59\x46\x47\x44\x45\x42\x43\x40\x41\x4e\x4f\x4c\x4d\x4a\x4b\x48\x49\xb6\xb7\xb4\xb5\xb2\xb3\xb0\xb1\xbe\xbf\xbc\xbd\xba\xbb\xb8\xb9\xa6\xa7\xa4\xa5\xa2\xa3\xa0\xa1\xae\xaf\xac\xad\xaa\xab\xa8\xa9\x96\x97\x94\x95\x92\x93\x90\x91\x9e\x9f\x9c\x9d\x9a\x9b\x98\x99\x86\x87\x84\x85\x82\x83\x80\x81\x8e\x8f\x8c\x8d\x8a\x8b\x88\x89\xf6\xf7\xf4\xf5\xf2\xf3\xf0\xf1\xfe\xff\xfc\xfd\xfa\xfb\xf8\xf9\xe6\xe7\xe4\xe5\xe2\xe3\xe0\xe1\xee\xef\xec\xed\xea\xeb\xe8\xe9\xd6\xd7\xd4\xd5\xd2\xd3\xd0\xd1\xde\xdf\xdc\xdd\xda\xdb\xd8\xd9\xc6\xc7\xc4\xc5\xc2\xc3\xc0\xc1\xce\xcf\xcc\xcd\xca\xcb\xc8\xc9}
  80 }
  81
  82 sub _xor5C {use bytes; $_[0]=~tr
  83 {\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff}
  84 {\x5c\x5d\x5e\x5f\x58\x59\x5a\x5b\x54\x55\x56\x57\x50\x51\x52\x53\x4c\x4d\x4e\x4f\x48\x49\x4a\x4b\x44\x45\x46\x47\x40\x41\x42\x43\x7c\x7d\x7e\x7f\x78\x79\x7a\x7b\x74\x75\x76\x77\x70\x71\x72\x73\x6c\x6d\x6e\x6f\x68\x69\x6a\x6b\x64\x65\x66\x67\x60\x61\x62\x63\x1c\x1d\x1e\x1f\x18\x19\x1a\x1b\x14\x15\x16\x17\x10\x11\x12\x13\x0c\x0d\x0e\x0f\x08\x09\x0a\x0b\x04\x05\x06\x07\x00\x01\x02\x03\x3c\x3d\x3e\x3f\x38\x39\x3a\x3b\x34\x35\x36\x37\x30\x31\x32\x33\x2c\x2d\x2e\x2f\x28\x29\x2a\x2b\x24\x25\x26\x27\x20\x21\x22\x23\xdc\xdd\xde\xdf\xd8\xd9\xda\xdb\xd4\xd5\xd6\xd7\xd0\xd1\xd2\xd3\xcc\xcd\xce\xcf\xc8\xc9\xca\xcb\xc4\xc5\xc6\xc7\xc0\xc1\xc2\xc3\xfc\xfd\xfe\xff\xf8\xf9\xfa\xfb\xf4\xf5\xf6\xf7\xf0\xf1\xf2\xf3\xec\xed\xee\xef\xe8\xe9\xea\xeb\xe4\xe5\xe6\xe7\xe0\xe1\xe2\xe3\x9c\x9d\x9e\x9f\x98\x99\x9a\x9b\x94\x95\x96\x97\x90\x91\x92\x93\x8c\x8d\x8e\x8f\x88\x89\x8a\x8b\x84\x85\x86\x87\x80\x81\x82\x83\xbc\xbd\xbe\xbf\xb8\xb9\xba\xbb\xb4\xb5\xb6\xb7\xb0\xb1\xb2\xb3\xac\xad\xae\xaf\xa8\xa9\xaa\xab\xa4\xa5\xa6\xa7\xa0\xa1\xa2\xa3}
  85 }
  86
  87 # As defined in RFC 2104 for H = SHA-1
  88 # Note that the order of the arguments is deliberately
  89 #   $_[0] -> text
  90 #   $_[1] -> key
  91 # To match other Perl Digest modules even though RFC 2104
  92 # talks about the key and then the text in that order!
  93 sub _hmac_sha1 {
  94         use bytes;
  95         my $text = shift || '';
  96         my $key = shift || '';
  97
  98         # HMAC is defined as H(K XOR opad, H(K XOR ipad, text))
  99         # where ipad is always 0x36 and opad is always 0x5C
 100
 101         # Reduce a key > 64 to 64
 102         $key = sha1($key) if length($key) > 64;
 103
 104         # (1) Pad with zeros if necessary
 105         $key .= pack('H2', '00') x (64 - length($key)) if length($key) < 64;
 106
 107         # (2) Create the step 4 data for the hash starting with $key XOR 0x36
 108         my $data4 = $key;
 109         _xor36($data4);
 110
 111         # (3) Append the text
 112         $data4 .= $text;
 113
 114         # (4) Apply H to $data
 115         $data4 = sha1($data4);
 116
 117         # (5) Create the step 5 data for the hash starting with $key XOR 0x5C
 118         my $data5 = $key;
 119         _xor5C($data5);
 120
 121         # (6) Append step 4 result to step 5 result
 122         $data5 .= $data4;
 123
 124         # (7) Return result of H applied to step 6 result
 125         return sha1($data5);
 126 }
 127
 128 BEGIN {
 129         $have_sha_hmac_sha1 or eval 'sub hmac_sha1 {goto &_hmac_sha1}';
 130 }
 131
 132 # An 8-byte salt is considered sufficient
 133 # We take the first 6 bytes of the sha1 hash of the rand output and pass
 134 # that through _encode_base64_alt to get a compatible 8-byte salt
 135 sub _random_salt {
 136         use bytes;
 137         return _encode_base64_alt(substr(sha1(rand()), 0, 6));
 138 }
 139
 140 # Return an iteration value that has a random amount of upto 1/4 its value
 141 # subtracted from it to avoid rainbow tables.  Practically this means that
 142 # iteration values 1-4 will be returned unchanged.
 143 sub _random_iterations {
 144         my $count = shift || 0;
 145         $count = 24680 unless $count > 0;
 146         $count -= int(rand($count / 4));
 147         return $count;
 148 }
 149
 150 # As defined in __crypt_sha1() from NetBSD's crypt-sha1.c which uses the
 151 # PBKDF1 function defined in RFC 2898 but with more convenient args and a
 152 # salt restricted to at most 64 bytes.  To pin the number of iterations
 153 # exactly a negative value must be passed in for iterations.  For example,
 154 # passing -10 as iterations will force exactly 10 iterations.
 155 # Note that the output of this function IS identical to the output of the
 156 # NetBSD __crypt_sha1() function provided the same $pw, $salt and $iterations
 157 # values are used.
 158 sub crypt_sha1 {
 159         use bytes;
 160         use constant SHA1_MAGIC => '$sha1$';
 161         my $pw = shift || '';
 162         my $salt = shift || _random_salt;
 163         $salt = substr($salt, 0, 64);
 164         my $iterations = shift || 0;
 165         $iterations = $iterations < 0 ?
 166                 -$iterations : _random_iterations($iterations || 24680);
 167
 168         # Create the starting value
 169         my $data = sprintf("%s%s%u", $salt, SHA1_MAGIC, $iterations);
 170
 171         # Do the initial HMAC where $pw is the KEY and $data is the TEXT
 172         $data = hmac_sha1($data, $pw);
 173
 174         # Perform any additional iterations requested
 175         for (my $i = 1; $i < $iterations; ++$i) {
 176                 # Again $pw is the KEY and $data is the TEXT
 177                 $data = hmac_sha1($data, $pw);
 178         }
 179
 180         return SHA1_MAGIC.$iterations.'$'.$salt.'$'._encode_base64_alt($data);
 181 }
 182
 183 # A convenience function similar to scrypt but producing a crypt_sha1 result.
 184 # Note that while 256 rounds is rather small, it's enough to allow some variation
 185 # in the number of rounds while still not taxing the CPU running Perl hmac_sha1.
 186 # If we have the Digest::SHA::hmac_sha1 version, it's approximately twice as
 187 # fast and we can allow up to 512 rounds for approximately the same CPU cost.
 188 sub scrypt_sha1 {
 189         my $pw = shift || '';
 190         return crypt_sha1($pw, '', $have_sha_hmac_sha1 ? 512 : 256);
 191 }
 192
 193 1;