Girocco/HashUtil.pm

   1 # Girocco::HashUtil.pm -- HMAC SHA-1 Utility Functions
   2 # Copyright (C) 2013,2020 Kyle J. McKay.  All rights reserved.
   3
   4 # This program is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU General Public License
   6 # as published by the Free Software Foundation; either version 2
   7 # of the License, or (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  17
  18 package Girocco::HashUtil;
  19
  20 use strict;
  21 use warnings;
  22
  23 use base qw(Exporter);
  24 our @EXPORT;
  25 our $VERSION;
  26
  27 BEGIN {
  28         @EXPORT = qw(hmac_sha1 crypt_sha1 scrypt_sha1);
  29         *VERSION = \'1.0';
  30 }
  31
  32 use MIME::Base64;
  33 BEGIN {
  34         eval {
  35                 require Digest::SHA;
  36                 Digest::SHA->import(
  37                         qw(sha1)
  38         );1} ||
  39         eval {
  40                 require Digest::SHA1;
  41                 Digest::SHA1->import(
  42                         qw(sha1)
  43         );1} ||
  44         eval {
  45                 require Digest::SHA::PurePerl;
  46                 Digest::SHA::PurePerl->import(
  47                         qw(sha1)
  48         );1} ||
  49         die "One of Digest::SHA or Digest::SHA1 or Digest::SHA::PurePerl "
  50         . "must be available\n";
  51 }
  52
  53 # Like MIME::Base64::encode except that the crypt Base64 string is used
  54 # instead and no \n or = characters are generated and each 4-character output
  55 # sequence is reversed.  To make the input an even multiple of 3-character
  56 # sequences, the first 1 or 2 bytes of it may be repeated on the end.
  57 sub _encode_base64_alt {
  58         use bytes;
  59         my $val = defined($_[0]) ? $_[0] : '';
  60         my $l = length($val);
  61         my $r;
  62         $l == 1 and $val .= $val.$val;
  63         $l > 1 and $r = $l % 3 and $val .= substr($val,0,3-$r);
  64         my $b64 = encode_base64($val, '');
  65         # convert standard base 64 encoding to the alternate crypt encoding
  66         $b64 =~ tr{ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/}
  67                   {./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz};
  68         my $out = '';
  69         $l = length($b64);
  70         my $i = 0;
  71         $out .= reverse(substr($b64,$i,4)), $i += 4 while $i < $l;
  72         return $out;
  73 }
  74
  75 sub _xor36 {use bytes; $_[0]=~tr
  76 {\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}
  77 {\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}
  78 }
  79
  80 sub _xor5C {use bytes; $_[0]=~tr
  81 {\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}
  82 {\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}
  83 }
  84
  85 # As defined in RFC 2104 for H = SHA-1
  86 sub hmac_sha1 {
  87         use bytes;
  88         my $key = shift || '';
  89         my $text = shift || '';
  90
  91         # HMAC is defined as H(K XOR opad, H(K XOR ipad, text))
  92         # where ipad is always 0x36 and opad is always 0x5C
  93
  94         # Reduce a key > 64 to 64
  95         $key = sha1($key) if length($key) > 64;
  96
  97         # (1) Pad with zeros if necessary
  98         $key .= pack('H2', '00') x (64 - length($key)) if length($key) < 64;
  99
 100         # (2) Create the step 4 data for the hash starting with $key XOR 0x36
 101         my $data4 = $key;
 102         _xor36($data4);
 103
 104         # (3) Append the text
 105         $data4 .= $text;
 106
 107         # (4) Apply H to $data
 108         $data4 = sha1($data4);
 109
 110         # (5) Create the step 5 data for the hash starting with $key XOR 0x5C
 111         my $data5 = $key;
 112         _xor5C($data5);
 113
 114         # (6) Append step 4 result to step 5 result
 115         $data5 .= $data4;
 116
 117         # (7) Return result of H applied to step 6 result
 118         return sha1($data5);
 119 }
 120
 121 # An 8-byte salt is considered sufficient
 122 # We take the first 6 bytes of the sha1 hash of the rand output and pass
 123 # that through _encode_base64_alt to get a compatible 8-byte salt
 124 sub _random_salt {
 125         use bytes;
 126         return _encode_base64_alt(substr(sha1(rand()), 0, 6));
 127 }
 128
 129 # Return an iteration value that has a random amount of upto 1/4 its value
 130 # subtracted from it to avoid rainbow tables.  Practically this means that
 131 # iteration values 1-4 will be returned unchanged.
 132 sub _random_iterations {
 133         my $count = shift || 0;
 134         $count = 24680 unless $count > 0;
 135         $count -= int(rand($count / 4));
 136         return $count;
 137 }
 138
 139 # As defined in __crypt_sha1() from NetBSD's crypt-sha1.c which uses the
 140 # PBKDF1 function defined in RFC 2898 but with more convenient args and a
 141 # salt restricted to at most 64 bytes.  To pin the number of iterations
 142 # exactly a negative value must be passed in for iterations.  For example,
 143 # passing -10 as iterations will force exactly 10 iterations.
 144 # Note that the output of this function IS identical to the output of the
 145 # NetBSD __crypt_sha1() function provided the same $pw, $salt and $iterations
 146 # values are used.
 147 sub crypt_sha1 {
 148         use bytes;
 149         use constant SHA1_MAGIC => '$sha1$';
 150         my $pw = shift || '';
 151         my $salt = shift || _random_salt;
 152         $salt = substr($salt, 0, 64);
 153         my $iterations = shift || 0;
 154         $iterations = $iterations < 0 ?
 155                 -$iterations : _random_iterations($iterations || 24680);
 156
 157         # Create the starting value
 158         my $data = sprintf("%s%s%u", $salt, SHA1_MAGIC, $iterations);
 159
 160         # Do the initial HMAC where $pw is the KEY and $data is the TEXT
 161         $data = hmac_sha1($pw, $data);
 162
 163         # Perform any additional iterations requested
 164         for (my $i = 1; $i < $iterations; ++$i) {
 165                 # Again $pw is the KEY and $data is the TEXT
 166                 $data = hmac_sha1($pw, $data);
 167         }
 168
 169         return SHA1_MAGIC.$iterations.'$'.$salt.'$'._encode_base64_alt($data);
 170 }
 171
 172 # A convenience function similar to scrypt but producing a crypt_sha1 result.
 173 # Note that while 256 rounds is rather small, it's enough to allow some variation
 174 # in the number of rounds while still not taxing the CPU running Perl hmac_sha1.
 175 sub scrypt_sha1 {
 176         my $pw = shift || '';
 177         return crypt_sha1($pw, '', 256);
 178 }
 179
 180 1;