#!/usr/bin/perl
#
# Looking at the DES algorithm
# Jim Mahoney, April 26 2005
#
# See
#
#   http://www.aci.net/kalliste/des.htm
#   http://en.wikipedia.org/wiki/Data_Encryption_Standard
#
#   http://en.wikipedia.org/wiki/Block_cipher_modes_of_operation
#   http://www.cs.eku.edu/faculty/styer/460/Encrypt/JS-AES-Chain.html
#
# This follows Grabbe's description closely (the www.aci.net link),
# and matches the data there at every step.
#
# The bit operations are done using Bits.pm,
# a fairly straightforward bit-munging package I
# threw together for this example.
#

use strict;
use warnings;
use Bits;

print "DES encryption\n\n";

my $key = new Bits hex => '133457799BBCDFF1';
print "key = " . $key->as_hex    . "\n";
print "    = " . $key->as_binary . "\n";

my $msg = new Bits hex => '0123456789ABCDEF';
print "msg = " . $msg->as_hex    . "\n";
print "    = " . $msg->as_binary . "\n";

# initial permutation
my @IP = ( 
  57,49,41,33,25,17,9,1,59,51,43,35,27,19,11,3,61,53,45,37,29,21,13,5,63, 
  55,47,39,31,23,15,7,56,48,40,32,24,16,8,0,58,50,42,34,26,18,10,2,60,52,
  44,36,28,20,12,4,62,54,46,38,30,22,14,6 
 );
print "\n";
print "initial permutation = \n";
print_permutation(@IP);

$msg = $msg->permute(@IP);
print "msg = " . $msg->as_hex    . "\n";
print "    = " . $msg->as_binary . "\n";

my @left;
my @right;

my $l = $left[0]  = $msg->permute(0..31);
my $r = $right[0] = $msg->permute(32..63);
print "left[0]  = " . $l->as_hex . " = $l (" . $l->size . " bits)\n";
print "right[0] = " . $r->as_hex . " = $r (" . $r->size . " bits)\n";

# 1st key permutation
my @PC1 = (
  56,48,40,32,24,16,8,0,57,49,41,33,25,17,9,1,58,50,42,34,26,18,10,2,59,
  51,43,35,62,54,46,38,30,22,14,6,61,53,45,37,29,21,13,5,60,52,44,36,28,
  20,12,4,27,19,11,3 
 );
print "\n";
print "PC-1 key permutation = \n";
print_permutation(@PC1);

my $key_pc1 = $key->permute(@PC1);
print "key_pc1 = " . $key_pc1->as_hex    . "\n";
print "        = " . $key_pc1->as_binary . "\n";
print "   size = " . $key_pc1->size      . "\n";

my $C = $key_pc1->permute(0..27);
my $D = $key_pc1->permute(28..55);
print "C left key  = " . $C->as_hex . " = $C (" . $C->size  . ") bits\n";
print "D right key = " . $D->as_hex . " = $D (" . $D->size  . ") bits\n";

my @left_shifts = ( 0,1,1, (2)x6, 1, (2)x6, 1 );
print "\n";
print "left_shifts(0..$#left_shifts) = ( @left_shifts )\n";
my @total_shifts;
for (my $i=0; $i<@left_shifts; $i++){
  $total_shifts[$i] = 0;
  for (my $j=0; $j<=$i; $j++){
    $total_shifts[$i]+= $left_shifts[$j];
  }
}
print "total_shifts(0..$#left_shifts) = ( @total_shifts )\n\n";

print "sample left shifted C(n), D(n) are \n";
my $n = 4;
print "C($n) = " . Cn($n) . "\n";
print "D($n) = " . Dn($n) . "\n";
print "\n";

my @PC2 = (
  13,16,10,23,0,4,2,27,14,5,20,9,22,18,11,3,25,7,15,6,26,19,12,1,40,51,30,
  36,46,54,29,39,50,44,32,47,43,48,38,55,33,52,45,41,49,35,28,31
 );
print "PC-2 key permutation = \n";
print_permutation(@PC2);
print "\n";

print "sample Kn is \n";
$n = 4;
my $Kn = Kn($n);
print "K($n) = $Kn (" . $Kn->size . " bits)\n";
print "\n";

my @expansion = (
  31,0,1,2,3,4,3,4,5,6,7,8,7,8,9,10,11,12,11,12,13,14,15,16,15,16,17,
  18,19,20,19,20,21,22,23,24,23,24,25,26,27,28,27,28,29,30,31,0
 );
