uebung4.plsrc

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

my %p = (a => .082, b => .015, c => .028, d => .043, e => .127, 
         f => .022, g => .020, h => .061, i => .070, j => .002, 
         k => .008, l => .040, m => .024, n => .067, o => .075, 
         p => .019, q => .001, r => .060, s => .063, t => .091, 
         u => .028, v => .010, w => .023, x => .001, y => .020, 
         z => .001);

my @digrams = qw(th he in er an re ed on es st en at to nt ha nd
                 ou ea ng as or ti is et it ar te se hi of);

my @trigrams = qw(the ing and her ere ent tha nth was eth for dth);

my %i = (1=>1, 3=>9, 5=>21, 7=>15, 11=>19, 17=>23, 25=>25);
%i = (%i, reverse %i);

my @pi = (23, 13, 24,  0, 7, 15, 14,  6, 25, 16, 22, 1, 19, 
          18,  5, 11, 17, 2, 21, 12, 20,  4, 10,  9, 3,  8);

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

sub e_affin {
  my ($a, $b) = (shift,  shift); 
  @_ = map { ord ($_) - 97 } split //, lc shift;
  $_[$_] = ($a*$_[$_]+$b)%26 for 0..@_-1;
  uc join '', map { chr ($_+97) } @_
}

sub d_affin {
  my ($a, $b) = (shift,  shift); 
  @_ = map { ord ($_) - 97 } split //, lc shift;
  $_[$_] = ($i{$a} * ($_[$_]-$b))%26 for 0..@_-1;
  join '', map { chr ($_+97) } @_
}

sub d_enigma {
  my $k = ord (lc shift)-97; 
  @_ = map { ord ($_) - 97 } split //, lc shift;
  my @z;
  $z[$_-1] = ($k + $_ - 1) % 26 for 1..@_;
  $_[$_] = ($_[$_] - $z[$_]) % 26 for 0..@_-1;
  $_[$_] = [reversepi (@pi)]->[$_[$_]] for 0..@_-1; 
  join '', map { chr ($_ + 97) } @_;
}

sub d_vigenere {
  my @k = map { ord ($_) - 97 } split //, lc shift();
  @_ = map { ord ($_) - 97 } split //, lc shift();
  $_[$_] = ($_[$_] - $k[$_ % @k]) % 26 for 0..@_-1;  
  join '', map { chr ($_ + 97) } @_;
}

sub bktest {
  my $s = shift; my %o; my $r;
  $o{substr ($s, $_, 3)}++ for 0..length($s)-4;
  my @c = reverse sort { $o{$a} <=> $o{$b} } 
          map { $o{$_} > 1 ? $_ : () } keys %o;  
  for my $t (@c) {
    my $i = 0;
    push @_, ($i = index $s, $t, $i)++ for 1..$o{$t};
    @_ = map { $_-$_[0] } @_;
    $i = euclid ($i, shift @_) for 1..@_;
    print $t, '(',$o{$t},'):', $i, "\n";
    $r = defined $r ? $r : $i;
  }
  $r
}

sub buckets {
  my ($m, $s) = (shift, shift);

  length ($s) % $m and substr $s, length($s)-length($s)%$m-1, length($s)%$m, '';

  while (my $t = substr $s, 0, $m, '') {
    $_[$_] .= substr ($t, $_, 1) for 0..$m-1;
  }
  @_
}

sub cindex {
  my ($s, $m) = @_; my $r = -1;
  for my $m (1..$m) {
    @_ = ();
    for my $t (buckets ($m, $s)) {
      my $total;
      my %f = frequency ($t);
      $total += $f{$_} * ($f{$_}-1) for 'a'..'z';
      $total /= length ($t) * (length ($t)-1);
      push @_, $total;
    }
    my $total; $total += $_ for @_; $total /= @_;
    $r = abs ($total-0.065) < 0.01 && ($r < 0 or $m%$r) ? 
         $m : $r;
    print $m, ': ', sprintf ('%.3f', $total), 
          ($m==$r) ? ' !' : '', "\n";
  }  
  $r
}

