#RC6 Encryption in PERL
#
# Tom St Denis, tomstdenis@yahoo.com, http://tomstdenis.home.dhs.org
#
# Functions you want to call:
#
#      rc6_encrypt_ecb(blk, key)
#
# Encrypts the four 32-bit words in 'blk' under control of the four 32-bit words in 'key' and returns 
# the ciphertext as four 32-bit words.
#
#
#      rc6_decrypt_ecb(blk, key)
#
# Opposite of rc6_encrypt_ecb().
#
#
#      rc6_encrypt_cbc(blk, key, iv)
#
# Encrypts a single block in CBC mode like the ECB routine.  It updates the third argument with the new IV and returns
# the ciphertext.
#
#
#      rc6_decrypt_cbc(blk, key, iv)
#
# Opposite of rc6_encrypt_cbc().
#
#      rc6_setup(key)
#
# Sets up a key which is stored in an array of 8-bit bytes.  It returns the scheduled key that you pass to the
# encrypt/decrypt functions.
#
use Math::BigInt;

#rotations
sub lrot {
    return (($_[0] << ($_[1] % 32)) | ($_[0] >> (32 - ($_[1] % 32)))) % (2**32);
}

sub rrot {
    return (($_[0] >> ($_[1] % 32)) | ($_[0] << (32 - ($_[1] % 32)))) % (2**32);
}

#PERL loads in high-endian fashion by default.  
sub bswap {
    return ( (($_[0]&0xFF000000)>>24) | (($_[0]&0x000000FF)<<24) | 
             (($_[0]&0x00FF0000)>>8) | (($_[0]&0x0000FF00)<<8));
}

sub quad {
   my($x) = new Math::BigInt($_[0]);
   my($y) = new Math::BigInt(2**32);
   $x = ($x * ($x + $x + 1)) % $y;
   return int($x);
}

# rc6_encrypt_ecb(blk, key)
sub rc6_encrypt_ecb {
   # get block
   my($a) = bswap(vec($_[0], 0, 32));
   my($b) = bswap(vec($_[0], 1, 32));
   my($c) = bswap(vec($_[0], 2, 32));
   my($d) = bswap(vec($_[0], 3, 32));
   my($t, $u) = 0;

   # pre white
   $b = ($b + vec($_[1], 0, 32)) % (2**32);
   $d = ($d + vec($_[1], 1, 32)) % (2**32);
 
   # 20 rounds
   for (my($r) = 0; $r < 20; $r++) {
       $t = lrot(quad($b), 5);
       $u = lrot(quad($d), 5);
       $a = (lrot($a ^ $t, $u) + vec($_[1], $r + $r + 2, 32)) % (2**32);
       $c = (lrot($c ^ $u, $t) + vec($_[1], $r + $r + 3, 32)) % (2**32);
       $t = $a; $a = $b; $b = $c; $c = $d; $d = $t;
   }

   #post white and return
   $a = ($a + vec($_[1], 42, 32)) % (2**32);
   $c = ($c + vec($_[1], 43, 32)) % (2**32);
   my($res) = 0;
   vec($res, 0, 32) = bswap($a);
   vec($res, 1, 32) = bswap($b);
   vec($res, 2, 32) = bswap($c);
   vec($res, 3, 32) = bswap($d);
   return $res;
}

# rc6_decrypt_ecb(blk, key)
sub rc6_decrypt_ecb {
   # get block
   my($a) = bswap(vec($_[0], 0, 32));
   my($b) = bswap(vec($_[0], 1, 32));
   my($c) = bswap(vec($_[0], 2, 32));
   my($d) = bswap(vec($_[0], 3, 32));
   my($t, $u) = 0;

   # pre white
   $a = ($a - vec($_[1], 42, 32)) % (2**32);
   $c = ($c - vec($_[1], 43, 32)) % (2**32);
 
   # 20 rounds
   for (my($r) = 19; $r >= 0; $r--) {
       $t = $d; $d = $c; $c = $b; $b = $a; $a = $t;
       $t = lrot(quad($b), 5);
       $u = lrot(quad($d), 5);
       $a = rrot(($a - vec($_[1], $r + $r + 2, 32)) % (2**32), $u) ^ $t;
       $c = rrot(($c - vec($_[1], $r + $r + 3, 32)) % (2**32), $t) ^ $u;
   }

   #post white and return
   $b = ($b - vec($_[1], 0, 32)) % (2**32);
   $d = ($d - vec($_[1], 1, 32)) % (2**32);
   my($res) = 0;
   vec($res, 0, 32) = bswap($a);
   vec($res, 1, 32) = bswap($b);
   vec($res, 2, 32) = bswap($c);
   vec($res, 3, 32) = bswap($d);
   return $res;
}

