package MD5;
use strict;
use integer;
require 5.000;

# $Id$

#
# Note: If you want to make your MD5 digests differ from others,
#       then uncomment and tune the "security feature" in the Digest
#       subroutine below.
#
#       This is useful if you want to get an undecodable digest for
#       security purposes. Standard MD5 can be decoded if the *set* 
#       of possible originals is small and known
#       (e.g. last two digits of an IP number)

require Exporter;

@MD5::ISA = qw( Exporter );
@MD5::EXPORT = qw( &Digest &HexDigest );

use integer;

#
# interface routine; returns a digest of a string passed as a parameter
#

# MD5 initialization. Begins an MD5 operation, writing a new context.

sub MD5Init {
    return {
	    'count' => [0, 0],
	    'buffer' => '',
	    'state' => [ 0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476],
	   };
}


sub Digest {
    my $context = MD5Init();

    # security feature: uncomment and put your own "magic string"
    # note: MD5test.pl will not work with your magic string, of course
    # my $magicString = '!@#$%^';
    # MD5Update($context, $magicString, length($magicString));

    # this should be done always
    MD5Update($context, $_[0], length($_[0]));

    return MD5Final($context);
}

#
# same as Digest but returns digest in a printable (hex) form
#

sub HexDigest { unpack("H*", Digest(@_)) }


#
# MD5 implementation is below
#



# derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm

# Original context structure
# typedef struct {
#
#       UINT4 state[4];                                   /* state (ABCD) */
#       UINT4 count[2];        /* number of bits, modulo 2^64 (lsb first) */
#       unsigned char buffer[64];                         /* input buffer */
#
# } MD5_CTX;


# Constants for MD5Transform routine.

use constant S11 =>  7;
use constant S12 => 12;
use constant S13 => 17;
use constant S14 => 22;

use constant S21 =>  5;
use constant S22 =>  9;
use constant S23 => 14;
use constant S24 => 20;

use constant S31 =>  4;
use constant S32 => 11;
use constant S33 => 16;
use constant S34 => 23;

use constant S41 =>  6;
use constant S42 => 10;
use constant S43 => 15;
use constant S44 => 21;

my $PADDING = chr(0x80) . ("\000" x 63);

# FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
# Rotation is separate from addition to prevent recomputation.


sub FF {
    my $i = $_[0] + (($_[1] & $_[2]) | (~$_[1] & $_[3])) + $_[4] + $_[6];
    $_[1] + (($i << $_[5]) | (($i >> (32 - $_[5]) & ~(-1 << $_[5]))));
}

sub GG {
    my $i = $_[0] + (($_[1] & $_[3]) | ($_[2] & ~$_[3])) + $_[4] + $_[6];
    $_[1] + (($i << $_[5]) | (($i >> (32 - $_[5]) & ~(-1 << $_[5]))));
}

sub HH {
    my $i = $_[0] + ($_[1] ^ $_[2] ^ $_[3]) + $_[4] + $_[6];
    $_[1] + (($i << $_[5]) | (($i >> (32 - $_[5]) & ~(-1 << $_[5]))));
}

sub II {
    my $i = $_[0] + ($_[2] ^ ($_[1] | ~$_[3])) + $_[4] + $_[6];
    $_[1] + (($i << $_[5]) | (($i >> (32 - $_[5]) & ~(-1 << $_[5]))));
}

# MD5 block update operation. Continues an MD5 message-digest
# operation, processing another message block, and updating the context.

sub MD5Update {
    my ($context, $input, $inputLen) = @_;

    # Compute number of bytes mod 64
    my $index = (($context->{count}[0] >> 3) & 0x3F);

    # Update number of bits
    if (($context->{count}[0] += ($inputLen << 3)) < ($inputLen << 3)) {
	$context->{count}[1] += ($inputLen >> 29) + 1;
    }

    my $partLen = 64 - $index;

    # Transform as many times as possible.

    my $i;
    if ($inputLen >= $partLen) {

	substr($context -> {buffer}, $index, $partLen) = substr($input, 0, $partLen);

	MD5Transform(\@{$context -> {state}}, $context -> {buffer});

	for ($i = $partLen; $i + 63 < $inputLen; $i += 64) {
	    MD5Transform($context-> {state}, substr($input,$i,64));
	}

	$index = 0;
    } else {
	$i = 0;
    }

    # Buffer remaining input
    substr($context->{buffer}, $index, $inputLen-$i) = substr($input, $i, $inputLen-$i);
}

