uebung5.plsrc


#!/usr/local/bin/perl -w
use strict;
use Number::Fraction;

#SPN S-Box vom Uebungszettel
my @pi_s = (0x8, 0x4, 0x2, 0x1, 0xc, 0x6, 0x3, 0xd, 
            0xa, 0x5, 0xe, 0x7, 0xf, 0xb, 0x9, 0x0);
            
my @reverse_pi_s = (0xf, 0x3, 0x2, 0x6, 0x1, 0x9, 0x5, 0xb, 
                    0x0, 0xe, 0x8, 0xd, 0x4, 0x7, 0xa, 0xc);

#Original SPN S-Box aus Skript
#my @pi_s = (0xe, 0x4, 0xd, 0x1, 0x2, 0xf, 0xb, 0x8,
#            0x3, 0xa, 0x6, 0xc, 0x5, 0x9, 0x0, 0x7);

my @pi_p = (0, 4, 8, 12, 1, 5, 9, 13, 2, 6, 10, 14, 3, 7, 11, 15);

my @k = (0,0,1,1, 1,0,1,0, 1,0,0,1, 0,1,0,0, 
         1,1,0,1, 0,1,1,0, 0,0,1,1, 1,1,1,1);

my @nl = map {
    my @t;
    for my $a (0..15) { for my $b (0..15) { $t[$a][$b] = 16 }}

    for (0..15) {      
      my @l = (split (//, sprintf '%04b', $_), 
               substitute (split //, sprintf '%04b', $_));
      for my $a (0..15) { 
        for my $b (0..15) {
          my @j = (split (//, sprintf '%04b', $a), 
                   split (//, sprintf '%04b', $b));
          my $r = 0;        
          $j[$_] and $r ^= $l[$_] for 0..7;
          $t[$a][$b] -= $r
        }
      }
    }
    @t
  }1;

sub substitute {
  split //, sprintf '%04b', $pi_s[oct 'b'.join '', @_]
}

sub reversesubstitute {
  split //, sprintf '%04b', $reverse_pi_s[oct 'b'.join '', @_]
}

sub SPN {
  my @w = @_;
  
  for my $i (0..2) {
    $w[$_ - $i*4] ^= $k[$_] for $i*4..$i*4+15;
    my @v; push @v, substitute (splice @w, 0, 4) for 0..3;
    $w[$_] = $v[$pi_p[$_]] for 0..15
  }
  $w[$_ - 12] ^= $k[$_] for 12..27;             
  my @v; push @v, substitute (splice @w, 0, 4) for 0..3;
  $v[$_ - 16] ^= $k[$_] for 16..31;
  @v
}

sub SPNBreaker {
  my %pairs = %{shift ()};
  my %count = ();
        
  for my $i (0..15) {
    for my $j (0..15) {
      $count {($i,$j)} = 0
    }
  }
        
  for my $pt (keys %pairs) {
    for my $ref (keys %count) {
      my @L1 = split //, sprintf '%04b', $ref->[0];
      my @L2 = split //, sprintf '%04b', $ref->[1];
      my @v41; push @v41, $L1[$_] ^ $pairs{$pt}->[$_] for 0..3;
      my @v43; push @v43, $L2[$_-8] ^ $pairs{$pt}->[$_] for 8..11;
       
      my @u41 = reversesubstitute @v41;
      my @u43 = reversesubstitute @v43;
      
      my $z = $pt->[16] ^ $u41[0] ^ $u43[0];
      $count{@$ref} += 1 unless $z;
    }
  }
        
  my $max = 0; my $maxkey = 0;
        
  for my $ref (keys %count) {
    if ($count {@$ref} - 1/2 * scalar keys %count > $max) {
      $max = $count {@$ref} - 1/2 * scalar keys %count;
      $maxkey = $ref
    }
  }
        
  @$maxkey;
}

sub f { Number::Fraction->new ($_[0], $_[1]) }
sub tf { 'f' . join '', map { '{' . $_ . '}' } split '/', shift }

sub prob17a {
  my (%p, %e);
  $p{$_}{Pasch} = $p{$_}{NichtPasch} = $e{$_} = 0 for 2..12;
  $e{Pasch} = $e{NichtPasch} = 0;
  foreach my $x1 (1..6) {
    foreach my $x2 (1..6) {
      $e{$x1+$x2}++;
      $p{$x1+$x2}{Pasch}++, $e{Pasch}++ if $x1 == $x2;
      $p{$x1+$x2}{NichtPasch}++, $e{NichtPasch}++ unless $x1 == $x2
    }
  }
  print '$';
  foreach my $x (2..12) {
    for my $y ('Pasch', 'NichtPasch') {
       $_ = "p[$y,$x] = ".tf (f ($p{$x}{$y}, 36)).', '.
        "p[$y|$x] = f{p[$y,$x]}{p[$x]} = f{".
        tf (f ($p{$x}{$y}, 36)).'}{'.tf (f ($e{$x}, 36)).'} = '.
        tf (f ($p{$x}{$y}, 36) / f ($e{$x}, 36)) . ', '.
        "p[$x|$y] = f{p[$x,$y]}{p[$y]} = f{".
        tf (f ($p{$x}{$y}, 36)).'}{'.tf (f ($e{$y}, 36)).'} = '.
        tf (f ($p{$x}{$y}, 36) / f ($e{$y}, 36));
        s/p/\\mathcal{P}/g; s/f/\\frac/g;
        s/\[/\\left[/g; s/\]/\\right]/g; 
        s/\\frac\{0\}\{1\}/0/g; s/\\frac\{1\}\{1\}/1/g;
        s/NichtPasch/\\mathrm{NP}/g; s/Pasch/\\mathrm{P}/g;
        print $_, $x%12 ? '\\\\' : '',  "\n";
     }
   }
   print '$'
}

my %des = ( 1 => [[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]],
            2 => [[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]],
            3 => [[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]],
            4 => [[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]],
            5 => [[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]],
            6 => [[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,41,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]],
            7 => [[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]],
            8 => [[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]]);

sub prob17c {
  sub dsubstitute {
      split //, sprintf '%04b', $des{$_[0]}->
         [oct'b'.$_[1].$_[6]]->
         [oct'b'.join'',splice @_,2,4];
  }

  for my $box (1..8) {
    my $t = 64;  
    for (0..63) {      
      @_ = (split (//, sprintf '%06b', $_), 
            dsubstitute ($box, split //, sprintf '%06b',$_));
      $t -= $_[1] ^ $_[6] ^ $_[7] ^ $_[8] ^ $_[9];
    }
    print "DES S-Box $box Bias fuer X_2^Y_1^Y_2^Y_3^Y_4: ", 
          (f($t,64) - f(1,2)), "\n";
  }
}

prob17a if $ARGV[0] eq 'prob17a';
prob17c if $ARGV[0] eq 'prob17c';
if ($ARGV[0] eq 'spn') {
  print SPN (0,0,1,0, 0,1,1,0, 1,0,1,1, 0,1,1,1), "\n";
}

if ($ARGV[0] eq 'nl') {
  print "   0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F\n";
  for my $i (0..15) {     
    print sprintf ("%1x ", $i);
    for my $j (0..15) { 
      print sprintf ('%2d', $nl[$i][$j]), " "
    }
    print "\n"
  }
}

if ($ARGV[0] eq 'prob18a') {
    print $nl[1][4], ", ", $nl[1][8], ", ",  $nl[4][10];
}