aboutsummaryrefslogtreecommitdiff
path: root/cryptrobber.sts
diff options
context:
space:
mode:
Diffstat (limited to 'cryptrobber.sts')
-rw-r--r--cryptrobber.sts213
1 files changed, 213 insertions, 0 deletions
diff --git a/cryptrobber.sts b/cryptrobber.sts
new file mode 100644
index 0000000..b8b120d
--- /dev/null
+++ b/cryptrobber.sts
@@ -0,0 +1,213 @@
+module sts/ia32/elf/begin.sts
+module sts/ia32/float/float.sts
+module sts/cipher.sts
+module sts/keygen.sts
+module sts/freq.sts
+module sts/bifreq.sts
+
+[ sd 0 swap drop ]
+
+defword nicedist
+ 1 float_iload a float_iload float_div
+exit
+
+defword zeros
+ do dup 0 = until
+ 0 swap
+ 1 - od drop
+exit
+
+defword clear
+ do dup 0 = until
+ swap drop
+ 1 - od drop
+exit
+
+defword calcdist ; distance from ideal as sqrt sum square diff
+ 2c1 ref as calcdist.textfr
+ local calcdist.fr
+ 0 do dup 2be = until
+ dup word_size mul dup dup
+ calcdist.fr + @ float_fload
+ calcdist.textfr + @ float_fload
+ float_sub float_fstore dup float_fload float_fload
+ float_mul float_fstore swap calcdist.fr + !
+ 1 + od
+ 0 do dup 2bd = until
+ swap float_fload swap float_fload float_add float_fstore swap
+ 1 + od drop
+ float_fload float_sqrt nicedist float_less
+exit
+
+defword checktext
+ as checktext.length
+ local checktext.text
+ ; Count frequencies:
+ ; 676 latin bigrams:
+ 2a4 zeros local checktext.bifr
+ ; 26 latin letters:
+ 1a zeros local checktext.fr
+ ; count how much of each letter is in text:
+ 0 local checktext.hadalpha
+ 0 local checktext.bicount
+ 0 local checktext.count
+ checktext.length do 1 -
+ dup word_size mul checktext.text + @
+ dup dup 'z' > 0 = swap 'a' < 0 = mul if
+ dup 'z' swap - word_size mul local checktext.i
+ checktext.i @ checktext.fr + @ 1 + checktext.i @ checktext.fr + !
+ checktext.count @ 1 + checktext.count !
+ checktext.hadalpha @ if
+ checktext.bicount @ 1 + checktext.bicount !
+ checktext.hadalpha @ 1 - 1a mul checktext.i @ +
+ checktext.bifr +
+ dup @ 1 + swap !
+ fi
+ 1 + checktext.hadalpha !
+ else dup dup 'Z' > 0 = swap 'A' < 0 = mul if
+ dup 'Z' swap - word_size mul local checktext.i
+ checktext.i @ checktext.fr + @ 1 + checktext.i @ checktext.fr + !
+ checktext.count @ 1 + checktext.count !
+ checktext.hadalpha @ if
+ checktext.bicount @ 1 + checktext.bicount !
+ checktext.hadalpha @ 1 - 1a mul checktext.i @ +
+ checktext.bifr +
+ dup @ 1 + swap !
+ fi
+ 1 + checktext.hadalpha !
+ else 0 checktext.hadalpha ! dup dup 8 > 0 = swap 1 < 0 = mul if
+ 2c3 clear
+ 0 exit fi dup dup 1f > 0 = swap e < 0 = mul if
+ 2c3 clear
+ 0 exit fi fi fi drop
+ dup 0 = untilod drop
+ ; At least 1/4 characters in text should be alphabetical:
+ checktext.count @ float_iload checktext.length float_iload float_div
+ 1 float_iload 4 float_iload float_div float_less if
+ 2c1 clear
+ 0 exit fi
+ ; Division by zero shall not pass:
+ checktext.bicount 0 = if 2c1 clear 0 exit fi
+ ; normalize:
+ 0 do dup 1a = until
+ dup word_size mul checktext.fr + dup @ float_iload
+ checktext.count @ float_iload
+ float_div float_fstore swap !
+ 1 + od drop
+ 0 do dup 2a4 = until
+ dup word_size mul checktext.bifr + dup @ float_iload
+ checktext.bicount @ float_iload
+ float_div float_fstore swap !
+ 1 + od drop
+ ; Decide if text is real:
+ bifreq_eng freq_eng calcdist if 1 else
+ 0 fi
+ ; Remove frequencies from stack:
+ 2c1 set
+ 2c1 clear
+exit
+
+set_entry float_init ; this is program with floats
+ ; read file into stack
+ 0 do sys_read 0 = until
+ swap 1 +
+ od drop as length
+ local ciphertext
+
+ 0 ; initial key is empty
+ do
+ ; generate next key to try
+ keygen as keylen local key
+ '.' sys_write_err
+
+ ; decipher text (length is the same as for ciphertext)
+ keylen 1 - length do 1 -
+ as textpos local pos
+ textpos word_size mul ciphertext + @
+ key
+ keylen
+ pos
+ cipher
+ swap textpos
+ dup 0 = untilod drop drop
+ local plaintext
+
+ ; check deciphering attempt, exit if Ok or keylen = max (3)
+ keylen 3 = if eeeee else length checktext fi dup until drop
+ ; else remove the text from stack and place keylen back
+ 0 do dup length = until
+ swap drop 1 +
+ od drop keylen
+ od as langcode drop
+
+ ; output language
+ langcode 1 = if
+ 'e' sys_write_err
+ 'n' sys_write_err
+ 'g' sys_write_err
+ 'l' sys_write_err
+ 'i' sys_write_err
+ 's' sys_write_err
+ 'h' sys_write_err
+ fi langcode 2 = if
+ 'd' sys_write_err
+ 'u' sys_write_err
+ 't' sys_write_err
+ 'c' sys_write_err
+ 'h' sys_write_err
+ fi langcode 3 = if
+ 'g' sys_write_err
+ 'e' sys_write_err
+ 'r' sys_write_err
+ 'm' sys_write_err
+ 'a' sys_write_err
+ 'n' sys_write_err
+ fi langcode 4 = if
+ 'f' sys_write_err
+ 'r' sys_write_err
+ 'e' sys_write_err
+ 'n' sys_write_err
+ 'c' sys_write_err
+ 'h' sys_write_err
+ fi langcode 5 = if
+ 's' sys_write_err
+ 'p' sys_write_err
+ 'a' sys_write_err
+ 'n' sys_write_err
+ 'i' sys_write_err
+ 's' sys_write_err
+ 'h' sys_write_err
+ fi langcode 6 = if
+ 'i' sys_write_err
+ 't' sys_write_err
+ 'a' sys_write_err
+ 'l' sys_write_err
+ 'i' sys_write_err
+ 'a' sys_write_err
+ 'n' sys_write_err
+ fi langcode eeeee = if
+ 'e' sys_write_err
+ 'r' sys_write_err
+ 'r' sys_write_err
+ 'o' sys_write_err
+ 'r' sys_write_err
+ fi newline sys_write_err
+
+ ; output text
+ length do 1 -
+ dup word_size mul plaintext + @ sys_write
+ dup 1 = untilod drop
+ length do 1 -
+ swap drop
+ dup 1 = untilod drop
+
+ ; output key
+ keylen do 1 -
+ dup word_size mul key + @
+ dup 4 shr get_hex sys_write_err get_hex sys_write_err
+ dup 0 = until
+ space sys_write_err
+ od drop newline sys_write_err
+sys_exit
+
+module sts/ia32/elf/end.sts