← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 19:05:14 2015
Reported on Fri Jul 31 19:08:09 2015

Filename/usr/share/perl5/vendor_perl/Crypt/PasswdMD5.pm
StatementsExecuted 10 statements in 587µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11114µs27µ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;
221600ns$VERSION='1.3';
23110µsrequire 5.000;
241300nsrequire Exporter;
2516µs@ISA = qw(Exporter);
261700ns@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
621200ns$Magic = q/$1$/; # Magic string
631200ns$itoa64 = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
64
652563µs240µ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
use Digest::MD5;
# spent 27µs making 1 call to Crypt::PasswdMD5::BEGIN@65 # spent 13µ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),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
16715µs1;
168
169__END__