|
Sur le modèle du Javascript
déjà fourni dans nos colonnes, ce programme Perl
renvoie le résultat du hachage MD5 d'une chaîne.
# Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm
use strict;
package md5;
require Exporter;
@md5::ISA = qw(Exporter);
@md5::EXPORT = qw(md5 md5_init md5_update md5_final);
# MD5 context
my @state; # array of four integers (A, B, C, D)
my @count; # number of bits, modulo 2^64, lsb first
my $buffer; # accumulates bytes until we get a 64-byte block to process
my $PADDING = "\200\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" .
"\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" .
"\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" .
"\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
# Given '$str', returns digest of '$str'
sub md5 # ($str)
{
my ($str) = @_;
my $digest;
md5_init();
md5_update($str);
$digest = md5_final();
return $digest;
}
# Finishes the MD5 calculation and returns the digest
sub md5_final
{
my $bits;
my $index;
my $pad_len;
# Save number of bits
$bits = md5_encode(@count);
# Pad out to 56 mod 64.
$index = ($count[0] >> 3) & 0x3f;
if ($index < 56)
{
$pad_len = 56 - $index;
}
else
{
$pad_len = 120 - $index;
}
md5_update(substr($PADDING,0,$pad_len));
# Append length (before padding)
md5_update($bits);
return md5_encode(@state);
}
# Initialize MD5 context to start a new digest
sub md5_init
{
@count = (0,0);
# magic initialization constants
@state = (0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476);
$buffer = '';
}
# Process another block of message, updating context
sub md5_update # ($input)
{
my($input) = @_;
my $i;
my $index;
my $input_len;
my $part_len;
$input_len = length($input);
# Compute number of bytes mod 64
$index = (($count[0] >> 3) & 0x3F);
# Update number of bits
$count[0] = $count[0] + ($input_len << 3);
if ($count[0] != ($count[0] & 0xffffffff)) # overflow
{
$count[0] = 0;
$count[1] = $count[1] + 1;
}
$count[1] = $count[1] + ($input_len >> 29);
$part_len = 64 - $index;
# Transform as many times as possible.
if ($input_len < $part_len)
{
$i = 0;
}
else
{
substr($buffer,$index,$part_len) = substr($input,0,$part_len);
md5_transform($buffer);
for ($i = $part_len; $i + 63 < $input_len; $i += 64)
{
md5_transform(substr($input,$i,64));
}
$index = 0;
}
# Buffer remaining input
substr($buffer,$index,($input_len - $i)) =
substr($input,$i,($input_len - $i));
}
sub add_unsigned # ($a1,...,$an)
{
my $addend;
my $sum;
$sum = 0;
foreach $addend (@_)
{
$sum = (($sum & 0x7fffffff) + ($addend & 0x7fffffff)) ^
($sum & 0x80000000) ^ ($addend & 0x80000000);
}
return $sum;
}
sub FF # ($a,$b,$c,$d,$x,$s,$ac)
{
my($a,$b,$c,$d,$x,$s,$ac) = @_;
$a = add_unsigned($a,(($b & $c) | (~$b & $d)),$x,$ac);
$a = rotate_left($a,$s);
return add_unsigned($a,$b);
}
sub GG # ($a,$b,$c,$d,$x,$s,$ac)
{
my($a,$b,$c,$d,$x,$s,$ac) = @_;
$a = add_unsigned($a,(($b & $d) | ($c & ~$d)),$x,$ac);
$a = rotate_left($a,$s);
return add_unsigned($a,$b);
}
sub HH # ($a,$b,$c,$d,$x,$s,$ac)
{
my($a,$b,$c,$d,$x,$s,$ac) = @_;
$a = add_unsigned($a,($b ^ $c ^ $d),$x,$ac);
$a = rotate_left($a,$s);
return add_unsigned($a,$b);
}
sub II # ($a,$b,$c,$d,$x,$s,$ac)
{
my($a,$b,$c,$d,$x,$s,$ac) = @_;
$a = add_unsigned($a,($c ^ ($b | ~$d)),$x,$ac);
$a = rotate_left($a,$s);
return add_unsigned($a,$b);
}
# Returns packed version of $input in array of integers
# length of $input must be a multiple of 4
sub md5_decode # ($input)
{
my($input) = @_;
my $i;
my $j;
my $len;
my @output;
$len = length($input);
$i = 0;
$j = 0;
while ($j < $len)
{
$output[$i] = ord(substr($input,$j,1)) |
(ord(substr($input,$j+1,1)) << 8) |
(ord(substr($input,$j+2,1)) << 16) |
(ord(substr($input,$j+3,1)) << 24);
$i = $i + 1;
$j = $j + 4;
}
return @output;
}
# Returns character version of (array of integers) @input
sub md5_encode # (@input)
{
my(@input) = @_;
my $output;
my $i;
my $len;
$len = $#input + 1;
$i = 0;
$output = '';
while ($i < $len)
{
$output = $output . chr( $input[$i] & 0xff);
$output = $output . chr(($input[$i] >> 8) & 0xff);
$output = $output . chr(($input[$i] >> 16) & 0xff);
$output = $output . chr(($input[$i] >> 24) & 0xff);
$i = $i + 1;
}
return $output;
}
# MD5 basic transformation. Transforms state based on $block.
# $block must contain exactly 64 bytes.
sub md5_transform # ($block)
{
my($block) = @_;
my $a = $state[0];
my $b = $state[1];
my $c = $state[2];
my $d = $state[3];
my @x;
@x = md5_decode($block);
# Round 1
$a = FF($a,$b,$c,$d,$x[ 0], 7,0xd76aa478); # 1
$d = FF($d,$a,$b,$c,$x[ 1],12,0xe8c7b756); # 2
$c = FF($c,$d,$a,$b,$x[ 2],17,0x242070db); # 3
$b = FF($b,$c,$d,$a,$x[ 3],22,0xc1bdceee); # 4
$a = FF($a,$b,$c,$d,$x[ 4], 7,0xf57c0faf); # 5
$d = FF($d,$a,$b,$c,$x[ 5],12,0x4787c62a); # 6
$c = FF($c,$d,$a,$b,$x[ 6],17,0xa8304613); # 7
$b = FF($b,$c,$d,$a,$x[ 7],22,0xfd469501); # 8
$a = FF($a,$b,$c,$d,$x[ 8], 7,0x698098d8); # 9
$d = FF($d,$a,$b,$c,$x[ 9],12,0x8b44f7af); # 10
$c = FF($c,$d,$a,$b,$x[10],17,0xffff5bb1); # 11
$b = FF($b,$c,$d,$a,$x[11],22,0x895cd7be); # 12
$a = FF($a,$b,$c,$d,$x[12], 7,0x6b901122); # 13
$d = FF($d,$a,$b,$c,$x[13],12,0xfd987193); # 14
$c = FF($c,$d,$a,$b,$x[14],17,0xa679438e); # 15
$b = FF($b,$c,$d,$a,$x[15],22,0x49b40821); # 16
# Round 2
$a = GG($a,$b,$c,$d,$x[ 1], 5,0xf61e2562); # 17
$d = GG($d,$a,$b,$c,$x[ 6], 9,0xc040b340); # 18
$c = GG($c,$d,$a,$b,$x[11],14,0x265e5a51); # 19
$b = GG($b,$c,$d,$a,$x[ 0],20,0xe9b6c7aa); # 20
$a = GG($a,$b,$c,$d,$x[ 5], 5,0xd62f105d); # 21
$d = GG($d,$a,$b,$c,$x[10], 9, 0x2441453); # 22
$c = GG($c,$d,$a,$b,$x[15],14,0xd8a1e681); # 23
$b = GG($b,$c,$d,$a,$x[ 4],20,0xe7d3fbc8); # 24
$a = GG($a,$b,$c,$d,$x[ 9], 5,0x21e1cde6); # 25
$d = GG($d,$a,$b,$c,$x[14], 9,0xc33707d6); # 26
$c = GG($c,$d,$a,$b,$x[ 3],14,0xf4d50d87); # 27
$b = GG($b,$c,$d,$a,$x[ 8],20,0x455a14ed); # 28
$a = GG($a,$b,$c,$d,$x[13], 5,0xa9e3e905); # 29
$d = GG($d,$a,$b,$c,$x[ 2], 9,0xfcefa3f8); # 30
$c = GG($c,$d,$a,$b,$x[ 7],14,0x676f02d9); # 31
$b = GG($b,$c,$d,$a,$x[12],20,0x8d2a4c8a); # 32
# Round 3
$a = HH($a,$b,$c,$d,$x[ 5], 4,0xfffa3942); # 33
$d = HH($d,$a,$b,$c,$x[ 8],11,0x8771f681); # 34
$c = HH($c,$d,$a,$b,$x[11],16,0x6d9d6122); # 35
$b = HH($b,$c,$d,$a,$x[14],23,0xfde5380c); # 36
$a = HH($a,$b,$c,$d,$x[ 1], 4,0xa4beea44); # 37
$d = HH($d,$a,$b,$c,$x[ 4],11,0x4bdecfa9); # 38
$c = HH($c,$d,$a,$b,$x[ 7],16,0xf6bb4b60); # 39
$b = HH($b,$c,$d,$a,$x[10],23,0xbebfbc70); # 40
$a = HH($a,$b,$c,$d,$x[13], 4,0x289b7ec6); # 41
$d = HH($d,$a,$b,$c,$x[ 0],11,0xeaa127fa); # 42
$c = HH($c,$d,$a,$b,$x[ 3],16,0xd4ef3085); # 43
$b = HH($b,$c,$d,$a,$x[ 6],23, 0x4881d05); # 44
$a = HH($a,$b,$c,$d,$x[ 9], 4,0xd9d4d039); # 45
$d = HH($d,$a,$b,$c,$x[12],11,0xe6db99e5); # 46
$c = HH($c,$d,$a,$b,$x[15],16,0x1fa27cf8); # 47
$b = HH($b,$c,$d,$a,$x[ 2],23,0xc4ac5665); # 48
# Round 4
$a = II($a,$b,$c,$d,$x[ 0], 6,0xf4292244); # 49
$d = II($d,$a,$b,$c,$x[ 7],10,0x432aff97); # 50
$c = II($c,$d,$a,$b,$x[14],15,0xab9423a7); # 51
$b = II($b,$c,$d,$a,$x[ 5],21,0xfc93a039); # 52
$a = II($a,$b,$c,$d,$x[12], 6,0x655b59c3); # 53
$d = II($d,$a,$b,$c,$x[ 3],10,0x8f0ccc92); # 54
$c = II($c,$d,$a,$b,$x[10],15,0xffeff47d); # 55
$b = II($b,$c,$d,$a,$x[ 1],21,0x85845dd1); # 56
$a = II($a,$b,$c,$d,$x[ 8], 6,0x6fa87e4f); # 57
$d = II($d,$a,$b,$c,$x[15],10,0xfe2ce6e0); # 58
$c = II($c,$d,$a,$b,$x[ 6],15,0xa3014314); # 59
$b = II($b,$c,$d,$a,$x[13],21,0x4e0811a1); # 60
$a = II($a,$b,$c,$d,$x[ 4], 6,0xf7537e82); # 61
$d = II($d,$a,$b,$c,$x[11],10,0xbd3af235); # 62
$c = II($c,$d,$a,$b,$x[ 2],15,0x2ad7d2bb); # 63
$b = II($b,$c,$d,$a,$x[ 9],21,0xeb86d391); # 64
$state[0] = add_unsigned($state[0],$a);
$state[1] = add_unsigned($state[1],$b);
$state[2] = add_unsigned($state[2],$c);
$state[3] = add_unsigned($state[3],$d);
}
# rotate $x left $n bits.
sub rotate_left # ($x,$n)
{
my($x,$n) = @_;
return(($x << $n) | ($x >> (32 - $n)) & 0xffffffff);
}
1; # for require
|
