Filename | /usr/share/perl5/vendor_perl/Crypt/PasswdMD5.pm |
Statements | Executed 10 statements in 587µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 14µs | 27µs | BEGIN@65 | Crypt::PasswdMD5::
0 | 0 | 0 | 0s | 0s | apache_md5_crypt | Crypt::PasswdMD5::
0 | 0 | 0 | 0s | 0s | to64 | Crypt::PasswdMD5::
0 | 0 | 0 | 0s | 0s | unix_md5_crypt | Crypt::PasswdMD5::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # | ||||
2 | # Crypt::PasswdMD5: Module to provide an interoperable crypt() | ||||
3 | # function for modern Unix O/S. This is based on the code for | ||||
4 | # | ||||
5 | # /usr/src/libcrypt/crypt.c | ||||
6 | # | ||||
7 | # on a FreeBSD 2.2.5-RELEASE system, which included the following | ||||
8 | # notice. | ||||
9 | # | ||||
10 | # ---------------------------------------------------------------------------- | ||||
11 | # "THE BEER-WARE LICENSE" (Revision 42): | ||||
12 | # <phk@login.dknet.dk> wrote this file. As long as you retain this notice you | ||||
13 | # can do whatever you want with this stuff. If we meet some day, and you think | ||||
14 | # this stuff is worth it, you can buy me a beer in return. Poul-Henning Kamp | ||||
15 | # ---------------------------------------------------------------------------- | ||||
16 | # | ||||
17 | # $Id: PasswdMD5.pm,v 1.3 2004/02/17 11:21:38 lem Exp $ | ||||
18 | # | ||||
19 | ################ | ||||
20 | |||||
21 | package Crypt::PasswdMD5; | ||||
22 | 1 | 600ns | $VERSION='1.3'; | ||
23 | 1 | 10µs | require 5.000; | ||
24 | 1 | 300ns | require Exporter; | ||
25 | 1 | 6µs | @ISA = qw(Exporter); | ||
26 | 1 | 700ns | @EXPORT = qw(unix_md5_crypt apache_md5_crypt); | ||
27 | |||||
28 | =head1 NAME | ||||
29 | |||||
30 | Crypt::PasswdMD5 - Provides interoperable MD5-based crypt() functions | ||||
31 | |||||
32 | =head1 SYNOPSIS | ||||
33 | |||||
34 | use Crypt::PasswdMD5; | ||||
35 | |||||
36 | $cryptedpassword = unix_md5_crypt($password, $salt); | ||||
37 | $apachepassword = apache_md5_crypt($password, $salt); | ||||
38 | |||||
39 | |||||
40 | =head1 DESCRIPTION | ||||
41 | |||||
42 | the C<unix_md5_crypt()> provides a crypt()-compatible interface to the | ||||
43 | rather new MD5-based crypt() function found in modern operating systems. | ||||
44 | It's based on the implementation found on FreeBSD 2.2.[56]-RELEASE and | ||||
45 | contains the following license in it: | ||||
46 | |||||
47 | "THE BEER-WARE LICENSE" (Revision 42): | ||||
48 | <phk@login.dknet.dk> wrote this file. As long as you retain this notice you | ||||
49 | can do whatever you want with this stuff. If we meet some day, and you think | ||||
50 | this stuff is worth it, you can buy me a beer in return. Poul-Henning Kamp | ||||
51 | |||||
52 | C<apache_md5_crypt()> provides a function compatible with Apache's | ||||
53 | C<.htpasswd> files. This was contributed by Bryan Hart <bryan@eai.com>. | ||||
54 | As suggested by William A. Rowe, Jr. <wrowe@lnd.com>, it is | ||||
55 | exported by default. | ||||
56 | |||||
57 | For both functions, if a salt value is not supplied, a random salt will be | ||||
58 | generated. Contributed by John Peacock <jpeacock@cpan.org>. | ||||
59 | |||||
60 | =cut | ||||
61 | |||||
62 | 1 | 200ns | $Magic = q/$1$/; # Magic string | ||
63 | 1 | 200ns | $itoa64 = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; | ||
64 | |||||
65 | 2 | 563µs | 2 | 40µs | # spent 27µs (14+13) within Crypt::PasswdMD5::BEGIN@65 which was called:
# once (14µs+13µs) by Foswiki::Users::BaseUserMapping::BEGIN@39 at line 65 # spent 27µs making 1 call to Crypt::PasswdMD5::BEGIN@65
# spent 13µs making 1 call to Exporter::import |
66 | |||||
67 | sub to64 { | ||||
68 | my ($v, $n) = @_; | ||||
69 | my $ret = ''; | ||||
70 | while (--$n >= 0) { | ||||
71 | $ret .= substr($itoa64, $v & 0x3f, 1); | ||||
72 | $v >>= 6; | ||||
73 | } | ||||
74 | $ret; | ||||
75 | } | ||||
76 | |||||
77 | sub apache_md5_crypt { | ||||
78 | # change the Magic string to match the one used by Apache | ||||
79 | local $Magic = q/$apr1$/; | ||||
80 | |||||
81 | unix_md5_crypt(@_); | ||||
82 | } | ||||
83 | |||||
84 | sub unix_md5_crypt { | ||||
85 | my($pw, $salt) = @_; | ||||
86 | my $passwd; | ||||
87 | |||||
88 | if ( defined $salt ) { | ||||
89 | |||||
90 | $salt =~ s/^\Q$Magic//; # Take care of the magic string if | ||||
91 | # if present. | ||||
92 | |||||
93 | $salt =~ s/^(.*)\$.*$/$1/; # Salt can have up to 8 chars... | ||||
94 | $salt = substr($salt, 0, 8); | ||||
95 | } | ||||
96 | else { | ||||
97 | $salt = ''; # in case no salt was proffered | ||||
98 | $salt .= substr($itoa64,int(rand(64)+1),1) | ||||
99 | while length($salt) < 8; | ||||
100 | } | ||||
101 | |||||
102 | $ctx = new Digest::MD5; # Here we start the calculation | ||||
103 | $ctx->add($pw); # Original password... | ||||
104 | $ctx->add($Magic); # ...our magic string... | ||||
105 | $ctx->add($salt); # ...the salt... | ||||
106 | |||||
107 | my ($final) = new Digest::MD5; | ||||
108 | $final->add($pw); | ||||
109 | $final->add($salt); | ||||
110 | $final->add($pw); | ||||
111 | $final = $final->digest; | ||||
112 | |||||
113 | for ($pl = length($pw); $pl > 0; $pl -= 16) { | ||||
114 | $ctx->add(substr($final, 0, $pl > 16 ? 16 : $pl)); | ||||
115 | } | ||||
116 | |||||
117 | # Now the 'weird' xform | ||||
118 | |||||
119 | for ($i = length($pw); $i; $i >>= 1) { | ||||
120 | if ($i & 1) { $ctx->add(pack("C", 0)); } | ||||
121 | # This comes from the original version, | ||||
122 | # where a memset() is done to $final | ||||
123 | # before this loop. | ||||
124 | else { $ctx->add(substr($pw, 0, 1)); } | ||||
125 | } | ||||
126 | |||||
127 | $final = $ctx->digest; | ||||
128 | # The following is supposed to make | ||||
129 | # things run slower. In perl, perhaps | ||||
130 | # it'll be *really* slow! | ||||
131 | |||||
132 | for ($i = 0; $i < 1000; $i++) { | ||||
133 | $ctx1 = new Digest::MD5; | ||||
134 | if ($i & 1) { $ctx1->add($pw); } | ||||
135 | else { $ctx1->add(substr($final, 0, 16)); } | ||||
136 | if ($i % 3) { $ctx1->add($salt); } | ||||
137 | if ($i % 7) { $ctx1->add($pw); } | ||||
138 | if ($i & 1) { $ctx1->add(substr($final, 0, 16)); } | ||||
139 | else { $ctx1->add($pw); } | ||||
140 | $final = $ctx1->digest; | ||||
141 | } | ||||
142 | |||||
143 | # Final xform | ||||
144 | |||||
145 | $passwd = ''; | ||||
146 | $passwd .= to64(int(unpack("C", (substr($final, 0, 1))) << 16) | ||||
147 | | int(unpack("C", (substr($final, 6, 1))) << 8) | ||||
148 | | int(unpack("C", (substr($final, 12, 1)))), 4); | ||||
149 | $passwd .= to64(int(unpack("C", (substr($final, 1, 1))) << 16) | ||||
150 | | int(unpack("C", (substr($final, 7, 1))) << 8) | ||||
151 | | int(unpack("C", (substr($final, 13, 1)))), 4); | ||||
152 | $passwd .= to64(int(unpack("C", (substr($final, 2, 1))) << 16) | ||||
153 | | int(unpack("C", (substr($final, 8, 1))) << 8) | ||||
154 | | int(unpack("C", (substr($final, 14, 1)))), 4); | ||||
155 | $passwd .= to64(int(unpack("C", (substr($final, 3, 1))) << 16) | ||||
156 | | int(unpack("C", (substr($final, 9, 1))) << 8) | ||||
157 | | int(unpack("C", (substr($final, 15, 1)))), 4); | ||||
158 | $passwd .= to64(int(unpack("C", (substr($final, 4, 1))) << 16) | ||||
159 | | int(unpack("C", (substr($final, 10, 1))) << 8) | ||||
160 | | int(unpack("C", (substr($final, 5, 1)))), 4); | ||||
161 | $passwd .= to64(int(unpack("C", substr($final, 11, 1))), 2); | ||||
162 | |||||
163 | $final = ''; | ||||
164 | $Magic . $salt . q/$/ . $passwd; | ||||
165 | } | ||||
166 | |||||
167 | 1 | 5µs | 1; | ||
168 | |||||
169 | __END__ |