原本是要放在 NTLM Protocol - 2. DES 编码 这篇文章中, 但不知是不是该章内容太大还是啥么原因, 怎么也传不上, 就拉出来单独放着.
#!/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";
其执行结果如下: