1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
#
# Crypt::PasswdMD5: Module to provide an interoperable crypt()
# function for modern Unix O/S. This is based on the code for
#
# /usr/src/libcrypt/crypt.c
#
# on a FreeBSD 2.2.5-RELEASE system, which included the following
# notice.
#
# ----------------------------------------------------------------------------
# "THE BEER-WARE LICENSE" (Revision 42):
# <phk@login.dknet.dk> wrote this file. As long as you retain this notice you
# can do whatever you want with this stuff. If we meet some day, and you think
# this stuff is worth it, you can buy me a beer in return. Poul-Henning Kamp
# ----------------------------------------------------------------------------
#
# $Id: PasswdMD5.pm,v 1.3 2004/02/17 11:21:38 lem Exp $
#
################
package Crypt::PasswdMD5;
$VERSION='1.3';
require 5.000;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(unix_md5_crypt apache_md5_crypt);
$Magic = q/$1$/; # Magic string
$itoa64 = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
use Digest::MD5;
sub to64 {
my ($v, $n) = @_;
my $ret = '';
while (--$n >= 0) {
$ret .= substr($itoa64, $v & 0x3f, 1);
$v >>= 6;
}
$ret;
}
sub apache_md5_crypt {
# change the Magic string to match the one used by Apache
local $Magic = q/$apr1$/;
unix_md5_crypt(@_);
}
sub unix_md5_crypt {
my($pw, $salt) = @_;
my $passwd;
if ( defined $salt ) {
$salt =~ s/^\Q$Magic//; # Take care of the magic string if
# if present.
$salt =~ s/^(.*)\$.*$/$1/; # Salt can have up to 8 chars...
$salt = substr($salt, 0, 8);
}
else {
$salt = ''; # in case no salt was proffered
$salt .= substr($itoa64,int(rand(64)+1),1)
while length($salt) < 8;
}
$ctx = new Digest::MD5; # Here we start the calculation
$ctx->add($pw); # Original password...
$ctx->add($Magic); # ...our magic string...
$ctx->add($salt); # ...the salt...
my ($final) = new Digest::MD5;
$final->add($pw);
$final->add($salt);
$final->add($pw);
$final = $final->digest;
for ($pl = length($pw); $pl > 0; $pl -= 16) {
$ctx->add(substr($final, 0, $pl > 16 ? 16 : $pl));
}
# Now the 'weird' xform
for ($i = length($pw); $i; $i >>= 1) {
if ($i & 1) { $ctx->add(pack("C", 0)); }
# This comes from the original version,
# where a memset() is done to $final
# before this loop.
else { $ctx->add(substr($pw, 0, 1)); }
}
$final = $ctx->digest;
# The following is supposed to make
# things run slower. In perl, perhaps
# it'll be *really* slow!
for ($i = 0; $i < 1000; $i++) {
$ctx1 = new Digest::MD5;
if ($i & 1) { $ctx1->add($pw); }
else { $ctx1->add(substr($final, 0, 16)); }
if ($i % 3) { $ctx1->add($salt); }
if ($i % 7) { $ctx1->add($pw); }
if ($i & 1) { $ctx1->add(substr($final, 0, 16)); }
else { $ctx1->add($pw); }
$final = $ctx1->digest;
}
# Final xform
$passwd = '';
$passwd .= to64(int(unpack("C", (substr($final, 0, 1))) << 16)
| int(unpack("C", (substr($final, 6, 1))) << 8)
| int(unpack("C", (substr($final, 12, 1)))), 4);
$passwd .= to64(int(unpack("C", (substr($final, 1, 1))) << 16)
| int(unpack("C", (substr($final, 7, 1))) << 8)
| int(unpack("C", (substr($final, 13, 1)))), 4);
$passwd .= to64(int(unpack("C", (substr($final, 2, 1))) << 16)
| int(unpack("C", (substr($final, 8, 1))) << 8)
| int(unpack("C", (substr($final, 14, 1)))), 4);
$passwd .= to64(int(unpack("C", (substr($final, 3, 1))) << 16)
| int(unpack("C", (substr($final, 9, 1))) << 8)
| int(unpack("C", (substr($final, 15, 1)))), 4);
$passwd .= to64(int(unpack("C", (substr($final, 4, 1))) << 16)
| int(unpack("C", (substr($final, 10, 1))) << 8)
| int(unpack("C", (substr($final, 5, 1)))), 4);
$passwd .= to64(int(unpack("C", substr($final, 11, 1))), 2);
$final = '';
$Magic . $salt . q/$/ . $passwd;
}
1;
__END__
|