# rc6_setup(key)
sub rc6_setup {
    # get c constant
    my($c) = (length($_[0])>>2) + ((length($_[0])&3)?1:0);

    # copy key into L array
    my($t, $j, $k, $L, $S) = 0;
    for (my($i) = 0; $i < length($_[0]); $i++) { 
        $t = ($t << 8) | vec($_[0], $i, 8);
        if (++$j == 4) {
           $L[$k++] = bswap($t);
           $j = $t = 0;
        }
    }

    # remaining key material?
    if ($j) {
       $t = $t << (8 * (4 - $j));
       $L[$k] = bswap($t);
    }
         
    # make S array
    $S[0] = 0xb7e15163;
    for ($i = 1; $i < 44; $i++) { $S[$i] = ($S[$i - 1] + 0x9e3779b9) % (2**32); }

    # shuffle it around
    my($v, $A, $B) = (3*44, 0, 0);
    $i = $j = 0;
    for ($s = 0; $s < $v; $s++) {
        $A = ($S[$i] = lrot(($S[$i] + $A + $B) % (2**32), 3));
        $B = ($L[$j] = lrot(($L[$j] + $A + $B) % (2**32), ($A+$B)%32));
        $i = ($i + 1) % 44;
        $j = ($j + 1) % $c;
    }

    # return key
    my($tkey) = 0;
    for ($i = 0; $i < 44; $i++) { vec($tkey, $i, 32) = $S[$i]; }
    return $tkey;
}

#encode a block in CBC mode
#rc6_encrypt_cbc(blk, key, iv)
sub rc6_encrypt_cbc {
    for (my($i) = 0; $i < 4; $i++) { vec($_[0], $i, 32) ^= vec($_[2], $i, 32); }
    my($tmp) = rc6_encrypt_ecb($_[0], $_[1]);
    for ($i = 0; $i < 4; $i++) { vec($_[2], $i, 32) = vec($tmp, $i, 32); }
    return $tmp;
}

#decode a block in CBC mode
#rc6_decrypt_cbc(blk, key, iv)
sub rc6_decrypt_cbc {
    my($tmp) = rc6_decrypt_ecb($_[0], $_[1]);
    for (my($i) = 0; $i < 4; $i++) { vec($tmp, $i, 32) ^= vec($_[2], $i, 32); vec($_[2], $i, 32) = vec($_[0], $i, 32); }
    return $tmp;
}


# ----------> DEMO <----------
@testkey = (0x01, 0x23, 0x45, 0x67, 0x89, 0xab, 0xcd, 0xef, 0x01, 0x12, 0x23, 0x34,
            0x45, 0x56, 0x67, 0x78);

@testpt  = (0x02, 0x13, 0x24, 0x35, 0x46, 0x57, 0x68, 0x79, 0x8a, 0x9b, 0xac, 0xbd,
            0xce, 0xdf, 0xe0, 0xf1);

@testct =  (0x52, 0x4e, 0x19, 0x2f, 0x47, 0x15, 0xc6, 0x23, 0x1f, 0x51, 0xf6, 0x36,
            0x7e, 0xa4, 0x3f, 0x18);

$ukey = $blk = 0;
for ($i = 0; $i < 16; $i++) { vec($ukey, $i, 8) = $testkey[$i]; }
for ($i = 0; $i < 16; $i++) { vec($blk, $i, 8) = $testpt[$i]; }
$key = rc6_setup($ukey);

$ct = rc6_encrypt_ecb($blk, $key);
for ($i = 0; $i < 16; $i++)  { print sprintf("%02lx ", vec($ct, $i, 8)); } print "\n";

$pt = rc6_decrypt_ecb($ct, $key);
for ($i = 0; $i < 16; $i++)  { print sprintf("%02lx ", vec($pt, $i, 8)); } print "\n";

print "Cipher is ";
for ($i = 0; $i < 16; $i++) { last if ($testct[$i] != vec($ct, $i, 8)); }
print "not " if ($i != 16);
print "working properly.";