print "expansion permutation = \n";
print_permutation(@expansion);
print "\n";

# S-boxes
my $Sboxes=
  [
    [
      [14,  4, 13,  1,  2, 15, 11,  8,  3, 10,  6, 12,  5,  9,  0,  7, ],
      [ 0, 15,  7,  4, 14,  2, 13,  1, 10,  6, 12, 11,  9,  5,  3,  8, ],
      [ 4,  1, 14,  8, 13,  6,  2, 11, 15, 12,  9,  7,  3, 10,  5,  0, ],
      [15, 12,  8,  2,  4,  9,  1,  7,  5, 11,  3, 14, 10,  0,  6, 13, ],
     ],
    [
      [15,  1,  8, 14,  6, 11,  3,  4,  9,  7,  2, 13, 12,  0,  5, 10, ],
      [ 3, 13,  4,  7, 15,  2,  8, 14, 12,  0,  1, 10,  6,  9, 11,  5, ],
      [ 0, 14,  7, 11, 10,  4, 13,  1,  5,  8, 12,  6,  9,  3,  2, 15, ],
      [13,  8, 10,  1,  3, 15,  4,  2, 11,  6,  7, 12,  0,  5, 14,  9, ],
     ],
    [
      [10,  0,  9, 14,  6,  3, 15,  5,  1, 13, 12,  7, 11,  4,  2,  8, ],
      [13,  7,  0,  9,  3,  4,  6, 10,  2,  8,  5, 14, 12, 11, 15,  1, ],
      [13,  6,  4,  9,  8, 15,  3,  0, 11,  1,  2, 12,  5, 10, 14,  7, ],
      [ 1, 10, 13,  0,  6,  9,  8,  7,  4, 15, 14,  3, 11,  5,  2, 12, ],
     ],
    [
      [ 7, 13, 14,  3,  0,  6,  9, 10,  1,  2,  8,  5, 11, 12,  4, 15, ],
      [13,  8, 11,  5,  6, 15,  0,  3,  4,  7,  2, 12,  1, 10, 14,  9, ],
      [10,  6,  9,  0, 12, 11,  7, 13, 15,  1,  3, 14,  5,  2,  8,  4, ],
      [ 3, 15,  0,  6, 10,  1, 13,  8,  9,  4,  5, 11, 12,  7,  2, 14, ],
     ],
    [
      [ 2, 12,  4,  1,  7, 10, 11,  6,  8,  5,  3, 15, 13,  0, 14,  9, ],
      [14, 11,  2, 12,  4,  7, 13,  1,  5,  0, 15, 10,  3,  9,  8,  6, ],
      [ 4,  2,  1, 11, 10, 13,  7,  8, 15,  9, 12,  5,  6,  3,  0, 14, ],
      [11,  8, 12,  7,  1, 14,  2, 13,  6, 15,  0,  9, 10,  4,  5,  3, ],
     ],
    [
      [12,  1, 10, 15,  9,  2,  6,  8,  0, 13,  3,  4, 14,  7,  5, 11, ],
      [10, 15,  4,  2,  7, 12,  9,  5,  6,  1, 13, 14,  0, 11,  3,  8, ],
      [ 9, 14, 15,  5,  2,  8, 12,  3,  7,  0,  4, 10,  1, 13, 11,  6, ],
      [ 4,  3,  2, 12,  9,  5, 15, 10, 11, 14,  1,  7,  6,  0,  8, 13, ],
     ],
    [
      [ 4, 11,  2, 14, 15,  0,  8, 13,  3, 12,  9,  7,  5, 10,  6,  1, ],
      [13,  0, 11,  7,  4,  9,  1, 10, 14,  3,  5, 12,  2, 15,  8,  6, ],
      [ 1,  4, 11, 13, 12,  3,  7, 14, 10, 15,  6,  8,  0,  5,  9,  2, ],
      [ 6, 11, 13,  8,  1,  4, 10,  7,  9,  5,  0, 15, 14,  2,  3, 12, ],
     ],
    [
      [13,  2,  8,  4,  6, 15, 11,  1, 10,  9,  3, 14,  5,  0, 12,  7, ],
      [ 1, 15, 13,  8, 10,  3,  7,  4, 12,  5,  6, 11,  0, 14,  9,  2, ],
      [ 7, 11,  4,  1,  9, 12, 14,  2,  0,  6, 10, 13, 15,  3,  5,  8, ],
      [ 2,  1, 14,  7,  4, 10,  8, 13, 15, 12,  9,  0,  3,  5,  6, 11, ],
     ],
   ];