sub vbreaker {
  my ($s, $m) = @_; my $r;
 
  for my $t (buckets ($m, $s)) {
    my %f = frequency ($t);
    $_ = 0;
    for my $g (0..25) {
      my $total;
      $total += $p{$_} * $f{chr((ord($_)-97+$g)%26+97)} for 'a'..'z';
      $total /= length $t;
      abs ($total-0.065) < 0.01 && 
        abs ($_-0.065) > abs ($total-0.065) and $_ = $g;
    }
    $r .= chr ($_+65);
  }
  $r
}

sub euclid { 
  $_[1] or return $_[0]; 
  euclid ($_[1], $_[0] % $_[1])
}

sub frequency {
  my $a = lc shift;
  $_{$_} = 0 for 'a'..'z'; 
  $_{$_}++ for split //, lc $a;
  %_
}

sub relfrequency {
  my $a = lc shift; %_ = frequency ($a);
  $_{$_} /= length($a) for keys %_; %_
}

sub likely {
  my $s = lc shift; my ($r, $c);
  $c = @digrams; $r += ($s =~ /$_/g) * $c-- for @digrams;
  $c = @trigrams; $r += ($s =~ /$_/g) * $c-- for @trigrams;
  $r
}

sub solve {
  my ($d1, $d2, $d3, $d4) = @_;
  for my $a (1..25) { for my $b (1..25) {
    return $a, $b 
     if (($d1*$a+$b)%26 == $d2 && ($d3*$a+$b)%26 == $d4);        
  }}
  undef
}

sub affinbreakerOnOrangejuice {
  my $in = shift; my $tries = shift;
  for my $a (keys %i) {
    for my $b (0..25) {
      my $d = d_affin ($a, $b, $in);
      push @_, "a : $a, b : $b, l : ".likely($d).", p : ".$d;
    }
  }
  print join "\n", splice @{[reverse sort 
        { likely ($a) <=> likely ($b) } @_]}, 0, $tries;
}

sub affinbreakerOnSteroids  {
    my $in = shift; my $tries = shift;
    my %f = frequency ($in);
    
    my @nd = map {ord ($_) - 97} reverse sort {$p{$a} <=> $p{$b}} keys %p;
    my @fl = map {ord ($_) - 97} reverse sort {$f{$a} <=> $f{$b}} keys %f;
    
    my $br = grep {$_ >= (0.5 * $f{chr($fl[0]+97)}); } values %f;
    
    for my $i (0..$br-1) {
        for (my $j = ($i+1) % $br; $j!=$i; $j= ($j+1) % $br) {
           my ($a, $b) = solve ($nd[0], $fl[$i], $nd[1], $fl[$j]);
                      
           next if ! defined $a or euclid ($a, 26) > 1;
            
           push @_, "a: $a, b: $b,  p: ". d_affin ($a, $b, $in);
       }
    }    
    for my $i (0..25) {
        for (my $j = $i < $br ? $br : ($i+1)%26; 
        ($j != 0 && $i < $br) || ($j!=$i && $i >= $br); 
        $j = ($j+1)%26){
            my ($a, $b) = solve $nd[0], $fl[$i], $nd[1], $fl[$j];
            
            next if ! defined $a or euclid ($a, 26) > 1;
            
            push @_, "a: $a, b: $b, p: ". d_affin ($a, $b, $in);
        }
    }    

    print join "\n", splice @_,0,$tries;
}

my $in = join '', map { chomp; $_ } <STDIN>;

if ($ARGV[0] eq 'affin') { 
    affinbreakerOnSteroids ($in, 5);
    print "\n";
    affinbreakerOnOrangejuice ($in, 5);
}

if ($ARGV[0] eq 'vigenere') {
  if ((my $m = cindex ($in, 20)) == bktest ($in)) {
     my $k = vbreaker ($in, $m);
     print "$k : ", d_vigenere ($k, $in);
  }  
}

if ($ARGV[0] eq 'enigma') {
  push @_, $_ . " : " . d_enigma($_, $in) for 'A'..'Z';
  print join ("\n", reverse sort { likely ($a) <=> likely ($b) } @_);
}