# MD5 finalization. Ends an MD5 message-digest operation, writing the
#	the message digest and zeroizing the context.

sub MD5Final {
    my $context = shift;

    # Save number of bits
    my $bits = pack("L2", @{$context->{count}});

    # Pad out to 56 mod 64.
    my ($index, $padLen);
    $index = ($context->{count}[0] >> 3) & 0x3f;
    $padLen = ($index < 56) ? (56 - $index) : (120 - $index);

    MD5Update($context, $PADDING, $padLen);

    # Append length (before padding)
    MD5Update($context, $bits, 8);

    # Store state in digest
    my $digest = pack("L4", @{$context-> {state}});

    # MD5_memset ($context, 0);

    return $digest;
}

# MD5 basic transformation. Transforms state based on block.

sub MD5Transform {
    my ($state, $block) = @_;
    my ($A,$B,$C,$D) = @{$state};
    my @x = unpack("L16", $block);

    # Round 1
    $A = FF($A, $B, $C, $D, $x[ 0], S11, 0xd76aa478); # 1
    $D = FF($D, $A, $B, $C, $x[ 1], S12, 0xe8c7b756); # 2
    $C = FF($C, $D, $A, $B, $x[ 2], S13, 0x242070db); # 3
    $B = FF($B, $C, $D, $A, $x[ 3], S14, 0xc1bdceee); # 4
    $A = FF($A, $B, $C, $D, $x[ 4], S11, 0xf57c0faf); # 5
    $D = FF($D, $A, $B, $C, $x[ 5], S12, 0x4787c62a); # 6
    $C = FF($C, $D, $A, $B, $x[ 6], S13, 0xa8304613); # 7
    $B = FF($B, $C, $D, $A, $x[ 7], S14, 0xfd469501); # 8
    $A = FF($A, $B, $C, $D, $x[ 8], S11, 0x698098d8); # 9
    $D = FF($D, $A, $B, $C, $x[ 9], S12, 0x8b44f7af); # 10
    $C = FF($C, $D, $A, $B, $x[10], S13, 0xffff5bb1); # 11
    $B = FF($B, $C, $D, $A, $x[11], S14, 0x895cd7be); # 12
    $A = FF($A, $B, $C, $D, $x[12], S11, 0x6b901122); # 13
    $D = FF($D, $A, $B, $C, $x[13], S12, 0xfd987193); # 14
    $C = FF($C, $D, $A, $B, $x[14], S13, 0xa679438e); # 15
    $B = FF($B, $C, $D, $A, $x[15], S14, 0x49b40821); # 16

    # Round 2
    $A = GG($A, $B, $C, $D, $x[ 1], S21, 0xf61e2562); # 17
    $D = GG($D, $A, $B, $C, $x[ 6], S22, 0xc040b340); # 18
    $C = GG($C, $D, $A, $B, $x[11], S23, 0x265e5a51); # 19
    $B = GG($B, $C, $D, $A, $x[ 0], S24, 0xe9b6c7aa); # 20
    $A = GG($A, $B, $C, $D, $x[ 5], S21, 0xd62f105d); # 21
    $D = GG($D, $A, $B, $C, $x[10], S22,  0x2441453); # 22
    $C = GG($C, $D, $A, $B, $x[15], S23, 0xd8a1e681); # 23
    $B = GG($B, $C, $D, $A, $x[ 4], S24, 0xe7d3fbc8); # 24
    $A = GG($A, $B, $C, $D, $x[ 9], S21, 0x21e1cde6); # 25
    $D = GG($D, $A, $B, $C, $x[14], S22, 0xc33707d6); # 26
    $C = GG($C, $D, $A, $B, $x[ 3], S23, 0xf4d50d87); # 27
    $B = GG($B, $C, $D, $A, $x[ 8], S24, 0x455a14ed); # 28
    $A = GG($A, $B, $C, $D, $x[13], S21, 0xa9e3e905); # 29
    $D = GG($D, $A, $B, $C, $x[ 2], S22, 0xfcefa3f8); # 30
    $C = GG($C, $D, $A, $B, $x[ 7], S23, 0x676f02d9); # 31
    $B = GG($B, $C, $D, $A, $x[12], S24, 0x8d2a4c8a); # 32

    # Round 3
    $A = HH($A, $B, $C, $D, $x[ 5], S31, 0xfffa3942); # 33
    $D = HH($D, $A, $B, $C, $x[ 8], S32, 0x8771f681); # 34
    $C = HH($C, $D, $A, $B, $x[11], S33, 0x6d9d6122); # 35
    $B = HH($B, $C, $D, $A, $x[14], S34, 0xfde5380c); # 36
    $A = HH($A, $B, $C, $D, $x[ 1], S31, 0xa4beea44); # 37
    $D = HH($D, $A, $B, $C, $x[ 4], S32, 0x4bdecfa9); # 38
    $C = HH($C, $D, $A, $B, $x[ 7], S33, 0xf6bb4b60); # 39
    $B = HH($B, $C, $D, $A, $x[10], S34, 0xbebfbc70); # 40
    $A = HH($A, $B, $C, $D, $x[13], S31, 0x289b7ec6); # 41
    $D = HH($D, $A, $B, $C, $x[ 0], S32, 0xeaa127fa); # 42
    $C = HH($C, $D, $A, $B, $x[ 3], S33, 0xd4ef3085); # 43
    $B = HH($B, $C, $D, $A, $x[ 6], S34,  0x4881d05); # 44
    $A = HH($A, $B, $C, $D, $x[ 9], S31, 0xd9d4d039); # 45
    $D = HH($D, $A, $B, $C, $x[12], S32, 0xe6db99e5); # 46
    $C = HH($C, $D, $A, $B, $x[15], S33, 0x1fa27cf8); # 47
    $B = HH($B, $C, $D, $A, $x[ 2], S34, 0xc4ac5665); # 48

    # Round 4
    $A = II($A, $B, $C, $D, $x[ 0], S41, 0xf4292244); # 49
    $D = II($D, $A, $B, $C, $x[ 7], S42, 0x432aff97); # 50
    $C = II($C, $D, $A, $B, $x[14], S43, 0xab9423a7); # 51
    $B = II($B, $C, $D, $A, $x[ 5], S44, 0xfc93a039); # 52
    $A = II($A, $B, $C, $D, $x[12], S41, 0x655b59c3); # 53
    $D = II($D, $A, $B, $C, $x[ 3], S42, 0x8f0ccc92); # 54
    $C = II($C, $D, $A, $B, $x[10], S43, 0xffeff47d); # 55
    $B = II($B, $C, $D, $A, $x[ 1], S44, 0x85845dd1); # 56
    $A = II($A, $B, $C, $D, $x[ 8], S41, 0x6fa87e4f); # 57
    $D = II($D, $A, $B, $C, $x[15], S42, 0xfe2ce6e0); # 58
    $C = II($C, $D, $A, $B, $x[ 6], S43, 0xa3014314); # 59
    $B = II($B, $C, $D, $A, $x[13], S44, 0x4e0811a1); # 60
    $A = II($A, $B, $C, $D, $x[ 4], S41, 0xf7537e82); # 61
    $D = II($D, $A, $B, $C, $x[11], S42, 0xbd3af235); # 62
    $C = II($C, $D, $A, $B, $x[ 2], S43, 0x2ad7d2bb); # 63
    $B = II($B, $C, $D, $A, $x[ 9], S44, 0xeb86d391); # 64

    $state -> [0] += $A;
    $state -> [1] += $B;
    $state -> [2] += $C;
    $state -> [3] += $D;
}

1;