uebung6.plsrc


#!/usr/local/bin/perl -w
use strict; $|=1; no strict 'refs';
use Number::Fraction;

sub prob20 {
  sub sb {
    my %s = ( 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,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]],
              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]]);        
    split //, sprintf '%04b', $s{$_[0]}->
       [oct'b'.$_[1].$_[6]]->[oct'b'.join'',splice @_,2,4]
  }
     
  sub f {
    my @a = @{shift()}; my @j = @{shift()}; my $t;
    my @e = 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);
    my @p = 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);
    $_[$_] = $a[$e[$_]-1] for 0..@e-1;
    $_[$_] ^= $j[$_]+0 for 0..@j-1;
    my @t; my @r; push @r, sb (++$t, @t) while @t = splice @_,0,6;
    $_[$_] = $r[$p[$_]-1] for 0..@p-1;
    splice @_,0,32
  }

  sub e_des_round1 {
    my @k = @{shift()}; my @r = @{shift()}; my @l = splice @r, 0, 32;
    (@r, map { $_^0+shift @l } f([@r], [@k]))
  }

  sub e {
    my $r = shift; 
    my @k = map { split //, sprintf '%04b', oct'0x'.$_ } split //, shift;

    my @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 54 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 @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);
    my @ro =  qw(1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1);

    $_[$_] = $k[$pc1[$_]-1] for 0..@pc1-1;
    for (1..$r) {
       my @l = splice @_,0,28; my @r = @_;
       @_ = splice @l,0,$ro[$_-1]; @l = (@l, @_);
       @_ = splice @r,0,$ro[$_-1]; @_ = (@l, @r, @_)
    }
    $k[$_] = $_[$pc2[$_]-1] for 0..@pc2-1;
    splice @k,0,48
  }

  sub e_des {
    sub permute {
      my @pix = @{shift()}; my @x = @{shift()};
      $_[$_] = $x[$pix[$_]-1] for 0..@pix-1; @_
    }

    sub reversepi {
      my @a = splice @_, 0, @_; 
      $_[$a[$_]-1] = $_+1 for 0..@a-1; @_
    }

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

    my $k = shift; my @r = permute (\@ip, [map { split //, sprintf '%04b', 
                                           oct'0x'.$_ } split //, shift]);
    for (1..16) {
      my @l = splice @r, 0, 32;	
      @r = (@r, map { $_^0+shift @l } f([@r], [e($_, $k)]));
    }
    @r = permute ([reversepi (@ip)], [splice (@r,32,32), @r]);
    $_ .= sprintf ('%x',oct'b'.join'',@_) while @_ = splice @r,0,4;  
    $_
  }

  print join '', e_des_round1
     ([split //, '000110110000001011101111111111000111000001110010'],
      [split //, '11001100000000001100110011111111'.
                 '11110000101010101111000010101010']), "\n";

  print e_des ('133457799BBCDFF1', '0123456789ABCDEF'), "\n";
}
 
sub prob21 {
  sub poly_extended_euclid {
    @{$_[1]} or return $_[0], new polynomial (1), new polynomial ();
    my ($d, $x, $y) = poly_extended_euclid ($_[1], $_[0] % $_[1]);
    $d, $y, $x-($_[0]/$_[1])*$y
  }

  for ([new polynomial (map { new Number::Fraction ($_,1) } 1,-1,0,0,1,-1),
        new polynomial (map { new Number::Fraction ($_,1) } 1,-3,3,-1)],
       [new polynomial (map { new f2 ($_) } 1,0,0,0,1,1,0,1,1),
        new polynomial (map { new f2 ($_) } 1,0,1,0,1,0,1,0)]) {
    my ($a, $b) = @{$_};     
    my ($c, $u, $v) = poly_extended_euclid ($a, $b);
    print "a = $a\nb = $b\nc = $c\nu = $u\nv = $v\na*u = ", $a*$u, 
          "\nb*v = ",  $b*$v,  "\na*u+b*v = ", $a*$u+$b*$v, "\n\n"
  }
}

sub prob22 {
  sub poly_euclid {
    @{$_[1]} ? poly_euclid ($_[1], $_[0]%$_[1]) : $_[0]
  }

  my $a = new polynomial (map { new f2 ($_) } 1,1,1);
  print poly_euclid ($a, new polynomial (map { new f2 ($_) }
        split //, sprintf "%02b", $_)), "\n" for 2..3;
}

sub prob23 {
  for my $i (1..15) {     
    my $c = new gf24 (split //, sprintf "%04b", $i);
    my $d = $c; my %gf; my $e = 1;
    while (! exists $gf{$d}) {
      $gf{$d}{p} = $d;
      $gf{$d}{e} = $e++;
      $d = $d * $c;
    }
    if (keys %gf == 15) {
      print "Generatorpolynom a=$c : \n  ";
      print sprintf('%11s','0')." 0000 0      -  -\n  ";
      print join "\n  ", 
       (map { sprintf('%11s',$_).' '.
              sprintf('%04s',join('',@{$gf{$_}{p}})).' '.
              sprintf('%1x', oct'b'.join('',@{$gf{$_}{p}})).' '.
              sprintf('%6s', "a^\{$gf{$_}{e}\}").' '.
              sprintf('%2s', $gf{$_}{e}) }
        sort { oct'b'.join('',@{$gf{$a}{p}}) <=> 
               oct'b'.join('',@{$gf{$b}{p}})} 
        keys (%gf)), "\n\n";
    }
  }
}

use vars qw(@aesSBox $r);

sub prob24 {
  sub matrixprint {
    while (my @t = splice @_,0,4) {
      print '  ', join ' ', (map { sprintf '%02x', $_ } @t), "\n"
    }
  }
  
  sub performVoodoo {
    @_  = split //, shift;
    push @_, oct'0x'.join'',splice @_,0,2 for 0..@_/2-1; @_
  }

  @aesSBox = performVoodoo join '',
     qw(637c777bf26b6fc53001672bfed7ab76ca82c97dfa5947f0add4a2af9ca472c0
        b7fd9326363ff7cc34a5e5f171d8311504c723c31896059a071280e2eb27b275
        09832c1a1b6e5aa0523bd6b329e32f8453d100ed20fcb15b6acbbe394a4c58cf
        d0efaafb434d338545f9027f503c9fa851a3408f929d38f5bcb6da2110fff3d2
        cd0c13ec5f974417c4a77e3d645d197360814fdc222a908846eeb814de5e0bdb
        e0323a0a4906245cc2d3ac629195e479e7c8376d8dd54ea96c56f4ea657aae08
        ba78252e1ca6b4c6e8dd741f4bbd8b8a703eb5664803f60e613557b986c11d9e
        e1f8981169d98e949b1e87e9ce5528df8ca1890dbfe6426841992d0fb054bb16);

  sub substitute {
    my ($r, $c)  = map {hex $_} split //, sprintf '%02x', shift;
    $aesSBox [$r*16+$c]
  }

  sub rotWord {
    push @_, shift; @_
  }

  sub subWord {
    push @_, substitute(shift @_) for 0..3; @_
  }

  sub shiftRows {
    for my $i (1..3) {
      my @t = splice @_,4,4;
      @t = rotWord @t for 1..$i;
      push @_, @t
    }
    print "shiftRows$r:\n"; matrixprint @_;
    @_
  }

  sub xtime {
    my $b = ($_ = shift) > 127 ? 0x1b : 0;
    $_ = ($_ << 1) % 256 ^ $b 
  }
  
  sub mixColumns {
    my @old = @_;
    for my $i (0..3) {
      my $T    = $old[0+$i] ^ $old[4+$i] ^ $old[8+$i] ^ $old[12+$i];
      $_[4*$_+$i] ^= xtime($old[4*$_+$i] ^ $old[(4*$_+4)%16+$i]) ^ $T for 0..3
    }    
    print "mixColumns$r:\n"; matrixprint @_;
    @_
  }

  sub SboxState {
    push @_, subWord splice @_,0,4 for 0..3;
    print "SboxState$r:\n"; matrixprint @_;
    @_
  }

  sub expandKey {
    my @RCon = performVoodoo join '',
      qw(0100000002000000040000000800000010000000
         2000000040000000800000001b00000036000000);

    for my $i (4..43) {
      my @tmp;
      $tmp[4+$_] = $_[$_] for -4..-1;

      unless ($i % 4) {
        @tmp = subWord rotWord @tmp;
        $tmp[$_] ^= $RCon [$i-4+$_] for 0..3;
      }

      push @_, $_[($i-4) * 4 + $_]^$tmp[$_] for 0..3
    }
    @_
  }

  sub addRoundKey {
    my @rk = @{shift ()}; my @tc = @{shift ()};

    for my $i (0..3) {
      for my $j (0..3) {
        $tc[$i + $j * 4] ^= $rk [$j + $i * 4]
      }
    }
    @tc
  }

  sub twistAndShout {
    my @newM;
    for my $i (0..3) {
      for my $j (0..3) {
        $newM[$i + $j * 4] = $_[$j + $i * 4]
      }
    }
    @newM
  }

  sub e_AES {
    my @ek = expandKey performVoodoo shift;
    my @pt = twistAndShout performVoodoo shift;
    my @rk; $r = 0;

    print "PT$r:\n"; matrixprint @pt;
    print "RK$r:\n"; matrixprint twistAndShout @rk = splice @ek,0,16;

    @pt = addRoundKey \@rk, \@pt;
    for $r (1..9) {
      print "PT$r:\n"; matrixprint @pt;
      print "RK$r:\n"; matrixprint twistAndShout @rk = splice @ek,0,16; 
      @pt = addRoundKey \@rk, [mixColumns shiftRows SboxState @pt];
      print "\n"
    }
    $r=10;
    my @ct = twistAndShout addRoundKey \@ek, [shiftRows SboxState @pt];
    @ct
  }

  @_ = e_AES (defined $_[0] ? $_[0] : '2B7E151628AED2A6ABF7158809CF4F3C',
              defined $_[1] ? $_[1] : '3243F6A8885A308D313198A2E0370734');

  print 'Ciphertext : '; printf "%02x ", $_[$_] for 0..@_-1; print "\n";
}

&{'prob'.$ARGV[0]} (splice @ARGV,1);

package f2;

use overload
    '+'  => \&add, '-'  => \&add,
    '*'  => \&mul, '/'  => \&mul,
    '==' => \&equals, '!=' => sub { ! equals (@_) },
    '""' => sub { $_[0]->[0] };

sub new { bless ref $_[1] ? $_[1] : [$_[1]], $_[0] }
sub clone { new (ref $_[0], $_[0]->[0]) }

sub add {
  my ($l, $r) = (shift, shift);
  $r = ref($r) ? $r : new (ref $l, $r);
  new (ref $l, ($l->[0] + $r->[0])%2)
}

sub mul { 
  my ($l, $r) = (shift, shift);
  $r = ref($r) ? $r : new (ref $l, $r);
  new (ref $l, $l->[0]*$r->[0])
}

sub equals {
  my ($l, $r) = (shift, shift);
  $r = ref($r) ? $r : new (ref $l, $r);
  $r->[0] == $l->[0] 
}
1;

package polynomial;

use overload
    '+'  => \&add,
    '-'  => \&subt,
    '*'  => \&mul, 
    '/'  => \&div,
    '%'  => \&mod,
    '==' => \&equals,
    '""' => \&tostring; 

sub new { bless [splice @_,1,@_-1], $_[0] }
sub clone { new (ref $_[0], @{$_[0]}) }

sub tostring { 
  @_ = @{$_[0]};
  my $l = @_-1;
  $_ = '('.join ("+", map { $l--; $_==0 ? () : 
    ($_ == 1 ? '' : $_).'x^'.($l+1) } @_).')';
  s/x\^0/ 1/g; s/(\(|\))//g; s/x\^1([^0-9]|$)/x$1/g;
  $_
}

sub mul {
  my @a = @{$_[0]}; my @b = @{$_[1]}; my $class = shift; @_ = ();
  for my $i (0..@b-1) {
    for my $j (0..@a-1) {
      $_[$i+$j] = defined $_[$i+$j] ? $_[$i+$j] : 0;
      $_[$i+$j] += $b[$i] * $a[$j];
    }
  }
  new (ref $class, @_)
}

sub subt {
  my @a = @{$_[0]}; my @b = @{$_[1]}; my $class = shift; @_ = ();
  my $i = @a; my $j = @b;
  while ($i > 0 or $j > 0) {
    unshift @_, 0;
    $_[0] += $a[$i] if $i-- > 0;
    $_[0] -= $b[$j] if $j-- > 0;
  }
  new (ref $class, @_)
}

sub mod {
  my @a = @{$_[0]}; my @b = @{$_[1]};      
  @b > @a and return new (ref $_[0], @a);
  while (@a >= @b) {
    my @t;
    push @t, $a[0] / $b[0];
    @a-@b > 0 and push @t,0 for 1..@a-@b;
    @t = @{mul (new polynomial (@t), new polynomial(@b))};
    @a = @{subt (new polynomial (@a), new polynomial (@t))};
    while (@a > 0 and $a[0] == 0) { shift @a }
  }
  new (ref $_[0], @a)
}

sub div {
  my @a = @{$_[0]}; my @b = @{$_[1]};      
  @b > @a and return new (ref $_[0], $_[0]-$_[0]);
  my @r = ();
  @a-@b > 0 and push @r,0 for 1..@a-@b;
  while (@a >= @b) {
    $r[@a-@b] = $a[0] / $b[0];    
    my @t;
    push @t, $a[0] / $b[0];
    @a-@b > 0 and push @t,0 for 1..@a-@b;
    @t = @{mul (new polynomial (@t), new polynomial (@b))};
    @a = @{subt (new polynomial (@a), new polynomial (@t))};
    while (@a > 0 and $a[0] == 0) { shift @a }
  }
  new (ref $_[0], reverse @r)
}

sub add {
  my @a = @{$_[0]}; my @b = @{$_[1]}; my $class = shift; @_ = ();
  my $i = @a; my $j = @b;
  while ($i > 0 and $j > 0) {
    unshift @_, 0;
    $_[0] += $a[$i] if $i-- > 0;
    $_[0] += $b[$j] if $j-- > 0;
  }
  new (ref $class, @_);
}

sub equals {
  @{$_[0]} != @{$_[1]} and return 0;
  my $t = 1;
  $_[0]->[$_] != $_[1]->[$_] and $t = 0 for 0..@{$_[0]}-1;
  $t
}

1;

package gf24;

BEGIN {
  use vars ('@ISA');
  @ISA = qw(polynomial);
  use overload '*' => \&mul;
}


sub new {
  my $class = shift;
  my $self = $class->SUPER::new (map { new f2 ($_) } @_);
  bless $self, $class;
  $self
}

sub mul {
   new gf24(@{new polynomial (@{$_[0]}) * 
              new polynomial (@{$_[1]}) % 
              new polynomial (map { new f2 ($_) } 1,0,0,1,1)});
}

1;

package gf28;

BEGIN {
  use vars ('@ISA');
  @ISA = qw(polynomial);
  use overload '*' => \&mul;
}

sub new {
  my $class = shift;
  my $self = $class->SUPER::new (map { new f2 ($_) } @_);
  bless $self, $class;
  $self
}

sub mul {
   new gf28 (@{new polynomial (@{$_[0]}) * 
              new polynomial (@{$_[1]}) % 
              new polynomial (map { new f2 ($_) } 1,0,0,0,1,1,0,1,1)});
}

1