#!/usr/local/bin/perl
my $i;

local @PC_1_TBL = (
        57,49,41,33,25,17, 9, 1,58,50,41,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);
#for($i=0;$i<=$#PC_1_TBL;$i++) {
#        print "passIn[$PC_1_TBL[$i]],\n";
#}

local @PC_2_TBL = (
        14,14,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, 5,30,40,
        51,45,33,48,44,49,39,56,34,53,46,42,50,36,29,32);
#for($i=0;$i<=$#PC_2_TBL;$i++) {
#        print "passOut[$PC_2_TBL[$i]],\n";
#}

local @KS_Count = (
         1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1);
local @KS_Count_1 = (
         0,1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1, 1);

local @IP_TBL = (
        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);
#for($i=0;$i<=$#IP_TBL;$i++) {
#        print "strIn[$IP_TBL[$i]],\n";
#}
#local @IP1_TBL = ();
#for($i=0;$i<=$#IP_TBL;$i++) {
#        $IP1_TBL[$IP_TBL[$i]-1]= $i +1;
#}
#for($i=0;$i<=$#IP1_TBL;$i++) {
#        print "strtmp[$IP1_TBL[$i]],\n";
#}

local @E_Table_TBL = (
        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,22,23,
        22,23,24,25,24,25,26,27,28,29,28,29,30,31,32, 1);
#for($i=0;$i<=$#E_Table_TBL;$i++) {
#        print "In[$E_Table_TBL[$i]],\n";
#}

local @S_Box_TBL1 = (
        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);
local @S_Box_TBL2 = (
        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);
local @S_Box_TBL3 = (
        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);
local @S_Box_TBL4 = (
         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);
local @S_Box_TBL5 = (
         3,12, 4, 1, 7,10, 1, 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);
local @S_Box_TBL6 = (
         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);
local @S_Box_TBL7 = (
        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);
local @S_Box_TBL8 = (
        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, 1, 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);

local @P_Table_TBL = (
        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);
#for($i=0;$i<=$#P_Table_TBL;$i++) {
#        print "In[$P_Table_TBL[$i]],\n";
#}

my $passwd_1_line = "0123456789abcdef";
my $passwd_2_line = "ffeeddccbbaa9988";
my $string_1_line = "0011223344556677";
my @passwd_1 = &hexLine2binArray($passwd_1_line);
my @passwd_2 = &hexLine2binArray($passwd_2_line);
my @string_1 = &hexLine2binArray($string_1_line);
my @string_2=();
my @string_3=();
my @string_4=();
my @string_5=();
my @string_6=();
my @string_7=();
my $aline=();

@string_2 = &DES(1,@passwd_1,@string_1);
@string_3 = &DES(0,@passwd_2,@string_2);
@string_4 = &DES(1,@passwd_1,@string_3);
@string_5 = &DES(0,@passwd_1,@string_4);
@string_6 = &DES(1,@passwd_2,@string_5);
@string_7 = &DES(0,@passwd_1,@string_6);
print "K1:$passwd_1_line\n\n";
print "K2:$passwd_2_line\n\n";
print "S1:$string_1_line\n\n";
print "S1:$#string_1 bit : ".join("",@string_1)."\n";
print "    change: ";
for($i=0;$i<=63;$i++) {
        if( $string_1[$i] == $string_7[$i] ) {
                print " ";
        }
        else {        print "v"; }
}
print "\n";
print "S7:$#string_7 bit : ".join("",@string_7)."\n";
print "    change: ";
for($i=0;$i<=63;$i++) {
        if( $string_1[$i] == $string_4[$i] ) {
                print " ";
        }
        else {        print "v"; }
}
print "\n";
print "S4:$#string_4 bit : ".join("",@string_4)."\n";
$aline = &binArray2hexLine(@string_4);
print "S4:$aline\n";
for($i=0;$i<=63;$i++) {
        if( $string_1[$i] != $string_7[$i] ) {
                print "Compare Error Between S1 and S7 in ${i}th bit => $string_1[$i] : $string_7[$i]\n";
        }
}

