#!/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; $_ } ; 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) } @_); }