API tools faq
paste
alexkus

xor.pl

alexkus
Dec 10th, 2013
144
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 8.98 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl
  2.  
  3. # Encode/decode a file by doing:-
  4. #
  5. # cat infile | ./xor.pl encode KEY > outfile
  6. #
  7. # Remaining functions expect the encrypted file to be a local file called e
  8. #
  9. # First determine keylength by doing:-
  10. # ./xor.pl keylength
  11. # and looking for the likely candidates
  12. #
  13. # Frequency analysis (of possible keys) by doing (for an expected keylength of 12):-
  14. #
  15. # ./xor.pl freq 12
  16. #
  17. # Known plaintext of "function" analysis by doing (for expected keylength of 12):-
  18. #
  19. # ./xor.pl knownplain 12 function
  20. #
  21. # Interactive key changing and decryption by doing:-
  22. #
  23. # ./xor.pl interactive 12
  24. # See source for available commands
  25.  
  26. use strict;
  27. use POSIX;
  28.  
  29. if( $ARGV[0] ~~ [ "encode", "decode" ] ) {
  30. my $key=$ARGV[1];
  31. if( $key eq "" ) {
  32. print "error: no key provided for $ARGV[0]\n";
  33. exit;
  34. }
  35. my $data = readstdin();
  36. print encode( $key, $data, 0 );
  37. } elsif( $ARGV[0] eq "keylength" ) {
  38. my ( $min,$max ) = ( undef, undef );
  39. if( $ARGV[1] ne "" ) {
  40. $min=int($ARGV[1]);
  41. if( $ARGV[2] ne "" ) {
  42. $max=int($ARGV[2]);
  43. }
  44. }
  45. my $data = readdata();
  46. keylength( $min, $max, $data );
  47. } elsif( $ARGV[0] eq "freq" ) {
  48. if( $ARGV[1] ne "" ) {
  49. my $kl=int($ARGV[1]);
  50. my $data = readdata();
  51. freq( $kl, $data );
  52. } else {
  53. print "error: no keylength provided for freq\n";
  54. exit;
  55. }
  56. } elsif( $ARGV[0] eq "knownplain" ) {
  57. if( $ARGV[1] ne "" ) {
  58. my $kl=int($ARGV[1]);
  59. if( $ARGV[2] ne "" ) {
  60. my $word=$ARGV[2];
  61. my $data = readdata();
  62. knownplain( $kl, $word, $data );
  63. }
  64. } else {
  65. print "error: no keylength provided for knownplain\n";
  66. exit;
  67. }
  68. } elsif( $ARGV[0] eq "interactive" ) {
  69. if( $ARGV[1] ne "" ) {
  70. my $kl=int($ARGV[1]);
  71. my $data = readdata();
  72. interactive( $kl, $data );
  73. } else {
  74. print "error: no keylength provided for interactive\n";
  75. exit;
  76. }
  77. } else {
  78. print "error: unknown command [$ARGV[0]]\n";
  79. }
  80.  
  81. exit;
  82.  
  83. sub readdata {
  84. local $/=undef; # Unset line delimeter so that next read from file slurps in everything
  85. open( D, "<e" ) || die "Can't open file 'e' [$!]";
  86. my $d=<D>;
  87. close( D );
  88. return( $d );
  89. }
  90.  
  91. sub readstdin{
  92. local $/=undef; # Unset line delimeter so that next read from file slurps in everything
  93. return( <STDIN> );
  94. }
  95.  
  96. sub keylength {
  97. # Check frequency distribution for different keylengths
  98. # See how many unique characters there are at different intervals
  99. my ( $min, $max, $data ) = @_;
  100. my $data_len=length( $data );
  101. $min=1 if( !defined( $min ) );
  102. $max=20 if( !defined( $max ) );
  103. foreach my $kl ( $min..$max ) {
  104. my %k=();
  105. foreach my $ct ( 0..$data_len-1 ) {
  106. my $let=substr( $data, $ct, 1 );
  107. $k{$ct%$kl}{ord($let)}++;
  108. }
  109. print "keylength=$kl";
  110. foreach my $ct ( 0..$kl-1 ) {
  111. my $boxes=0;
  112. foreach my $n ( 0..255 ) {
  113. $boxes++ if( exists( $k{$ct}{$n} ) );
  114. }
  115. print " $boxes";
  116. }
  117. print "\n";
  118. }
  119. }
  120.  
  121. sub encode {
  122. # Encoding is the same as decoding...
  123. my ( $key, $data, $cr ) = @_;
  124. my $kl=length( $key );
  125. my $ct=0;
  126. my $e="";
  127. foreach my $x ( split( //, $data ) ) {
  128. my $k=substr($key,$ct%$kl,1);
  129. my $l="$x"^"$k";
  130. if( $cr && !isprint( $l ) ) {
  131. $e .= "\\".ord($l);
  132. } else {
  133. $e.=$l;
  134. }
  135. $ct++;
  136. $e.="\n" if( $cr && ( $ct % $cr == 0 ) );
  137. }
  138. return( $e );
  139. }
  140.  
  141. sub freq {
  142. # Do frequency analysis of likely keys given a key length
  143. my ( $kl, $data ) = @_;
  144. my $data_len=length($data);
  145. my %k=();
  146. foreach my $ct ( 0..$data_len-1 ) {
  147. my $let=substr( $data, $ct, 1 );
  148. foreach my $cn ( 0..255 ) {
  149. my $c=chr($cn);
  150. my $x="$let"^"$c";
  151. # If the result is printable then its a likely candidate
  152. if( isprint( $x ) ) {
  153. $k{$ct%$kl}{$cn}++;
  154. }
  155. }
  156. }
  157. # Print out the top likely candidates for each position based on frequency
  158. # Note that this is definitely not foolproof!
  159. foreach my $ct ( 0..$kl-1 ) {
  160. my $poss=""; my $poss_n=0;
  161. foreach my $n ( 0..255 ) {
  162. if( exists( $k{$ct}{$n} ) ) {
  163. if( $k{$ct}{$n} > $poss_n ) {
  164. $poss_n=$k{$ct}{$n};
  165. $poss=chr($n);
  166. } elsif( $k{$ct}{$n} == $poss_n ) {
  167. $poss.=chr($n);
  168. }
  169. if( 0 ) {
  170. print "$ct ".(isprint(chr($n))?chr($n):$n)." = $k{$ct}{$n}\n";
  171. }
  172. }
  173. }
  174. print "POSS:$ct: n=$poss_n chars=$poss\n";
  175. }
  176. }
  177.  
  178. sub knownplain {
  179. # Given a keylength and a known plaintext string we check what are the most likely
  180. # keys assuming each possible substring is the given plaintext
  181. my ( $kl, $word, $data ) = @_;
  182. my $data_len=length($data);
  183. my $wl=length($word);
  184. my %k=();
  185. foreach my $ct ( 0..($data_len-$wl-1) ) { # Loop through all possible starts
  186. my $lets=substr( $data, $ct, $wl );
  187. my $x="$lets"^"$word";
  188. my @x=split( //, $x );
  189. foreach my $nct ( 0..$kl-1 ) {
  190. my $pos=($ct+$nct)%$kl;
  191. if( $nct < $wl ) {
  192. $k{$pos}{ord($x[$nct])}++;
  193. # print "POS $pos -> ".isprint($x[$nct])?$x[$nct]:ord($x[$nct])."\n";
  194. }
  195. }
  196. }
  197.  
  198. foreach my $ct ( 0..$kl-1 ) {
  199. my @rows=();
  200. foreach my $cn ( 0..255 ) {
  201. if( exists( $k{$ct}{$cn} ) ) {
  202. my $printit=$cn;
  203. if( isprint( chr($cn) ) ) {
  204. $printit=chr($cn);
  205. }
  206. my @row=( $ct, $printit, $k{$ct}{$cn} );
  207. push( @rows, \@row );
  208. # print "POS $ct: $printit -> $k{$ct}{$cn}\n";
  209. }
  210. }
  211. my $top=3;
  212. print "POS: $ct:";
  213. foreach my $x ( sort { $b->[2] <=> $a->[2] } @rows ) {
  214. print " $x->[1]->$x->[2]";
  215. last if( --$top == 0 );
  216. }
  217. print "\n";
  218. }
  219. }
  220.  
  221. sub interactive {
  222. # Interactive mode
  223. # k = print key
  224. # p = print output in blocks of keylength
  225. # P = print output verbatim
  226. # s n x = set key character n (starts from 0) to x
  227. # S xxxx = set entire key to S
  228. my ( $kl, $data ) = @_;
  229. my $k="a"x$kl;
  230. while( my $x = <STDIN> ) {
  231. chomp( $x );
  232. if( $x eq "p" ) {
  233. print encode( $k, $data, $kl );
  234. } elsif( $x eq "P" ) {
  235. print encode( $k, $data, 0 );
  236. } elsif( $x eq "k" ) {
  237. print "key is $k\n";
  238. } elsif( $x eq "x" || $x =~ /^q/ ) {
  239. exit;
  240. } elsif( $x =~ /^S (.*)$/ ) {
  241. my $oldlen=$kl;
  242. $k=$1;
  243. print "key is now $k\n";
  244. $kl=length( $k );
  245. print "WARNING: keylength changed from $oldlen to $kl\n" if( $kl != $oldlen );
  246. } elsif( $x =~ /^s (\d+) (.)$/ ) {
  247. my $pos=$1;
  248. my $c=$2;
  249. my @k=split( //, $k );
  250. $k[$pos]=$c;
  251. $k=join( '', @k );
  252. print "key is now $k\n";
  253. }
  254. }
  255. }
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!