decrypter.lisp

(in-package #:decrypter)

(eval-when (:compile-toplevel)
  (qtlc:utilize
   :utilities '(:iota :riffle)
   :categories '(:alexandria)
   :symbols '(:split-sequence-if-not)))

(qtlc:utilize-symbols '(:split-sequence :split-sequence-if-not))

(defvar messages '("15 ce 2a 15 64 40 ca 13"
		   "1f c8 25 17 62 48 d1 18"))

(defvar hex-messages (mapcar #'(lambda (x) 
				 (mapcar #'(lambda (y) 
					     (parse-integer y :radix 16)) 
					 (split-sequence #\Space x))) 
			     messages))
(defun bxor (x y)
  (boole boole-xor x y))

(defun slurp-stream (stream)
  (let ((seq (make-array (file-length stream) :element-type 'character :fill-pointer t)))
    (setf (fill-pointer seq) (read-sequence seq stream))
    seq))

(defvar x-message (apply #'mapcar #'bxor hex-messages))

(defvar guesses
  (with-open-file (stream "/usr/share/dict/american-english")
    (split-sequence #\Newline (slurp-stream stream))))

(defvar results 
  (mapcar #'(lambda (o)
	      (concatenate 'string o))
	  (mapcar #'(lambda (z) (mapcar #'code-char z)) 
		  (mapcar #'(lambda (x)
			      (mapcar #'bxor (mapcar #'char-code (concatenate 'list x)) x-message)) guesses))))

(defvar filtered-results 
  (intersection guesses (loop for x in results when (every #'identity (map 'list #'alphanumericp x)) 
			   collect x) :test #'equal))

(defvar key 
  (mapcar #'bxor (map 'list #'char-code "champion")
	  (mapcar #'(lambda (x) (parse-integer x :radix 16)) 
		  (split-sequence #\Space (first messages)))))

(defun write-encoded-str-to-hex (s)
  (mapcar #'(lambda (y) (write-to-string y :base 16)) 
	  (mapcar #'bxor key (mapcar #'char-code (concatenate 'list s)))))

(write-encoded-str-to-hex "champion")
(write-encoded-str-to-hex "innovate")
(mapcar #'(lambda (x) (write-to-string x :base 16)) key)
;;; "decrypter" goes here. Hacks and glory await!

Zzz that's ugly.

Oh and this is for OTPs (one time pads).