#oooOOO-OkIDaN-NNNnnn
#myDES ver 1.1 by OkIDaN # Released: june, 2004
#The other name: One week of hard study and coding DES.pl
#The other name: several days of fixing and debugging was hell.pl
#It is full DES in one script. After studying DES in details from many docs
#I created this script that simply encrypts and decrypts anything
#following the DES explained in FIPS and other standard documents.
#So, this is a legitimate DES encryption/decryption tool.
#Feedback, comments: okidan@yandex.ru, okidan_nadiko@yahoo.com
#This is still not checked in many ways, but as far as for now it works
#fine. I need some checkers, so do it andcontact me if you want to help.
#Still some work has to be done, because this is the first form of script
#that was created just to work. I still have to make it beautiful ;)
#http://www.freewebs.com/okidan/
#Enjoy.

####[Stage 0: Parsing the input]
die "
|usage: $0 {e or d} {file} {password} [output]
|
|e or d    - encrypt or decrypt
|file     - filename you want to encrypt or decrypt
|password - key you want to encrypt  or decrypt the file with
|output   - specify this if you want to write to different output file
" if ($#ARGV < 2);
$method=$ARGV[0];
if ($method=~/^d$/i){
  $method="d";
}elsif ($method=~/^e$/i){
  $method="e";
}else { die "Method must be \"e\" or \"d\"\n" }
($file, $key)=@ARGV[1,2];
if (-s $file){
  $mode="f";
  $outfile=$ARGV[3];
  open (IN, "$file") or die "Failed to open \"$file\": $!\n";
  open (OUT, ">$outfile") or print "No file specified, printing to output.\n";
}else{ 
  print "File \"$file\" does not exist. Assuming \"$file\" is a word\n";
  $text=$file;
  $mode="w";
}
@text=split("", $text);
@key=split("", $key);
die "Key must be 8 characters maximum\n" if ($#key>7);
my $t = time;

####[Defining variables]

(@{$s[0]}[0..15],@{$s[1]}[0..15],@{$s[2]}[0..15],@{$s[3]}[0..15])=qw(         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);

(@{$s[4]}[0..15],@{$s[5]}[0..15],@{$s[6]}[0..15],@{$s[7]}[0..15])=qw(        15   1  8  14  6  11  3   4  9   7  2  13 12   O  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);

(@{$s[8]}[0..15],@{$s[9]}[0..15],@{$s[10]}[0..15],@{$s[11]}[0..15])=qw(    10   0  9  14  6   3 15   5  1  13 12   7 11   4  2   8
             13   7  O   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);

(@{$s[12]}[0..15],@{$s[13]}[0..15],@{$s[14]}[0..15],@{$s[15]}[0..15])=qw( 7  13 14   3  0   6  9  10  1   2  8   5 11  12  4  15
             13   8 11   5  6  15  O   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  O   6 10   1 13   8  9   4  5  11 12   7  2  14);

(@{$s[16]}[0..15],@{$s[17]}[0..15],@{$s[18]}[0..15],@{$s[19]}[0..15])=qw(2  12  4   1  7  10 11   6  8   5  3  15 13   O 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  O  14
            11   8 12   7  1  14  2  13  6  15  O   9 10   4  5   3);

(@{$s[20]}[0..15],@{$s[21]}[0..15],@{$s[22]}[0..15],@{$s[23]}[0..15])=qw(12   1 10  15  9   2  6   8  O  13  3   4 14   7  5  11
             10  15  4   2  7  12  9   5  6   1 13  14  O  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);

(@{$s[24]}[0..15],@{$s[25]}[0..15],@{$s[26]}[0..15],@{$s[27]}[0..15])=qw(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);

(@{$s[28]}[0..15],@{$s[29]}[0..15],@{$s[30]}[0..15],@{$s[31]}[0..15])=qw(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);

@ip=qw(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);

@pc1=qw(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);

@pc2=qw(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);

@ebits=qw (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);

@pbits=qw(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);

@r_ip=qw(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);

#########{Variables defined}

####[Stage 1: Generating plaintext and key bits]
if ($mode eq "w"){
foreach $char (@text){
  push @hex, sprintf("%X", ord($char));
}
$temp=join ("", @hex);
@hex=split ("", $temp);
foreach $hex (@hex){
  $bit=sprintf("%b", hex($hex));
  &add ($bit);
  @new_bit=split ("", $bit);
  push @bits, @new_bit;
}
&add_bits_bit();
}else{
@in=<IN>;
close (IN);
$all=join ("", @in);
$filesize=length($all);
print "Input file: $file [$filesize bytes]\n";
print "Output file: $outfile\n";
print "Method: $method\n";
@all=split ("", $all);
foreach $char (@all){
  $hex=sprintf("%X", ord($char));
  if (length($hex) == 1){ $hex="0" . $hex }
  push @hex, $hex;
}
$temp=join ("", @hex);
@hex=split ("", $temp);
foreach $hex (@hex){;
  $bit=sprintf("%b", hex($hex));
  &add ($bit);
  @new_bit=split ("", $bit);
  push @bits, @new_bit;
}
$pad=$#bits+1;
$dif=64 - ($pad % 64);
$dif=0 if ($dif == 64);
$pnum=0;
while ($pnum<$dif){
  push @bits, "0";
  $pnum++;
}
}
@hex=0; pop @hex;
foreach $char (@key){
  push @hex, sprintf("%X", ord($char));
}
$temp=join ("", @hex);
@hex=split ("", $temp);
foreach $hex (@hex){
  $bit=sprintf("%b", hex($hex));
  &add ($bit);
  @new_key=split ("", $bit);
  push @keybits, @new_key;
}
@key=@keybits;
&add_bits_key();

####{Stage 1 completed}

####[Stage 2: Key generation]

$pnum=0;
while ($pnum <= $#pc1){
  $ind=$pc1[$pnum]-1;
  $CD[$pnum]=$key[$ind];
  $pnum++;
}
(@{$C[0]}[0..27], @{$D[0]}[0..27])=@CD;
$i=0;
while ($i<16){
  @C_now=@{$C[$i]};
  @D_now=@{$D[$i]};
  $last=shift @C_now;
  @{$C[$i+1]}=(@C_now, $last);
  $last=shift @D_now;
  @{$D[$i+1]}=(@D_now, $last);
  if (!($i==0 || $i ==1 || $i==8 || $i==15)){
    $last=shift @{$C[$i+1]};
    @{$C[$i+1]}=(@{$C[$i+1]}, $last);
    $last=shift @{$D[$i+1]};
    @{$D[$i+1]}=(@{$D[$i+1]}, $last);
  }
  @CD_now=(@{$C[$i+1]}, @{$D[$i+1]});
  $rt=$i+1;
  $cdn=join ("", @CD_now);
  @CD_now=split ("", $cdn);
  $pnum=0;
  while ($pnum<=$#pc2){
    $ind=$pc2[$pnum]-1;
    $K[$i][$pnum]=$CD_now[$ind];
    $pnum++;
  }
  $i++;
}

####{Stage 2 completed}

#the big loop

@all_bits=@bits;
$number=0;
while ($number < $#all_bits){

 @bits=@all_bits[$number..$number+63];

####[Stage 3: Initial permutation]

$pnum=0;
while ($pnum <= $#ip){
  $ind=$ip[$pnum]-1;
  $LR[$pnum]=$bits[$ind];
  $pnum++;
}
@LR=(@LR[32..63], @LR[0..31]) if ($method eq "d");
@L=@LR[0..31];
@R=@LR[32..63];

####{Stage 3 completed}

####[Stage 4: Main algorithm of 16 iterations]

$round=0;
while ($round <= 15){
  if ($method eq "e"){
  @L_next=@R;
  # @R_next=@L + f (@R, @K[n]); Starting calculation of R_next: 
  }else{
  @R_next=@L;
  # @L_next=@R + f (@L, @K[n]); Starting calculation of R_next: 
  @temp=@L;
  @L=@R;
  @R=@temp;
  }
  &e_bits();
  &XOR_RK();
  &ss();
  &p_bits();
  &XOR_LR();
  if ($method eq "e"){@R_next=@final;}else{
    @L_next=@final;}
  @R=@R_next;
  @L=@L_next;
  $round++;
}
if ($method eq "e"){ @LR_pre=(@R, @L);}else{
@LR_pre=(@L, @R);}
$pnum=0;
while ($pnum <= $#r_ip){
  $ind=$r_ip[$pnum]-1;
  $LR[$pnum]=$LR_pre[$ind];
  $pnum++;
}
$i=0;
$inc=7;
while ($i<63){
  $part=join("", @LR[$i..$i+$inc]);
  $dec=oct( "0b$part" );
  $ciphertext.=chr($dec);
  $i=$i+$inc+1;
}

#big loop completion:

$number=$number+64;
}
$t = time - $t;

if ($mode eq "w"){
print "\nDone. Completed in $dh:$dm:$ds\n";
print "Method: $method\n";
print "Initial: $text\n";
print "Result: ";
print "$ciphertext\n";
}else{
print OUT $ciphertext or print "Result: $ciphertext\n";
close (OUT);
print "Done. Completed in ";
printf("%d:%d:%d", $t / 3600, ($t / 3600) % 60, $t % 60); print "\n";
}

####{Stage 4 completed: All stages completed}

#############
####[All the subs]

sub add (){
  @mybits=split ("", $_[0]);
  $dif=3-$#mybits;
  if ($dif){
    $added="0"x$dif;
    $bit="$added$bit";
  }
}

sub gen_key (){
  @key_now=0; pop (@key_now);
  $N=$round;
  $lastkeybit=$N+48;
  while ($N < $lastkeybit){
    push @key_now, @key[$N];
    $N++;
  }
}

sub e_bits(){
  $pnum=0;
  while ($pnum <= $#ebits){
    $ind=$ebits[$pnum]-1;
    $R2[$pnum]=$R[$ind];
    $pnum++;
  }
}

sub p_bits(){
$pnum=0;
while ($pnum <= $#pbits){
  $ind=$pbits[$pnum]-1;
  $final[$pnum]=$prefinal[$ind];
  $pnum++;
}
}

sub add_bits_bit(){
  $adds=0;
  $toadd=64-(($#bits+1) % 64);
  if ($toadd != 64){
    while ($adds < $toadd){
      push @bits, "0";
      $adds++; 
    }
  }
}

sub add_bits_key(){
  $adds=0;
  $toadd=63-$#key;
  if ($toadd){
    while ($adds < $toadd){
      push @key, "0";
      $adds++; 
    }
  }
}

sub XOR_RK(){
  $i=0;
  $ind=$round;
  $ind=15-$round if ($method eq "d");
  while ($i < 48){
    if ($R2[$i] xor $K[$ind][$i]){
      $RK[$i]=1;
    }else{
      $RK[$i]=0;
    }
    $i++;
  }
  @RK=@RK[0..47];
}

sub XOR_LR(){
  $i=0;
  while ($i < 32){
    if ($final[$i] xor $L[$i]){
      $final2[$i]=1;
    }else{
      $final2[$i]=0;
    }
    $i++;
  }
  @final=@final2;
}

sub ss(){
 (@{$b[0]}[0..5],@{$b[1]}[0..5],@{$b[2]}[0..5],@{$b[3]}[0..5], @{$b[4]}[0..5], @{$b[5]}[0..5], @{$b[6]}[0..5], @{$b[7]}[0..5])=@RK;
$q=0;
while ($q < 8){
  $brow=$b[$q][0] . $b[$q][5];
  $bcol=$b[$q][1] . $b[$q][2] . $b[$q][3] . $b[$q][4];
  $brow=oct("0b$brow");
  $bcol=oct("0b$bcol");
  $row_index=$q*4+$brow;
  $b_final=$s[$row_index][$bcol];
  $b_final=sprintf("%b", $b_final);
  @b_final=split ("", $b_final);
  while ($#b_final < 3){
    @b_final=("0", @b_final);
  }
  @prefinal[$q*4..$q*4+3]=@b_final;
  $q++;
}
}