纯Perl实现的DES加密算法

清华大佬耗费三个月吐血整理的几百G的资源,免费分享!....>>>

#!/usr/bin/perl -w

# DES algorithm - reference to http://orlingrabbe.com/des.htm

sub iteration_handle {
  my ($bitstring, $pad) = @_;
  my $bitstringp = pack 'b*', $bitstring;
  my @bitarray = split(//, unpack('b*',$bitstringp));

  my @subkey;
  # perl give four zeros append the last of packed string
  my ($d1, $d2) = (scalar(@bitarray) - 4, scalar(@bitarray) - 1);
  delete @bitarray[$d1..$d2];

  #print "PAD=$pad\n";

  # handle last $pad bits
  for ($n=$pad; $n>0; $n--) {
    $subkey[scalar(@bitarray)-$n] = $bitarray[$pad - $n]; 
  }

  # handle head of bits
  for($i=0; $i<(scalar(@bitarray)-$pad); $i++) {
    #if ($i == $#bitarray) {
    #  $subkey[$i] = $bitarray[0];
    #} else {
    $subkey[$i] = $bitarray[$i+$pad];
    #}
    #print $i. ": ". $subkey[$i]. "\n";
  }
  return join('', @subkey);
}

sub tobit {
  my $uncode = shift;
  my %codemap = ('0' => '0000', '1' => '0001', '2' => '0010', '3' => '0011',
                 '4' => '0100', '5' => '0101', '6' => '0110', '7' => '0111',
                 '8' => '1000', '9' => '1001', 'A' => '1010', 'B' => '1011',
                 'C' => '1100', 'D' => '1101', 'E' => '1110', 'F' => '1111');
  my $coded = '';
  my @chars = split('', $uncode);
  foreach $c (@chars) {
      $coded .= $codemap{$c};
  }
  return $coded;
}


sub tohex {
  my $origin = shift;
  my @hexbits = split(//, $origin);
  my $ret = '';
  for ($j=0; $j<@hexbits; $j=$j+4) {
    $hex = join '', @hexbits[$j..($j+3)];
    $ret .=  sprintf ("%x", oct('0b' .$hex)); 
  }
  return $ret;
}

sub permuted {

  my $unpermuted = shift;

  # the first permutation chooser map table
  my @pc1map = (57, 49, 41, 33, 25, 17,  9,
                 1, 58, 50, 42, 34, 26, 18,
                10,  2, 59, 51, 43, 35, 27,
                19, 11,  3, 60, 52, 44, 36,
                63, 55, 47, 39, 31, 23, 15,
                 7, 62, 54, 46, 38, 30, 22,
                14,  6, 61, 53, 45, 37, 29,
                21, 13,  5, 28, 20, 12,  4);
 
  my $permuted = '';

  my @unpermutation = split(//, $unpermuted);
  foreach $d (@pc1map) {
    $permuted .= $unpermutation[$d-1]; # start from index 1

  }
  return $permuted; 
}

sub generate_subkey {
  my $origin = shift;
  
  # the second permutation chooser map table
  my @pc2map = (14, 17, 11, 24,  1,  5,
                 3, 28, 15,  6, 21, 10,
                23, 19, 12,  4, 26,  8,
                16,  7, 27, 20, 13,  2,
                41, 52, 31, 37, 47, 55,
                30, 40, 51, 45, 33, 48,
                44, 49, 39, 56, 34, 53, 
                46, 42, 50, 36, 29, 32); 

  my $permuted = '';
  my @unpermutation = split(//, $origin);
  foreach $d (@pc2map) {
    $permuted .= $unpermutation[$d-1]; # start from index 1
  }
  return $permuted; 
  
}

sub initial_permutation {
  my $origin = shift;

  # the initial permutation map table
  my @IP = (58, 50, 42, 34, 26, 18, 10, 2,
            60, 52, 44, 36, 28, 20, 12, 4,
            62, 54, 46, 38, 30, 22, 14, 6,
            64, 56, 48, 40, 32, 24, 16, 8,
            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);

  my $permuted = '';
  my @unpermutation = split(//, $origin);
  foreach $d (@IP) {
    $permuted .= $unpermutation[$d-1]; # start from index 1
  }
  return $permuted;
}

sub expand {
  my $origin = shift;

  # bit selection table
  my @selection_table = (32,  1,  2,  3,  4,  5,
                          4,  5,  6,  7,  8,  9,
                          8,  9, 10, 11, 12, 13,
                         12, 13, 14, 15, 16, 17,
                         16, 17, 18, 19, 20, 21,
                         20, 21, 22, 23, 24, 25,
                         24, 25, 26, 27, 28, 29,
                         28, 29, 30, 31, 32,  1);  

  my $permuted = '';
  my @unpermutation = split(//, $origin);
  foreach $d (@selection_table) {
    #print "array of position $d: $unpermutation[$d-1]\n";
    $permuted .= $unpermutation[$d-1]; # start from index 1
  }
  return $permuted;

}

sub subxor {
  my ($a, $b) = @_;
  my @as = split(//, $a);
  my @bs = split(//, $b);

  my @targets;

  for ($z=0; $z<@as; $z++) {
    if ($as[$z] eq '0' && $bs[$z] eq '0') {
      $targets[$z] = '0';
    } elsif ($as[$z] eq '1' && $bs[$z] eq '1') {
      $targets[$z] = '0';
    } else { 
      $targets[$z] = '1';
    }    
  }

  return join '', @targets;
}

sub cal_sboxes {
  my $origin = shift;
  
  my @sboxes;
 
  my @scalars = split(//, $origin);

  my @sb1 = (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);

  my @sb2 = (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);

  my @sb3 = (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);

  my @sb4 = ( 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);

  my @sb5 = ( 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);

  my @sb6 = (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);

  my @sb7 = ( 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);

  my @sb8 = (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);

  @sboxes = (\@sb1, \@sb2, \@sb3, \@sb4, \@sb5, \@sb6, \@sb7, \@sb8);

  my $ret = '';
  my $index = 0;
  for ($i=0; $i<@scalars; $i=$i+6, $index++) {
      $row = oct('0b'. join ('', @scalars[$i,($i+5)]));
      $col = oct ('0b'. join ('', @scalars[($i+1)..($i+4)]));
      #print "ROW: $row, COL= $col\n";
      $sindex = $row == 0 ? ($row * 15 + $col) : ($row * 16 + $col);
      #print "SINDEX = $sindex\n";
      #print "ROW= $row, COL= $col, V= $sboxes[$index][$sindex]\n";
      #print sprintf("%04b", $sboxes[$index][$sindex]);
      $ret .= sprintf("%04b", $sboxes[$index][$sindex]);
  }

  return $ret;
}

sub second_permutation {
  my $origin = shift;

  # bit selection table
  my @sp = (16,  7, 20, 21,
            29, 12, 28, 17,
             1, 15, 23, 26,
             5, 18, 31, 10,
             2,  8, 24, 14, 
            32, 27,  3,  9,
            19, 13, 30,  6,
            22, 11,  4, 25);

  my $permuted = '';
  my @unpermutation = split(//, $origin);
  foreach $d (@sp) {
    $permuted .= $unpermutation[$d-1]; # start from index 1
  }
  return $permuted;
}

sub handle_func {
  
  my ($rp, $key) = @_;

  # expand $rp[n-1] from 32 bits to 48 bits
  my $expands = expand $rp;
  #print "EXP= $expands\n";

  # XOR
  my $xor = subxor $key, $expands;

  #print "XOR= $xor\n";
  my $ret = '';
  # calcute sboxes
  my $sbs = cal_sboxes($xor); 
  #print "SBS= $sbs\n";
  
  $ret = second_permutation $sbs;
  #print "FP = $ret\n";

  return $ret;
}

sub final_permutation {
  my $origin = shift;

  # bit selection table
  my @fp = (40, 8, 48, 16, 56, 24, 64, 32, 
            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);

  my $permuted = '';
  my @unpermutation = split(//, $origin);
  foreach $d (@fp) {
    $permuted .= $unpermutation[$d-1]; # start from index 1
  }
  return $permuted;
}

# Step1: Create 16 subkeys, each of which is 48-bits long.
$original_key = '133457799BBCDFF1'; 
#print "KEY   = ". $original_key. "\n";

my $keybits = tobit $original_key;

#print "K = ". $keybits. "\n";

$permutation = permuted $keybits;

#print "K+ = ". $permutation. "\n\n";

my @subkeys;

$subkeys[0] = $permutation;

my @permutations = split(//, $permutation);

my @leftpart;
my @rightpart;

$leftpart[0] = join('', @permutations[0..27]);
$rightpart[0] = join ('', @permutations[28..55]);

#print "C0: ". $leftpart[0]. "\n";
#print "D0: ". $rightpart[0]. "\n\n";

# irations table for shift N
my %iterations = (1 => 1, 2 => 1, 3 => 2, 4 => 2, 5 => 2, 6 => 2, 7 => 2,
                  8 => 2, 9 => 1, 10 => 2, 11 => 2, 12 => 2, 13 => 2, 
                  14 => 2, 15 => 2, 16 => 1);

for ($j=1; $j<=16; $j++) {
  $leftpart [$j] = iteration_handle $leftpart[$j-1], $iterations{$j};
  $rightpart[$j] = iteration_handle $rightpart[$j-1], $iterations{$j};
  #print "C". $j. " = ". $leftpart[$j]. "\n";
  #print "D". $j. " = ". $rightpart[$j]. "\n\n";
  $subkeys[$j] = generate_subkey($leftpart[$j]. $rightpart[$j]);
  #print "K". $j. " = ". $subkeys[$j]. "\n";
}

# Step 2: Encode each 64-bit block of data

my $data = '0123456789ABCDEF';
print "DATA  = ". $data. "\n";
my $ip = initial_permutation(tobit($data));
#print "IP = ". $ip. "\n";

# $ip = $lp[0] + $rp[0]

my (@lp, @rp);
$lp[0] = join '', (split(//, $ip))[0..31];
$rp[0] = join '', (split(//, $ip))[32..63];

#print "L0 = ". $lp[0]. "\n";
#print "R0 = ". $rp[0]. "\n";

for ($x=1; $x<=16; $x++) {
  $lp[$x] = $rp[$x-1];
  #print "L". $x. " = ". $lp[$x]. "\n";
  #print "R". ($x-1). " = ". $rp[$x-1]. "\n";
  #print "K". $x. " = ". $subkeys[$x]. "\n";
  #print "L". ($x-1). " = ". $lp[$x-1]. "\n";
  $rp[$x] = subxor($lp[$x-1], handle_func($rp[$x-1], $subkeys[$x]));
  #print "R". $x. " = ". $rp[$x]. "\n";
}

my $reverse = $rp[16]. $lp[16];
#print "R16L16 = ". $reverse. "\n";

my $final = final_permutation $reverse;
$final = uc(tohex $final);

print "FINAL = $final\n";