← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/local/src/github.com/foswiki/core/bin/view
  Run on Sun Dec 4 17:17:59 2011
Reported on Sun Dec 4 17:26:34 2011

Filename/usr/share/perl5/Crypt/PasswdMD5.pm
StatementsExecuted 10 statements in 1.04ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11125µs68µsCrypt::PasswdMD5::::BEGIN@65Crypt::PasswdMD5::BEGIN@65
0000s0sCrypt::PasswdMD5::::apache_md5_cryptCrypt::PasswdMD5::apache_md5_crypt
0000s0sCrypt::PasswdMD5::::to64Crypt::PasswdMD5::to64
0000s0sCrypt::PasswdMD5::::unix_md5_cryptCrypt::PasswdMD5::unix_md5_crypt
Call graph for these subroutines as a Graphviz dot language file.
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
21package Crypt::PasswdMD5;
2212µs$VERSION='1.3';
23118µsrequire 5.000;
2411µsrequire Exporter;
2518µs@ISA = qw(Exporter);
2612µs@EXPORT = qw(unix_md5_crypt apache_md5_crypt);
27
28=head1 NAME
29
30Crypt::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
42the C<unix_md5_crypt()> provides a crypt()-compatible interface to the
43rather new MD5-based crypt() function found in modern operating systems.
44It's based on the implementation found on FreeBSD 2.2.[56]-RELEASE and
45contains 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
52C<apache_md5_crypt()> provides a function compatible with Apache's
53C<.htpasswd> files. This was contributed by Bryan Hart <bryan@eai.com>.
54As suggested by William A. Rowe, Jr. <wrowe@lnd.com>, it is
55exported by default.
56
57For both functions, if a salt value is not supplied, a random salt will be
58generated. Contributed by John Peacock <jpeacock@cpan.org>.
59
60=cut
61
6212µs$Magic = q/$1$/; # Magic string
6311µs$itoa64 = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
64
652995µs2111µs
# spent 68µs (25+43) within Crypt::PasswdMD5::BEGIN@65 which was called: # once (25µs+43µs) by Foswiki::Users::HtPasswdUser::BEGIN@2.2 at line 65
use Digest::MD5;
# spent 68µs making 1 call to Crypt::PasswdMD5::BEGIN@65 # spent 43µs making 1 call to Exporter::import
66
67sub 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
77sub 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
84sub 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)
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
16719µs1;
168
169__END__