use strict;
use warnings;
use integer;
use Digest::MD5 qw( md5 );
use URI::Escape;

# Good guys compute this
my $secret = "don't tell";
my $good_data = "this_data_is_ok";
my $good_hash = md5($secret . $good_data);
print "Good:  ", unpack("H*", $good_hash), ":",
    uri_escape($good_data), "\n";

# Bad guys compute this
my $bad_stuff = "this_is_bogus";
my $bad_data = $good_data
    . padding(length($secret) + length($good_data))
    . $bad_stuff;
my $bad_hash = md5_update( $good_hash,
    $bad_stuff . padding(64 + length($bad_stuff)) );
print "Bad:   ", unpack("H*", $bad_hash), ":",
    uri_escape($bad_data), "\n";

# Good guys get fooled
my $check_hash = md5($secret . $bad_data);
print "Check: ", unpack("H*", $check_hash), " ",
    ($check_hash eq $bad_hash ? "valid data!" : "INVALID"), "\n";

sub padding {
  my ($len)   = @_;
  my $lastblk = ($len + 9) & 63;
  my $padlen  = $lastblk ? 64 - $lastblk : 0;
  return "\x80" . ("\0" x $padlen) . pack("V2", $len*8, 0);
} # padding

BEGIN {
  my @c = (
      0xd76aa478, 0xe8c7b756, 0x242070db, 0xc1bdceee, 0xf57c0faf,
      0x4787c62a, 0xa8304613, 0xfd469501, 0x698098d8, 0x8b44f7af,
      0xffff5bb1, 0x895cd7be, 0x6b901122, 0xfd987193, 0xa679438e,
      0x49b40821, 0xf61e2562, 0xc040b340, 0x265e5a51, 0xe9b6c7aa,
      0xd62f105d, 0x02441453, 0xd8a1e681, 0xe7d3fbc8, 0x21e1cde6,
      0xc33707d6, 0xf4d50d87, 0x455a14ed, 0xa9e3e905, 0xfcefa3f8,
      0x676f02d9, 0x8d2a4c8a, 0xfffa3942, 0x8771f681, 0x6d9d6122,
      0xfde5380c, 0xa4beea44, 0x4bdecfa9, 0xf6bb4b60, 0xbebfbc70,
      0x289b7ec6, 0xeaa127fa, 0xd4ef3085, 0x04881d05, 0xd9d4d039,
      0xe6db99e5, 0x1fa27cf8, 0xc4ac5665, 0xf4292244, 0x432aff97,
      0xab9423a7, 0xfc93a039, 0x655b59c3, 0x8f0ccc92, 0xffeff47d,
      0x85845dd1, 0x6fa87e4f, 0xfe2ce6e0, 0xa3014314, 0x4e0811a1,
      0xf7537e82, 0xbd3af235, 0x2ad7d2bb, 0xeb86d391,
  );
  sub md5_update {
    my ($hash, $data) = @_;
    my @h = unpack "V4", $hash;
    my @x = unpack "V16", $data;
    my ($a, $b, $c, $d) = @h;
    my ($t, $r);

    # round 1
    for (0 .. 15) {
      $t = $a + $c[$_] + $x[$_] + ((($c^$d)&$b)^$d);
      $r = (7, 12, 17, 22)[$_ & 3];
      $t = ($t<<$r) | ($t>>(32-$r)) & ~(~0<<$r);
      $a = $d; $d = $c; $c = $b; $b += $t;
    }

    # round 2
    for (16 .. 31) {
      $t = $a + $c[$_] + $x[($_*5+1)&15] + ((($b^$c)&$d)^$c);
      $r = (5, 9, 14, 20)[$_ & 3];
      $t = ($t<<$r) | ($t>>(32-$r)) & ~(~0<<$r);
      $a = $d; $d = $c; $c = $b; $b += $t;
    }

    # round 3
    for (32 .. 47) {
      $t = $a + $c[$_] + $x[($_*3+5)&15] + ($b^$c^$d);
      $r = (4, 11, 16, 23)[$_ & 3];
      $t = ($t<<$r) | ($t>>(32-$r)) & ~(~0<<$r);
      $a = $d; $d = $c; $c = $b; $b += $t;
    }

    # round 4
    for (48 .. 63) {
      $t = $a + $c[$_] + $x[($_*7)&15] + ($c^($b|~$d));
      $r = (6, 10, 15, 21)[$_ & 3];
      $t = ($t<<$r) | ($t>>(32-$r)) & ~(~0<<$r);
      $a = $d; $d = $c; $c = $b; $b += $t;
    }

    $h[0] = ($h[0] + $a) & 0xffffffff;
    $h[1] = ($h[1] + $b) & 0xffffffff;
    $h[2] = ($h[2] + $c) & 0xffffffff;
    $h[3] = ($h[3] + $d) & 0xffffffff;
    return pack "V4", @h;
  } # md5_update
}