print "S boxes are \n";
foreach my $i (0..7){
  my $box = $Sboxes->[$i];
  print " S$i = [\n";
  foreach my $row (0..3){
    print "       [";
    foreach my $column (0..15){
      printf "%2i ", $box->[$row][$column];
    }
    print "],\n";
  }
  print "      ]\n";
}
print "\n";


my @fpermute = (
  15,6,19,20,28,11,27,16,0,14,22,25,4,17,30,9,
  1,7,23,13,31,26,2,8,18,12,29,5,21,10,3,24
 );
print "f permutation = \n";
print_permutation(@fpermute);
print "\n";

my @IPinv = 
  (39,7,47,15,55,23,63,31,38,6,46,14,54,22,62,30,37,5,45,13,53,21,
   61,29,36,4,44,12,52,20,60,28,35,3,43,11,51,19,59,27,34,2,42,10,
   50,18,58,26,33,1,41,9,49,17,57,25,32,0,40,8,48,16,56,24
  );
print "IP inverse permutation = \n";
print_permutation(@IPinv);
print "\n";

# -- 16 rounds --
for (my $round = 1; $round <= 16; $round++){

  print "-- round $round -- \n";

  $left[$round] = $right[$round-1]->clone;                   # 32 bits
  print " L[$round] = " . $left[$round] . "\n";
  print " K[$round]    = " . Kn($round) . "\n";

  my $r_expand  = $right[$round-1]->permute(@expansion);     # 48 bits
  print " E(R[$round]) = " . $r_expand . "\n";
  my $addresses = $r_expand ^ Kn($round);                    # 48 bits
  print " K[$round]+E(R[$round]) = " . $addresses . "\n";

  my $f = new Bits;
  for (my $group = 0; $group < 8; $group++){
    my $Bi = $addresses->permute( $group*6 .. $group*6+5 );  # 6 bits  0..63
    my $fourBits = Sbox($group, $Bi);                        # 4 bits  0..16
    print " B$group = " . $Bi->as_binary . "; ";
    print " S$group(B$group) = " . $fourBits->as_binary . "\n";
    $f = $f . $fourBits;
  }
  print " f = $f \n";

  $f = $f->permute(@fpermute);
  print " P(f) = $f \n";

  $right[$round] = $left[$round-1] ^ $f;
  print " R[$round] = " . $right[$round] . "\n";

}

print "\n";
print "left[16] = " . $left[16] . "\n";
print "right[16] = " . $right[16] . "\n";

my $R16L16 = $right[16] . $left[16];
print "\n";
print "R[16]L[16] = " . $R16L16->as_hex    . "\n";
print "           = " . $R16L16->as_binary . "\n";

my $des = $R16L16->permute(@IPinv);
print "\n";
print "des(msg) = " . $des->as_hex    . "\n";
print "         = " . $des->as_binary . "\n";

print "\n";
print "So there.\n";

# - - - - subroutines - - - - 

sub Cn {
  my ($n) = @_;
  return $C << $total_shifts[$n];
}

sub Dn {
  my ($n) = @_;
  return $D << $total_shifts[$n];
}

sub Kn {
  my ($n) = @_;
  my $CnDn = Cn($n) . Dn($n);
  return $CnDn->permute(@PC2);
}

# B has 6 bits : abcdef which we split into
#                af   = row (base 2) = 0..3
#                bcde = col (base 2) = 0..15
# n is which of the 8 of the S-boxes we want.
# Returned is a size=4 Bits object.
sub Sbox {
  my ($n, $B) = @_;
  my $row = 2*$B->get(0) +   $B->get(5);
  my $col = 8*$B->get(1) + 4*$B->get(2) + 2*$B->get(3) + $B->get(4);
  my $number = $Sboxes->[$n][$row][$col];
  # Make sure that what goes back is 4 bits long.
  return new Bits binary => sprintf("%04b", $number);
}

sub print_permutation {
  my @perm = @_;
  my $n=scalar(@perm)/4;
  print  " ( ";   printf "%02i ", $perm[$_] for    0..  $n-1;  print "\n";
  print  "   ";   printf "%02i ", $perm[$_] for   $n..2*$n-1;  print "\n";
  print  "   ";   printf "%02i ", $perm[$_] for 2*$n..3*$n-1;  print "\n";
  print  "   ";   printf "%02i ", $perm[$_] for 3*$n..4*$n-1;  print ")";
  print  " has " . 4*$n . " bits.\n";
}


