Girocco/HashUtil.pm

   1 # Girocco::HashUtil.pm -- HMAC SHA-1 Utility Functions
   2 # Copyright (c) 2013 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 my %_b64convert;
  54 BEGIN {
  55         # A table that converts a standard base 64 encoding using this string:
  56         #   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  57         # to the alternate crypt encoding using this string:
  58         #   "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
  59         %_b64convert = (
  60         'A'=>'.','B'=>'/','C'=>'0','D'=>'1','E'=>'2','F'=>'3','G'=>'4','H'=>'5',
  61         'I'=>'6','J'=>'7','K'=>'8','L'=>'9','M'=>'A','N'=>'B','O'=>'C','P'=>'D',
  62         'Q'=>'E','R'=>'F','S'=>'G','T'=>'H','U'=>'I','V'=>'J','W'=>'K','X'=>'L',
  63         'Y'=>'M','Z'=>'N','a'=>'O','b'=>'P','c'=>'Q','d'=>'R','e'=>'S','f'=>'T',
  64         'g'=>'U','h'=>'V','i'=>'W','j'=>'X','k'=>'Y','l'=>'Z','m'=>'a','n'=>'b',
  65         'o'=>'c','p'=>'d','q'=>'e','r'=>'f','s'=>'g','t'=>'h','u'=>'i','v'=>'j',
  66         'w'=>'k','x'=>'l','y'=>'m','z'=>'n','0'=>'o','1'=>'p','2'=>'q','3'=>'r',
  67         '4'=>'s','5'=>'t','6'=>'u','7'=>'v','8'=>'w','9'=>'x','+'=>'y','/'=>'z'
  68         );
  69 }
  70
  71 # Like MIME::Base64::encode except that the crypt Base64 string is used
  72 # instead and no \n or = characters are generated and each 4-character output
  73 # sequence is reversed.  To make the input an even multiple of 3-character
  74 # sequences, the first 1 or 2 bytes of it may be repeated on the end.
  75 sub _encode_base64_alt {
  76         use bytes;
  77         my $val = shift || '';
  78         $val .= substr($val.$val, 0, (3-(length($val)%3))) if length($val)%3;
  79         my $b64 = encode_base64($val, '');
  80         $b64 =~ s/=+//;
  81         $b64 =~ s/(.)/$_b64convert{$1}/g;
  82         my $out = '';
  83         while (length($b64)) {
  84                 $out .= substr($b64,3,1).substr($b64,2,1).
  85                         substr($b64,1,1).substr($b64,0,1);
  86                 substr($b64,0,4) = '';
  87         }
  88         return $out;
  89 }
  90
  91 # As defined in RFC 2104 for H = SHA-1
  92 sub hmac_sha1 {
  93         use bytes;
  94         my $key = shift || '';
  95         my $text = shift || '';
  96
  97         # HMAC is defined as H(K XOR opad, H(K XOR ipad, text))
  98         # where ipad is always 0x36 and opad is always 0x5C
  99
 100         # Reduce a key > 64 to 64
 101         $key = sha1($key) if length($key) > 64;
 102
 103         # (1) Pad with zeros if necessary
 104         $key .= pack('H2', '00') x (64 - length($key)) if length($key) < 64;
 105
 106         # (2) Create the step 4 data for the hash starting with $key XOR 0x36
 107         my $data4 = $key;
 108         $data4 =~ s/(.)/chr(ord($1)^0x36)/ge;
 109
 110         # (3) Append the text
 111         $data4 .= $text;
 112
 113         # (4) Apply H to $data
 114         $data4 = sha1($data4);
 115
 116         # (5) Create the step 5 data for the hash starting with $key XOR 0x5C
 117         my $data5 = $key;
 118         $data5 =~ s/(.)/chr(ord($1)^0x5C)/ge;
 119
 120         # (6) Append step 4 result to step 5 result
 121         $data5 .= $data4;
 122
 123         # (7) Return result of H applied to step 6 result
 124         return sha1($data5);
 125 }
 126
 127 # An 8-byte salt is considered sufficient
 128 # We take the first 6 bytes of the sha1 hash of the rand output and pass
 129 # that through _encode_base64_alt to get a compatible 8-byte salt
 130 sub _random_salt {
 131         use bytes;
 132         return _encode_base64_alt(substr(sha1(rand()), 0, 6));
 133 }
 134
 135 # Return an iteration value that has a random amount of upto 1/4 its value
 136 # subtracted from it to avoid rainbow tables.  Practically this means that
 137 # iteration values 1-4 will be returned unchanged.
 138 sub _random_iterations {
 139         my $count = shift || 0;
 140         $count = 24680 unless $count > 0;
 141         $count -= int(rand($count / 4));
 142         return $count;
 143 }
 144
 145 # As defined in __crypt_sha1() from NetBSD's crypt-sha1.c which uses the
 146 # PBKDF1 function defined in RFC 2898 but with more convenient args and a
 147 # salt restricted to at most 64 bytes.  To pin the number of iterations
 148 # exactly a negative value must be passed in for iterations.  For example,
 149 # passing -10 as iterations will force exactly 10 iterations.
 150 # Note that the output of this function IS identical to the output of the
 151 # NetBSD __crypt_sha1() function provided the same $pw, $salt and $iterations
 152 # values are used.
 153 sub crypt_sha1 {
 154         use bytes;
 155         use constant SHA1_MAGIC => '$sha1$';
 156         my $pw = shift || '';
 157         my $salt = shift || _random_salt;
 158         $salt = substr($salt, 0, 64);
 159         my $iterations = shift || 0;
 160         $iterations = $iterations < 0 ?
 161                 -$iterations : _random_iterations($iterations || 24680);
 162
 163         # Create the starting value
 164         my $data = sprintf("%s%s%u", $salt, SHA1_MAGIC, $iterations);
 165
 166         # Do the initial HMAC where $pw is the KEY and $data is the TEXT
 167         $data = hmac_sha1($pw, $data);
 168
 169         # Perform any additional iterations requested
 170         for (my $i = 1; $i < $iterations; ++$i) {
 171                 # Again $pw is the KEY and $data is the TEXT
 172                 $data = hmac_sha1($pw, $data);
 173         }
 174
 175         return SHA1_MAGIC.$iterations.'$'.$salt.'$'._encode_base64_alt($data);
 176 }
 177
 178 # A convenience function similar to scrypt but producing a crypt_sha1 result.
 179 # Note that while 32 rounds is rather small, it's enough to allow some variation
 180 # in the number of rounds while still not taxing the CPU running Perl hmac_sha1.
 181 sub scrypt_sha1 {
 182         my $pw = shift || '';
 183         return crypt_sha1($pw, '', 32);
 184 }
 185
 186 1;