1#!/usr/bin/env perl
2
3##
4## Author......: See docs/credits.txt
5## License.....: MIT
6##
7
8use strict;
9use warnings;
10
11use Digest::MD5 qw (md5);
12
13sub module_constraints { [[0, 256], [0, 8], [0, 15], [0, 8], [-1, -1]] }
14
15sub module_generate_hash
16{
17  my $word = shift;
18  my $salt = shift;
19  my $iter = shift;
20
21  my $iterations = 1000;
22
23  if (defined ($iter))
24  {
25    if ($iter > 0)
26    {
27      $iterations = int ($iter);
28    }
29  }
30
31  my $hash_buf = md5_crypt ('$apr1$', $iterations, $word, $salt);
32
33  return $hash_buf;
34}
35
36sub module_verify_hash
37{
38  my $line = shift;
39
40  my ($hash, $word) = split (':', $line);
41
42  return unless defined $hash;
43  return unless defined $word;
44
45  my $index1 = index ($hash, ',', 1);
46  my $index2 = index ($hash, '$', 1);
47
48  if ($index1 != -1)
49  {
50    if ($index1 < $index2)
51    {
52      $index2 = $index1;
53    }
54  }
55
56  $index2++;
57
58  # rounds= if available
59  my $iter = 0;
60
61  if (substr ($hash, $index2, 7) eq "rounds=")
62  {
63    my $old_index = $index2;
64
65    $index2 = index ($hash, '$', $index2 + 1);
66
67    return if $index2 < 1;
68
69    $iter = substr ($hash, $old_index + 7, $index2 - $old_index - 7);
70
71    $index2++;
72  }
73
74  # get salt
75  my $index3 = rindex ($hash, '$');
76
77  return if $index3 < 1;
78
79  my $salt = substr ($hash, $index2, $index3 - $index2);
80
81  my $word_packed = pack_if_HEX_notation ($word);
82
83  my $new_hash = module_generate_hash ($word_packed, $salt, $iter);
84
85  return ($new_hash, $word);
86}
87
88sub md5_crypt
89{
90  my $magic = shift;
91
92  my $iter = shift;
93  my $pass = shift;
94  my $salt = shift;
95
96  my $hash = ""; # hash to be returned by this function
97
98  my $final = md5 ($pass . $salt . $pass);
99
100  $salt = substr ($salt, 0, 8);
101
102  my $tmp = $pass . $magic . $salt;
103
104  my $pass_len = length ($pass);
105
106  my $i;
107
108  for ($i = $pass_len; $i > 0; $i -= 16)
109  {
110    my $len = 16;
111
112    if ($i < $len)
113    {
114      $len = $i;
115    }
116
117    $tmp .= substr ($final, 0, $len);
118  }
119
120  $i = $pass_len;
121
122  while ($i > 0)
123  {
124    if ($i & 1)
125    {
126      $tmp .= chr (0);
127    }
128    else
129    {
130      $tmp .= substr ($pass, 0, 1);
131    }
132
133    $i >>= 1;
134  }
135
136  $final = md5 ($tmp);
137
138  for ($i = 0; $i < $iter; $i++)
139  {
140    $tmp = "";
141
142    if ($i & 1)
143    {
144      $tmp .= $pass;
145    }
146    else
147    {
148      $tmp .= $final;
149    }
150
151    if ($i % 3)
152    {
153      $tmp .= $salt;
154    }
155
156    if ($i % 7)
157    {
158      $tmp .= $pass;
159    }
160
161    if ($i & 1)
162    {
163      $tmp .= $final;
164    }
165    else
166    {
167      $tmp .= $pass;
168    }
169
170    $final = md5 ($tmp);
171  }
172
173  # done
174  # now format the output sting ("hash")
175
176  my $hash_buf;
177
178  $hash  = to64 ((ord (substr ($final, 0, 1)) << 16) | (ord (substr ($final,  6, 1)) << 8) | (ord (substr ($final, 12, 1))), 4);
179  $hash .= to64 ((ord (substr ($final, 1, 1)) << 16) | (ord (substr ($final,  7, 1)) << 8) | (ord (substr ($final, 13, 1))), 4);
180  $hash .= to64 ((ord (substr ($final, 2, 1)) << 16) | (ord (substr ($final,  8, 1)) << 8) | (ord (substr ($final, 14, 1))), 4);
181  $hash .= to64 ((ord (substr ($final, 3, 1)) << 16) | (ord (substr ($final,  9, 1)) << 8) | (ord (substr ($final, 15, 1))), 4);
182  $hash .= to64 ((ord (substr ($final, 4, 1)) << 16) | (ord (substr ($final, 10, 1)) << 8) | (ord (substr ($final,  5, 1))), 4);
183  $hash .= to64 (ord (substr ($final, 11, 1)), 2);
184
185  if ($iter == 1000) # default
186  {
187    $hash_buf = sprintf ("%s%s\$%s", $magic , $salt , $hash);
188  }
189  else
190  {
191    $hash_buf = sprintf ("%srounds=%i\$%s\$%s", $magic, $iter, $salt , $hash);
192  }
193
194  return $hash_buf;
195}
196
197sub to64
198{
199  my $v = shift;
200  my $n = shift;
201
202  my $itoa64 = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
203
204  my $ret = "";
205
206  while (($n - 1) >= 0)
207  {
208    $n = $n - 1;
209
210    $ret .= substr ($itoa64, $v & 0x3f, 1);
211
212    $v = $v >> 6;
213  }
214
215  return $ret
216}
217
2181;
219