crypt_md5

BSD/Linux 等の passwd および Apache htpasswd の MD5 符号化は同じアルゴリズムを使っており、ピュア Perl の実装は CPAN モジュール Crypt::PasswdMD5 があります。 これは C 言語のコードを直訳したものな上に余計な機能がついているため、 自分好みに書き直してみました。

ダイジェストを 1000 回繰り返す部分は、2 と 3 と 7 の最小公倍数の 42 回分を展開し、23 回ループさせ、 余りの分 34 回を追加します。

use strict;
use warnings;
use integer;
use Digest::MD5 (md5);

sub crypt_md5 {
    my($plain, $secret) = @_;
    my $c64 = [q(.), q(/), '0' .. '9', 'A' .. 'Z', 'a' .. 'z'];
    my($magic, $salt) = $secret =~ m{\A(\$(?:apr)?1\$)([./0-9A-Za-z]{1,8})\$}msx
        ? ($1, $2) : return "not $secret";

    my $digest = md5($plain, $salt, $plain);
    for my $n (length $plain) {
        my $s = join q(), $plain, $magic, $salt,
                    substr $digest x (1 + ($n >> 4)), 0, $n;
        my($i, $c0, $p0) = ($n, (pack 'C', 0), (substr $plain, 0, 1));
        while ($i) {
            $s .= $i & 1 ? $c0 : $p0;
        } continue { $i >>= 1 }
        $digest = md5($s);
    }
    #for my $i (0 .. 999) {
    #    $digest = md5(
    #        $i & 1 ? $plain : $digest,
    #        $i % 3 ? $salt : (),
    #        $i % 7 ? $plain : (),
    #        $i & 1 ? $digest : $plain,
    #    );
    #}
    # 42 == 2 * 3 * 7 && 1000 == 23 * 42 + 34
    for (0 .. 22) {
        $digest = md5($digest,                $plain ); #  0: 0 0 0
        $digest = md5($plain,  $salt, $plain, $digest); #  1: 1 1 1
        $digest = md5($digest, $salt, $plain, $plain ); #  2: 0 2 2
        $digest = md5($plain,         $plain, $digest); #  3: 1 0 3
        $digest = md5($digest, $salt, $plain, $plain ); #  4: 0 1 4
        $digest = md5($plain,  $salt, $plain, $digest); #  5: 1 2 5
        $digest = md5($digest,        $plain, $plain ); #  6: 0 0 6
        $digest = md5($plain,  $salt,         $digest); #  7: 1 1 0
        $digest = md5($digest, $salt, $plain, $plain ); #  8: 0 2 1
        $digest = md5($plain,         $plain, $digest); #  9: 1 0 2
        $digest = md5($digest, $salt, $plain, $plain ); # 10: 0 1 3
        $digest = md5($plain,  $salt, $plain, $digest); # 11: 1 2 4
        $digest = md5($digest,        $plain, $plain ); # 12: 0 0 5
        $digest = md5($plain,  $salt, $plain, $digest); # 13: 1 1 6
        $digest = md5($digest, $salt,         $plain ); # 14: 0 2 0
        $digest = md5($plain,         $plain, $digest); # 15: 1 0 1
        $digest = md5($digest, $salt, $plain, $plain ); # 16: 0 1 2
        $digest = md5($plain,  $salt, $plain, $digest); # 17: 1 2 3
        $digest = md5($digest,        $plain, $plain ); # 18: 0 0 4
        $digest = md5($plain,  $salt, $plain, $digest); # 19: 1 1 5
        $digest = md5($digest, $salt, $plain, $plain ); # 20: 0 2 6
        $digest = md5($plain,                 $digest); # 21: 1 0 0
        $digest = md5($digest, $salt, $plain, $plain ); # 22: 0 1 1
        $digest = md5($plain,  $salt, $plain, $digest); # 23: 1 2 2
        $digest = md5($digest,        $plain, $plain ); # 24: 0 0 3
        $digest = md5($plain,  $salt, $plain, $digest); # 25: 1 1 4
        $digest = md5($digest, $salt, $plain, $plain ); # 26: 0 2 5
        $digest = md5($plain,         $plain, $digest); # 27: 1 0 6
        $digest = md5($digest, $salt,         $plain ); # 28: 0 1 0
        $digest = md5($plain,  $salt, $plain, $digest); # 29: 1 2 1
        $digest = md5($digest,        $plain, $plain ); # 30: 0 0 2
        $digest = md5($plain,  $salt, $plain, $digest); # 31: 1 1 3
        $digest = md5($digest, $salt, $plain, $plain ); # 32: 0 2 4
        $digest = md5($plain,         $plain, $digest); # 33: 1 0 5
        $digest = md5($digest, $salt, $plain, $plain ); # 34: 0 1 6
        $digest = md5($plain,  $salt,         $digest); # 35: 1 2 0
        $digest = md5($digest,        $plain, $plain ); # 36: 0 0 1
        $digest = md5($plain,  $salt, $plain, $digest); # 37: 1 1 2
        $digest = md5($digest, $salt, $plain, $plain ); # 38: 0 2 3
        $digest = md5($plain,         $plain, $digest); # 39: 1 0 4
        $digest = md5($digest, $salt, $plain, $plain ); # 40: 0 1 5
        $digest = md5($plain,  $salt, $plain, $digest); # 41: 1 2 6
    }
    $digest = md5($digest,                $plain ); #  0: 0 0 0
    $digest = md5($plain,  $salt, $plain, $digest); #  1: 1 1 1
    $digest = md5($digest, $salt, $plain, $plain ); #  2: 0 2 2
    $digest = md5($plain,         $plain, $digest); #  3: 1 0 3
    $digest = md5($digest, $salt, $plain, $plain ); #  4: 0 1 4
    $digest = md5($plain,  $salt, $plain, $digest); #  5: 1 2 5
    $digest = md5($digest,        $plain, $plain ); #  6: 0 0 6
    $digest = md5($plain,  $salt,         $digest); #  7: 1 1 0
    $digest = md5($digest, $salt, $plain, $plain ); #  8: 0 2 1
    $digest = md5($plain,         $plain, $digest); #  9: 1 0 2
    $digest = md5($digest, $salt, $plain, $plain ); # 10: 0 1 3
    $digest = md5($plain,  $salt, $plain, $digest); # 11: 1 2 4
    $digest = md5($digest,        $plain, $plain ); # 12: 0 0 5
    $digest = md5($plain,  $salt, $plain, $digest); # 13: 1 1 6
    $digest = md5($digest, $salt,         $plain ); # 14: 0 2 0
    $digest = md5($plain,         $plain, $digest); # 15: 1 0 1
    $digest = md5($digest, $salt, $plain, $plain ); # 16: 0 1 2
    $digest = md5($plain,  $salt, $plain, $digest); # 17: 1 2 3
    $digest = md5($digest,        $plain, $plain ); # 18: 0 0 4
    $digest = md5($plain,  $salt, $plain, $digest); # 19: 1 1 5
    $digest = md5($digest, $salt, $plain, $plain ); # 20: 0 2 6
    $digest = md5($plain,                 $digest); # 21: 1 0 0
    $digest = md5($digest, $salt, $plain, $plain ); # 22: 0 1 1
    $digest = md5($plain,  $salt, $plain, $digest); # 23: 1 2 2
    $digest = md5($digest,        $plain, $plain ); # 24: 0 0 3
    $digest = md5($plain,  $salt, $plain, $digest); # 25: 1 1 4
    $digest = md5($digest, $salt, $plain, $plain ); # 26: 0 2 5
    $digest = md5($plain,         $plain, $digest); # 27: 1 0 6
    $digest = md5($digest, $salt,         $plain ); # 28: 0 1 0
    $digest = md5($plain,  $salt, $plain, $digest); # 29: 1 2 1
    $digest = md5($digest,        $plain, $plain ); # 30: 0 0 2
    $digest = md5($plain,  $salt, $plain, $digest); # 31: 1 1 3
    $digest = md5($digest, $salt, $plain, $plain ); # 32: 0 2 4
    $digest = md5($plain,         $plain, $digest); # 33: 1 0 5
    return $magic . $salt . q($)
        . _encode_vector($c64, $digest, 4,  0,  6, 12)
        . _encode_vector($c64, $digest, 4,  1,  7, 13)
        . _encode_vector($c64, $digest, 4,  2,  8, 14)
        . _encode_vector($c64, $digest, 4,  3,  9, 15)
        . _encode_vector($c64, $digest, 4,  4, 10,  5)
        . _encode_vector($c64, $digest, 2, 11);
}

sub _encode_vector {
    my($c64, $digest, $n, $i, $j, $k) = @_;
    my $x = $n == 2
        ?  (unpack 'C', substr $digest, $i, 1)
        : ((unpack 'C', substr $digest, $i, 1) << 16)
        | ((unpack 'C', substr $digest, $j, 1) <<  8)
        |  (unpack 'C', substr $digest, $k, 1);
    my $t = q();
    for (1 .. $n) {
        $t .= $c64->[$x & 0x3f];
        $x >>= 6;
    }
    return $t;
}