# This is a porting from PHP of the APR1-MD5 encryption method (windows compatible).

# This function requires the packages List::Util, Digest::MD5 and MIME::Base64.

# See: http://stackoverflow.com/questions/1038791/how-to-programmaticaly-build-an-apr1-md5-using-php

sub crypt_apr1_md5 {

my ($plainpasswd, $salt) = @_;

$salt = "" if (!$salt);

# Subroutine like the PHP min() function to get

# the min value of an array.

my $min = sub {

	return $_[$_[0] > $_[1]];

};

# Subroutine like the PHP str_shuffle() function to

# shuffles a string randomly. List::Util is needed.

my $str_shuffle = sub {

	return join("", shuffle(split //, shift));

};

# Subroutine like the PHP strtr() function to

# replaced characters from strings.

my $strtr = sub {

	my ($str, $a, $b) = @_;

	$a =~ s!/!\\/!g;

	$b =~ s!/!\\/!g;

	eval "\$str =~ tr/$a/$b/, 1";

	return $str;

};

my $tmp = "";

my $translateTo = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";

$salt = substr($str_shuffle->("abcdefghijklmnopqrstuvwxyz0123456789"), 0, 8) if (!length($salt)>0);

my $len = length($plainpasswd);

my $text = $plainpasswd.'$apr1$'.$salt;

my $bin = pack("H32", md5_hex($plainpasswd.$salt.$plainpasswd));

for(my $i = $len; $i > 0; $i -= 16) { $text .= substr($bin, 0, $min->(16, $i)); }

for(my $i = $len; $i > 0; $i >>= 1) { $text .= ($i & 1) ? chr(0) : substr($plainpasswd, 0, 1); }

$bin = pack("H32", md5_hex($text));

for(my $i = 0; $i < 1000; $i++) {

	my $new = ($i & 1) ? $plainpasswd : $bin;

	$new .= $salt if ($i % 3);

	$new .= $plainpasswd if ($i % 7);

	$new .= ($i & 1) ? $bin : $plainpasswd;

	$bin = pack("H32", md5_hex($new));

}

for (my $i = 0; $i < 5; $i++) {

	my $k = $i + 6;

	my $j = $i + 12;

	$j = 5 if ($j == 16);

	$tmp = substr($bin, $i, 1).substr($bin, $k, 1).substr($bin, $j, 1).$tmp;

}

$tmp = chr(0).chr(0).substr($bin, 11, 1).$tmp;

$tmp = reverse(substr(encode_base64($tmp), 2));

$tmp =~ s!\s+!!g;

$tmp = $strtr->($tmp, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", $translateTo);

return "\$apr1\$".$salt."\$".$tmp;

}