sub DES {
        my @IN = @_;
        my $flag;
        my @passwd=();
        my @string=();
        my @passwd_K1=();
        my @passwd_C0=();
        my @passwd_D0=();
        my @string_L0=();
        my @string_R0=();
        my @passwd_C1=();
        my @passwd_D1=();
        my @string_L1=();
        my @string_R1=();
        my $i;
        my $aline;

        ($flag, @passwd[0..63],   @string[0..63]   ) = @IN;
        (@passwd_C0[0..27],@passwd_D0[0..27]) = &PC_1(@passwd);
        (@string_L0[0..31],@string_R0[0..31]) = &IP(@string);

        
        $aline = &binArray2hexLine(@passwd_C0);
        print "ASC11:C0:$#passwd_C0 $i : $aline\n";
        $aline = &binArray2hexLine(@passwd_D0);
        print "ASC11:D0:$#passwd_D0 $i : $aline\n";
        $aline = &binArray2hexLine(@string_R0);
        print "ASC11:R0:$#string_R0 $i : $aline\n";
        $aline = &binArray2hexLine(@string_L0);
        print "ASC11:L0:$#string_L0 $i : $aline\n";

        #print ". ".join("",@passwd_C0)." ".join("",@passwd_D0)."\n";
        for($i=0;$i<16;$i++) {
                (@passwd_K1[0..47],@passwd_C1[0..27],@passwd_D1[0..27]) =
                        &passwd_bl($flag,$i,@passwd_C0,@passwd_D0);

                (@string_L1[0..31],@string_R1[0..31]) =
                        &string_bl(@passwd_K1,@string_L0,@string_R0);

                @passwd_C0 = @passwd_C1;
                @passwd_D0 = @passwd_D1;

                @string_L0 = @string_L1;
                @string_R0 = @string_R1;

        
        #print ":K1:$i $#passwd_K1 $i : ".join("",@passwd_K1)."\n";
        #print ":R0:$i $#string_R0 $i : ".join("",@string_R0)."\n";
        #print ":L0:$i $#string_L0 $i : ".join("",@string_L0)."\n";
                @string = (@string_L0,@string_R0);
        }
        #print ":Ro:$#string_R0 $i : ".join("",@string_R0)."\n";
        #print ":Lo:$#string_L0 $i : ".join("",@string_L0)."\n";

        @string = &IP_1(@string_R0[0..31],@string_L0[0..31]);
        #print "$#string IP1 : ".join("",@string)."\n";
        return @string;
        
}
sub PC_1 {
        my @IN = @_;
        my @OUT = ();
        my $i;
        #print "$#IN PC1_In : ".join("",@IN)."\n";
        for($i=0;$i<=$#PC_1_TBL;$i++) {
                $OUT[$i]=$IN[$PC_1_TBL[$i] - 1];
        }
        #print "$#OUT PC1 : ".join("",@OUT)."\n";
        return @OUT;
}
sub passwd_bl {
        my @IN = @_;
        my $flag;
        my $round;
        my @passwd_C0=();
        my @passwd_D0=();
        my @passwd_C1=();
        my @passwd_D1=();
        my @passwd_K1=();
        my $i;

        ($flag,$round,@passwd_C0[0..27],@passwd_D0[0..27]) = @IN;
        #print "$flag $round ";
        if( $flag ) {
                @passwd_C1[0..27]= &Left_Shift($KS_Count[$round],@passwd_C0);
                @passwd_D1[0..27]= &Left_Shift($KS_Count[$round],@passwd_D0);
        }
        else {
                @passwd_C1[0..27]= &Right_Shift($KS_Count_1[$round],@passwd_C0);
                @passwd_D1[0..27]= &Right_Shift($KS_Count_1[$round],@passwd_D0);
        }
        @passwd_K1[0..47] = &PC_2(@passwd_C1,@passwd_D1);

        return (@passwd_K1,@passwd_C1,@passwd_D1);        
}
sub Left_Shift {
        my ($count,@IN) = @_;
        my $i;
        #print "$#IN LS1 : ".join("",@IN)."\n";
        for($i=0;$i<$count;$i++) {
                $IN[$#IN + 1] = $IN[0];
                shift(@IN);
        }
        #print "$#IN LS2 : ".join("",@IN)."\n";
        return @IN;
}
sub Right_Shift {
        my ($count,@IN) = @_;
        my $i;
        #print "$#IN RS1 : ".join("",@IN)."\n";
        for($i=0;$i<$count;$i++) {
                (@IN) = ($IN[27],@IN);
        }
        #print "$#IN RS2 : ".join("",@IN)."\n";
        return @IN;
}
sub PC_2 {
        my @IN = @_;
        my @OUT = ();
        my $i;
        for($i=0;$i<=$#PC_2_TBL;$i++) {
                $OUT[$i]=$IN[$PC_2_TBL[$i]-1];
        }
        return @OUT;
}
sub IP {
        my @IN = @_;
        my @OUT = ();
        my $i;
        for($i=0;$i<=$#IP_TBL;$i++) {
                $OUT[$i] = $IN[$IP_TBL[$i]-1];
        }
        return @OUT;
}
sub IP_1 {
        my @IN = @_;
        my @OUT = ();
        my $i;
        for($i=0;$i<=$#IP_TBL;$i++) {
                @OUT[$IP_TBL[$i]-1] = $IN[$i];
        }
        return (@OUT);
}
sub string_bl {
        my @IN = @_;
        my @passwd_K1;
        my @string_L0=();
        my @string_R0=();
        my @string_L1=();
        my @string_R1=();
        my @string_R48=();

        (@passwd_K1[0..47],@string_L0[0..31],@string_R0[0..31])=@IN;

        @string_R48 = &E_Table(@string_R0);
        @string_R48 = &XOR(@passwd_K1,@string_R48);
        @string_R1 = &S_Box(@string_R48);
        @string_R1 = &P_Table(@string_R1);
        @string_R1 = &XOR(@string_L0,@string_R1);
        @string_L1 = @string_R0;

        return(@string_L1,@string_R1);
}

sub XOR {
        my @IN = @_;
        my @OUT = ();
        my $length = ($#IN + 1) / 2;
        my $i;
        for($i=0; $i<$length; $i++) {
                if($IN[$i] == $IN[$i + $length]) { $OUT[$i] = 0; }
                else {                             $OUT[$i] = 1; }
        }
        return @OUT;
}
sub E_Table {
        my @IN = @_;
        my @OUT = ();
        my $i;
        for($i=0;$i<=$#E_Table_TBL;$i++) {
                $OUT[$i]=$IN[$E_Table_TBL[$i]-1];
        }
        return @OUT;
}
sub S_Box {
        my @IN = @_;

        my @s1=();
        my @s2=();
        my @s3=();
        my @s4=();
        my @s5=();
        my @s6=();
        my @s7=();
        my @s8=();

        my @o1=();
        my @o2=();
        my @o3=();
        my @o4=();
        my @o5=();
        my @o6=();
        my @o7=();
        my @o8=();
        my @OUT = ();
        my $i;

        (@s1[0..5],@s2[0..5],@s3[0..5],@s4[0..5],
                @s5[0..5],@s6[0..5],@s7[0..5],@s8[0..5]) = @IN;

        $num = &bit_2_dec($s1[0],$s1[5]) * 16 + &bit_2_dec(@s1[1..4]);
        $num = $S_Box_TBL1[$num];
        @s1 = &dec_2_bit($num);

        $num = &bit_2_dec($s2[0],$s2[5]) * 16 + &bit_2_dec(@s2[1..4]);
        $num = $S_Box_TBL2[$num];
        @s2 = &dec_2_bit($num);

        $num = &bit_2_dec($s3[0],$s3[5]) * 16 + &bit_2_dec(@s3[1..4]);
        $num = $S_Box_TBL3[$num];
        @s3 = &dec_2_bit($num);

        $num = &bit_2_dec($s4[0],$s4[5]) * 16 + &bit_2_dec(@s4[1..4]);
        $num = $S_Box_TBL4[$num];
        @s4 = &dec_2_bit($num);

        $num = &bit_2_dec($s5[0],$s5[5]) * 16 + &bit_2_dec(@s5[1..4]);
        $num = $S_Box_TBL5[$num];
        @s5 = &dec_2_bit($num);

        $num = &bit_2_dec($s6[0],$s6[5]) * 16 + &bit_2_dec(@s6[1..4]);
        $num = $S_Box_TBL6[$num];
        @s6 = &dec_2_bit($num);

        $num = &bit_2_dec($s7[0],$s7[5]) * 16 + &bit_2_dec(@s7[1..4]);
        $num = $S_Box_TBL7[$num];
        @s7 = &dec_2_bit($num);

        $num = &bit_2_dec($s8[0],$s8[5]) * 16 + &bit_2_dec(@s8[1..4]);
        $num = $S_Box_TBL8[$num];
        @s8 = &dec_2_bit($num);

        @OUT = (@s1,@s2,@s3,@s4,@s5,@s6,@s7,@s8);

        return @OUT;
}
sub bit_2_dec {
        my @IN = @_;
        my $OUT=0;
        my $i;
        for($i=0;$i<=$#IN;$i++) {
                $OUT = ($OUT * 2) + $IN[$i];
        }
        return $OUT;
}
sub dec_2_bit {
        my ($IN) = @_;
        my @OUT = ();
        my @OUT2 = ();
        my $div = $IN;
        my $i;
        while( $div != 0) {
                $res = $div % 2;
                push(@OUT,$res);
                $div = ($div - $res) / 2;
        }
        my $l=  $#OUT;
        for($i=0;$i<= $l;$i++) {
                $OUT2[$i] = $OUT[$l - $i];        
        }
        while($#OUT2 < 3) {
                @OUT2 = (0,@OUT2);
        }

        return @OUT2;
}
sub P_Table {
        my @IN = @_;
        my @OUT = ();
        my $i;
        for($i=0;$i<=$#P_Table_TBL;$i++) {
                $OUT[$i]=$IN[$P_Table_TBL[$i]-1];
        }
        return @OUT;
}
sub hex2bin {
        my ($aline) = @_;
        my @hex=();
        my @bin=();
        my $bline = ();
        @hex = split("",$aline);
        for($i=0;$i<=$#hex;$i++) {
                if   ($hex[$i] eq '1') { $bline = "0001"; }
                elsif($hex[$i] eq '2') { $bline = "0010"; }
                elsif($hex[$i] eq '3') { $bline = "0011"; }
                elsif($hex[$i] eq '4') { $bline = "0100"; }
                elsif($hex[$i] eq '5') { $bline = "0101"; }
                elsif($hex[$i] eq '6') { $bline = "0110"; }
                elsif($hex[$i] eq '7') { $bline = "0111"; }
                elsif($hex[$i] eq '8') { $bline = "1000"; }
                elsif($hex[$i] eq '9') { $bline = "1001"; }
                elsif($hex[$i] eq 'a') { $bline = "1010"; }
                elsif($hex[$i] eq 'b') { $bline = "1011"; }
                elsif($hex[$i] eq 'c') { $bline = "1100"; }
                elsif($hex[$i] eq 'd') { $bline = "1101"; }
                elsif($hex[$i] eq 'e') { $bline = "1110"; }
                elsif($hex[$i] eq 'f') { $bline = "1111"; }
                else                   { $bline = "0000"; }
                push(@bin,$bline);
        }
        $bline = join('',@bin);
        return $bline;
}
sub bin2hex {
        my ($aline) = @_;
        my @bin=();
        my @hex=();
        my $bline = ();
        @bin = split("",$aline);
        for($i=0;$i<=$#bin;$i+=4) {
                $aline = join('',$bin[$i],$bin[$i+1],
                                $bin[$i+2],$bin[$i+3]);
                if   ($aline eq "0001") { $bline = "1"; }
                elsif($aline eq "0010") { $bline = "2"; }
                elsif($aline eq "0011") { $bline = "3"; }
                elsif($aline eq "0100") { $bline = "4"; }
                elsif($aline eq "0101") { $bline = "5"; }
                elsif($aline eq "0110") { $bline = "6"; }
                elsif($aline eq "0111") { $bline = "7"; }
                elsif($aline eq "1000") { $bline = "8"; }
                elsif($aline eq "1001") { $bline = "9"; }
                elsif($aline eq "1010") { $bline = "a"; }
                elsif($aline eq "1011") { $bline = "b"; }
                elsif($aline eq "1100") { $bline = "c"; }
                elsif($aline eq "1101") { $bline = "d"; }
                elsif($aline eq "1110") { $bline = "e"; }
                elsif($aline eq "1111") { $bline = "f"; }
                else                    { $bline = "0"; }
                push(@hex,$bline);
        }
        $bline = join('',@hex);
        return $bline;
}
sub binArray2hexLine {
        my @IN = @_;
        my $aline=();
        my $bline=();
        $aline = join('',@IN);
        $bline = bin2hex($aline);
        return $bline;
}
sub binArray2hexPrint {
        my @IN = @_;
        $aline = &binArray2hexLine(@IN);
        print "$aline\n";
}
sub hexLine2binArray {
        my ($aline) = @_;
        my @bin=();
        my $bline =();
        $bline = &hex2bin($aline);
        @bin = split('',$bline);
        return @bin;
}
sub B_AND {
        my @IN = @_;
        my @OUT = ();
        my $length = ($#IN + 1) / 2;
        my $i;
        for($i=0; $i<$length; $i++) {
                if(($IN[$i] == 1)&&($IN[$i + $length] == 1)) {
                                                $OUT[$i] = 1; }
                else {                          $OUT[$i] = 0; }
        }
        return @OUT;
}
sub B_XOR {
        my @IN = @_;
        my @OUT = ();
        my $length = ($#IN + 1) / 2;
        my $i;
        for($i=0; $i<$length; $i++) {
                if($IN[$i] == $IN[$i + $length]) { $OUT[$i] = 0; }
                else {                             $OUT[$i] = 1; }
        }
        return @OUT;
}