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>