obfuscated
chargrill
<p>This is a compliment to my recent obfuscated post, [id://549415]. In honor of [href://http://en.wikipedia.org/wiki/Charles_Babbage#Other_accomplishments|Charles Babbage] [href://http://en.wikipedia.org/wiki/Charles_Babbage|(pictured here so you don't have to squint <b>too</b> hard)], who is credited with breaking Vigenére's cipher ca. 1854, but his method was not published until several years later, and as a result credit for the development was instead given to Friedrich Kasiski, who made the same discovery some years after Babbage.</p>
<p>What is now commonly referred to as the Kasiski examination allows a cryptanalyst to deduce the length of the keyword used in the polyalphabetic substitution cipher. Once the length of the keyword is discovered, the cryptanalyst lines up the ciphertext in N columns, where N is the length of the keyword. Then, each column can be treated as the ciphertext of a monoalphabetic substitution cipher. As such, each column can be attacked with [href://http://en.wikipedia.org/wiki/Frequency_analysis|frequency analysis]</p>
<p>This homage to Charles Babbage uses this approach.</p>
<code>
$_='`$t`
`.=lc for<>;u($_`
)for` 3..``6;%t=qw `
`(a 82 b 15 c 28 d 43 e `
`127 f 22 ` g 20 h 61 i 70 `
`j 2 k 8 ```````l 40 m 24 n 67
` o 75` ` p 19 q 1`
` r ` 60 s 63 t
` 91 ` u 28 v 1
`0 w ` 24 x 2 y `
`20 ` ` z 1);$k=
k() ` ``;$d+=$t{$`
`_}f o``r keys%t;$l
=$d` /in` ``t(`length($t)/
$k)/100 ` ;map{%n=f(t($_));@g=b(1,\`
`%n);$y.= i(\@g)}0..$k-1;@_=(a..z);
map{@$_= @_;if($;++){for$"(2..$;){
pu ` sh` `` @$_,shift@$_}
`` `` `}` }@_;map{$p=i`
n` d`ex `((join\'\',`
` ` `@`{(sp `lit//,$y)[$c
` ]}),$_);` `$o```.=$p>=0?$`a`
`` [ $p]: $_;$c+=$c<$k-1?1
````: `-$` ``k+1}split//,$t;s
``ub \'b{my($e,$s `,@g)=@_;p `
``ush@ `g`,[$_,(s pli`
`` ``t//,\'#\' ``x in`
`` `t($$s{`$_}*$e )`)]for
` `+sort+keys%$s;retur ```n@g}s`
ub\'c{my$x=shift;$x=g($x,shift ```)while@_;
return$x}sub\'f{my%d;$d{$_}++f` or grep/[a-z]/
,split//,shift;$d{$_}||=0for a..z;return%d}su
b\'g{my($x,$y)=@_;($x,$y)=($y,$x%$y)while$y;r
eturn$x}sub\'i{my($g,@c)=@_;map{push@c,o(v($g),`
`` ` $$g[0][0]);w($g)}0..25;return(map{$_->[1]}sort{$`
b-`` >[0]<=>$a->[0]}@c)[0]} sub\'k{my@g;for(sort{$s{`
`$b}`` <=>$s{$a}}keys%s){last ``if$s{$_}<3;next unless y
`/a-``` z//>2;my@f ;push@f,(pos `($t)-3)while$t=~/$_/g;m`
````````y$g=c(n(@f) );`$g```` >2&&push@g,$g}return c(@`
g)}sub\'n{my$o= shift;return map{$_-$o}@_
}sub\'o{my($g,$w) =@_;my$c=0;map{map{/\+/&&`
$c++;/\-/&&$c--}@ $_}@$g;return[$c,$w]}sub\'
`t{my($o)=@_;my$c= 0;my$r;map{$r.=$_ unless(
`$k-$o+$c)%$k;$c++} split//,$t;$r=~s/[^a-z]/
/g;return$r}sub\'u{ my$l=$_[0];$s{substr($t`
,$_,$l)}++for 0..(le ngth($t)-$l)}sub\'v{my($
`m)=@_;my@g=b($l,\%t );$s=\@g;$z=0;map{$x=0;ma
`p{$$s[$z][$x]=$$m` [$z][$x]eq\'#\'&&$$s[$z][
`$x]eq\'#\'?\'+` \':\'-\';$x++}@$_;$z++}@$m
`;return$s}sub \'w{$R=shift;push@$R,shif`
`t@$R}print" Key: $y\nPlaintext:\n$o\``
`n";';s-\s \s+--gmx;s&`&&gm;eval#;`
#etur#`` `#my($x($v());$y=$z#`#`
##```` ``# charles #``
#`````` ````# babbage #`
#`````````` # # # # #`
# ` ` ` `# ##`
</code>
<p>This reads in ciphertext via STDIN. If saved as <code>babbage.pl</code>, and [id://549415] is saved as <code>vigenere.pl</code>, you can see it in action via:</p>
<code>
perl vigenere.pl | perl babbage.pl
</code>
<p>I have a more fully featured (unobfuscated, commented, and POD'd) version which even produces [href://http://www.kentcowgill.org/devig.html|HTML output] detailing the results of the Kasiski examination, and optionally the letter frequency analysis charts, which I will post to the code contributions section shortly. But not too quickly, as it's basically a giant spoiler for this :-)</p>
<p>I'd like to give a special thanks to [liverpole], as without his [id://520274], I wouldn't have been so easily able to generate an ascii 'portrait' of Charles Babbage that I could then turn into code.</p>
<!-- Node text goes above. Div tags should contain sig only -->
<div class="pmsig"><div class="pmsig-474411">
<br><br>
--chargrill
<hr>
<font size=2>
<code>$,=42;for(34,0,-3,9,-11,11,-17,7,-5){$*.=pack'c'=>$,+=$_}for(reverse split//=>$*
){$%++?$ %%2?push@C,$_,$":push@c,$_,$":(push@C,$_,$")&&push@c,$"}$C[$#C]=$/;($#C
>$#c)?($ c=\@C)&&($ C=\@c):($ c=\@c)&&($C=\@C);$%=$|;for(@$c){print$_^$$C[$%++]}</code>
</font>
</div></div>