changing distance function to manhattan

changing distance function to manhattan

const sampler_t sampler = CLK_NORMALIZED_COORDS_FALSE | CLK_ADDRESS_CLAMP | CLK_FILTER_NEAREST;

float myhypot(float x, float y)
{
    return sqrt((x*x) + (y*y));
}

float myabs(float x)
{
    if (x < 0)
        return x * -1;
    return x;
}

float manhattan(float x1, float x2, float y1, float y2)
{
    return (myabs(x1 - x2) + myabs(y1 - y2));
}

// Simple brute force voronoi diagram
__kernel void voronoi(__global float* voronoi_points_x, __global float*  voronoi_points_y, __global float* colors, __global int* data_points, __global float* superregions_x, __global float* superregions_y, __global float* supercolors, __global int* supercount, __write_only image2d_t heightmap, __global float* middle_colors)
{
    // Get the (x,y) coordinates of our desired point
    int x = get_global_id(0);
	int y = get_global_id(1);

	int2 coord = (int2) (x, y);

    float dmin = myhypot(1023, 1023);
    float d = 0.0f;
    int voronoi_cell = 0;

    // Check this point against EVERY datapoint
    // After this loop, the program has solved which of the datapoints is closest
    // to this (x,y) coordinate. This is stupid brute-forcing, but works on the GPU
    for (int i = 0; i < *data_points; i++)
    {
        //d = myhypot(voronoi_points_x[i]-x, voronoi_points_y[i]-y);
        d = manhattan(voronoi_points_x[i], x, voronoi_points_y[i],y);
        if (d < dmin)
        {
            dmin = d;
            voronoi_cell = i;
        }
    }

	float voronoi_color = colors[voronoi_cell];
    float uppercell = middle_colors[voronoi_cell];
	float4 outvalue;
	outvalue.x = voronoi_color;

    // Now see to which superregion this point belongs

    dmin = myhypot(1023, 1023);
    d = 0.0f;
    int super_cell = 0;

    for (int i = 0; i < *supercount; i++)
    {
        //d = myhypot(superregions_x[i]-x, superregions_y[i]-y);
        d = manhattan(superregions_x[i], x, superregions_y[i],y);
        if (d < dmin)
        {
            dmin = d;
            super_cell = i;
        }
    }

    float supercol = supercolors[super_cell];

	outvalue.y = supercol;
	outvalue.z = 0.0f;
	outvalue.w = 1.0f;
	write_imagef(heightmap, coord, outvalue);
}

const sampler_t sampler = CLK_NORMALIZED_COORDS_FALSE | CLK_ADDRESS_CLAMP | CLK_FILTER_NEAREST;

float myhypot(float x, float y)
{
    return sqrt((x*x) + (y*y));
}

float mystrangehypot(float x, float y)
{
    return (sqrt((x*x) + (y*y)));
}

// Simple brute force voronoi diagram
__kernel void voronoi(__global float* voronoi_points_x, __global float*  voronoi_points_y, __global float* colors, __global int* data_points, __global float* superregions_x, __global float* superregions_y, __global float* supercolors, __global int* supercount, __write_only image2d_t heightmap, __global float* middle_colors)
{
    // Get the (x,y) coordinates of our desired point
    int x = get_global_id(0);
	int y = get_global_id(1);

	int2 coord = (int2) (x, y);

    float dmin = myhypot(1023, 1023);
    float d = 0.0f;
    int voronoi_cell = 0;

    // Check this point against EVERY datapoint
    // After this loop, the program has solved which of the datapoints is closest
    // to this (x,y) coordinate. This is stupid brute-forcing, but works on the GPU
    for (int i = 0; i < *data_points; i++)
    {
        d = myhypot(voronoi_points_x[i]-x, voronoi_points_y[i]-y);
        if (d < dmin)
        {
            dmin = d;
            voronoi_cell = i;
        }
    }

	float voronoi_color = colors[voronoi_cell];
    float uppercell = middle_colors[voronoi_cell];
	float4 outvalue;
	outvalue.x = voronoi_color;

    // Now see to which superregion this point belongs

    dmin = myhypot(1023, 1023);
    d = 0.0f;
    int super_cell = 0;

    for (int i = 0; i < *supercount; i++)
    {
        d = mystrangehypot(superregions_x[i]-x, superregions_y[i]-y);
        if (d < dmin)
        {
            dmin = d;
            super_cell = i;
        }
    }

    float supercol = supercolors[super_cell];

	outvalue.y = supercol;
	outvalue.z = 0.0f;
	outvalue.w = 1.0f;
	write_imagef(heightmap, coord, outvalue);
}


Added #24, renamed bv-cat -> v-cat

Added #24, renamed bv-cat -> v-cat

;this file is a re-write of my solutions to www.cryptopals.com, trying out cl21 and apps hungarian notation

(eval-when (:execute)
  (ql-dist:install-dist "http://dists.cl21.org/cl21.txt"))

(eval-when (:compile-toplevel :execute)
  (ql:quickload :cl21)
  (ql:quickload :cl-test-more)
  (ql:quickload "ironclad")
  (ql:quickload "hunchentoot")
  (ql:quickload :drakma)
  (ql:quickload :iterate))

(in-package :cl21-user)
(defpackage cryptopals
  (:use :cl21
	:cl-test-more
	:iterate)
  (:shadowing-import-from :iterate :until)
  (:shadowing-import-from :iterate :while))
(in-package :cryptopals)

#|prefixes:
bv  -  byte vector
in  -  int
s   -  string
hs  -  hex string (eg, "12ef" for #x12ef)
hc  -  hex char
b64 -  base64 encoded data, represented as a string
cb  -  count of bytes
by  -  byte
?   -  boolean predicate

|#

;some utility functions
(defun bv-make (cb-length &optional by-initial-element)
  (if by-initial-element
      (make-array cb-length :element-type '(unsigned-byte 8) :initial-element by-initial-element)
      (make-array cb-length :element-type '(unsigned-byte 8) :initial-element 0)))

(defun bv-rand (cb-length)
  (ironclad:make-random-salt cb-length))

(defun bv-pad (bv padded-len)
  (concatenate 'vector (bv-make (- padded-len (length bv))) bv))

(defun v-cat (&rest args)
  (apply #'concatenate 'vector args))

(defun bv-from-in (in)
   (iterate (for i first in then (/ (- i (mod i 256)) 256))
	    (while (>= i 1))
	    (with res = #())
	    (after-each (push (mod i 256) res))
	    (finally (return (nreverse res)))))

(defun bv-from-s (s)
  (map-to 'vector #'char-code s))

(defun bv-from-hs (hs)
  (let ((nibbles (map-to 'vector #'in-from-hc hs)))
    (let ((pairs (nreverse (subdivide (nreverse nibbles) 2)))) ;to handle odd lengths correctly
      (map-to 'vector (lm (pair) (+ (* 16 (second pair)) (first pair)))
	      pairs))))

(defun in-combine-bytes (high low bit-len)
  (+ (* high (expt 2 bit-len)) low))

(defun in-from-bv (bv)
  (reduce (lm (x y) (in-combine-bytes x y 8)) bv))

(defun in-from-s (s)
  (in-from-bv (bv-from-s s)))

(defun in-from-hc (hc)
  (let ((index "0123456789abcdef")
	(hc-dc (char-downcase hc)))
    (position hc-dc index)))

(defun in-from-hs (hs)
  (in-from-bv (bv-from-hs hs)))

(defun s-from-in (in)
  (s-from-bv (bv-from-in in)))

(defun s-from-bv (bv)
  (map-to 'string #'code-char bv))

(defun s-from-hs (hs)
  (s-from-bv (bv-from-hs hs)))

(defun s-from-seq (seq)
  (with-output-to-string (s)
    (doeach (x seq)
      (princ x s))))

(defun s-make (len &optional (c-initial-element #\a))
  (map-to 'string #'code-char (bv-make len (char-code c-initial-element))))

(defun s-cat (&rest args)
  (apply #'concatenate 'string args))

(defun hs-from-by (by)
  (let ((index "0123456789abcdef")
	(high (floor (/ by 16)))
	(low (mod by 16)))
    (format nil "~{~A~}" (list (getf index high) (getf index low)))))

(defun hs-from-bv (bv)
  (reduce (lm (x y) (s-cat x y))
	  (map-to 'list #'hs-from-by bv)))

(defun hs-from-in (in)
  (hs-from-bv (bv-from-in in)))

(defun hs-from-s (s)
  (hs-from-bv (bv-from-s s)))

;conversion function tests
(ok (equalp (bv-pad #(1 2) 3) #(0 1 2))
    "bv-pad")
(ok (equalp (bv-from-in 258) #(1 2))
    "bv-from-in 1")
(ok (equalp (bv-from-in 123) #(123))
    "bv-from-in 2")
(ok (equalp (bv-from-s "ab") #((char-code #\a) (char-code #\b)))
    "bv-from-s")
(is (in-from-bv #(1 2)) 258)
(is (in-from-hc #\a) 10)
(is (in-from-hs "BC614e") 12345678)
(is (s-from-seq '(#\a #\b #\c #\d #\e #\f)) "abcdef")
(is (s-from-seq #(#\a #\b #\c #\d #\e #\f)) "abcdef")
(is (hs-from-by 255) "ff")
(is (hs-from-bv #(255 0)) "ff00")
(is (s-from-in (+ (* 97 256) 98)) "ab")

;set 1

;1. Convert hex to base64 encoding.  Base64 will be represented as a string in all future cases in this file

(defun mod-remainder (num div)
  (if (= (mod num div) 0)
      0
      (- div (mod num div))))

(defun b64c-from-6bits (n)
  (let ((base64-index "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))
        (getf base64-index n)))

(defun b64-from-3bytes (bv)
  (let ((len-pad (mod-remainder (length bv) 3)))
    (let ((in-padded (in-from-bv (v-cat bv (bv-make len-pad))))
	  (s-padding (s-from-bv (bv-make len-pad 61))))
	(iterate (for offset in '(0 6 12 18))
		 (for cur-bits = (ldb (byte 6 offset) in-padded))
		 (collecting (b64c-from-6bits cur-bits) into l-res)
		 (finally (return (s-cat
					       (subseq (s-from-seq (nreverse l-res))
						       0
						       (- 4 len-pad))
					       s-padding)))))))

(defun b64-from-bv (bv)
  (s-from-seq (map #'b64-from-3bytes (subdivide bv 3))))

(defun b64-from-hs (hs)
  (b64-from-bv (bv-from-hs hs)))

(defun b64-from-s (s)
  (b64-from-bv (bv-from-s s)))

(defun b64-from-in (in)
  (b64-from-bv (bv-from-in in)))

(is (b64-from-s "l pleasure.") "bCBwbGVhc3VyZS4=")

(defun 6bits-from-b64c (b64c)
  (position b64c "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))

(defun 3bv-from-b64 (b64)
  (let ((len-pad 0))
    (cond ((equalp (getf b64 2) #\=) (setf len-pad 2))
	  ((equalp (getf b64 3) #\=) (setf len-pad 1)))
    (let ((b64-padding (s-make len-pad #\A))
	  (b64-without-pad (subseq b64 0 (- 4 len-pad))))
      (let ((in-total (reduce (lm (high low) (in-combine-bytes high low 6))
			      (map-to 'vector #'6bits-from-b64c (s-cat b64-without-pad b64-padding)))))
	(subseq (bv-pad (bv-from-in in-total) 3) 0 (- 3 len-pad))))))

(defun bv-from-b64 (b64)
  (reduce #'append (map-to 'vector #'3bv-from-b64 (subdivide b64 4))))

(defun in-from-b64 (b64)
  (in-from-bv (bv-from-b64 b64)))

(defun s-from-b64 (b64)
  (s-from-bv (bv-from-b64 b64)))

(defun hs-from-b64 (b64)
  (hs-from-bv (bv-from-b64 b64)))

(defun bv-from-b64-file (file-name)
  (bv-from-b64 (remove #\Newline (remove #\Return (read-file-into-string file-name)))))

(is (b64-from-hs "49276d206b696c6c696e6720796f757220627261696e206c696b65206120706f69736f6e6f7573206d757368726f6f6d")
    "SSdtIGtpbGxpbmcgeW91ciBicmFpbiBsaWtlIGEgcG9pc29ub3VzIG11c2hyb29t")

;2. Fixed XOR

;(int-to-hex-string (hex-string-xor "1c0111001f010100061a024b53535009181c" "686974207468652062756c6c277320657965"))

;output: "746865206b696420646f6e277420706c6179"

(defun bv-xor (bv1 bv2)
  (map-to 'vector #'logxor bv1 bv2))

(defun hs-xor (hs1 hs2)
  (hs-from-bv (bv-xor (bv-from-hs hs1) (bv-from-hs hs2))))

(defun s-xor (s1 s2)
  (s-from-bv (bv-xor (bv-from-s s1) (bv-from-s s2))))

(defun int-xor (&rest ints)
  (apply #'logxor ints))

(is (hs-xor "1c0111001f010100061a024b53535009181c" "686974207468652062756c6c277320657965")
    "746865206b696420646f6e277420706c6179")

;3. Single-character XOR Cipher:

;frequency table derived from http://www.data-compression.com/english.html
(defvar *frequency-table* #H(#\a .0651738 #\b .0124248 #\c .0217339 #\d .0349835 #\e .1041442 #\f .0197881 #\g .0158610 #\h .049288 #\i .0558094 #\j .0009033 #\k .0050529 #\l .0331490 #\m .0202124 #\n .0564513 #\o .0596302 #\p .0137645 #\q .0008606 #\r .0497563 #\s .0515760 #\t .0729357 #\u .0225134 #\v .0082903 #\w .0171272 #\x .0013692 #\y .0145984 #\z .0007836 #\  .1918182 #\newline .01 #\Return .01 #\' .01 #\. .01 #\" .01 #\, .01 #\0 .001 #\1 .001 #\2 .001 #\3 .001 #\4 .001 #\5 .001 #\6 .001 #\7 .001 #\8 .001 #\9 .001))

#|
;frequency table derived from Vanilla Ice lyrics
(defvar *frequency-table* #H(#\! 1/3101 #\1 1/3101 #\0 1/3101 #\. 2/3101 #\5 1/3101 #\z 3/3101 #\q 2/3101 #\j 13/3101 #\- 2/3101 #\x 4/3101 #\u 62/3101 #\? 3/3101 #\f 29/3101 #\m 66/3101 #\w 6/443 #\d 11/443 #\n 137/3101 #\h 109/3101 #\g 51/3101 #\r 78/3101 #\a 204/3101 #\b 76/3101 #\c 107/3101 #\k 47/3101 #\s 110/3101 #\' 33/3101 #\t 173/3101 #\e 257/3101 #\l 151/3101 #\Newline 110/3101 #\p 47/3101 #\i 207/3101 #\v 36/3101 #\  526/3101 #\, 72/3101 #\o 179/3101 #\y 82/3101))
|#

(defun ft-from-string (s)
  (let ((ft #H()))
    (doeach (chr s)
      (inc-hash ft (char-downcase chr)))
    (ft-normalize-hash ft)))

(defun ft-from-file (file)
  (let ((s (read-file-into-string file)))
    (ft-from-string s)))

(defun ft-from-bv (bv)
  (ft-from-string (s-from-bv bv)))

(defun inc-hash (table key)
  (let ((?-exists (nth-value 1 (getf table key))))
    (if ?-exists
        (incf (getf table key))
      (setf (getf table key) 1))))

(defun ft-normalize-hash (ft)
  (let ((sum (reduce #'+ (map-to 'list #'cdr ft))))
    (doeach ((key val) ft)
      (setf (getf ft key) (/ val sum)))
    ft))

(defun fl-frequency-compare (ft-test ft-ref)
  (let ((res 0))
    (doeach ((key val) ft-test res)
      (if (getf ft-ref key)
	  (incf res (expt (abs (- val (getf ft-ref key))) 5))
	  (incf res 100)))))

(defun bv-xor-with-byte (bv by)
  (map (lm (x) (logxor x by)) bv))

(defun xor-crack (bv-ciphertext ft-ref)
  (let ((res (list "default result" 0 1000)))
    (doeach (x (iota 256) res)
      (let ((cand (fl-frequency-compare (ft-from-bv (bv-xor-with-byte bv-ciphertext x))
					ft-ref)))
	(if (< cand (nth res 2))
	    (setf res (list (s-from-bv (bv-xor-with-byte bv-ciphertext x)) x cand)))))))

(is (nth (xor-crack (bv-from-hs "1b37373331363f78151b7f2b783431333d78397828372d363c78373e783a393b3736") *frequency-table*) 0)
    "Cooking MC's like a pound of bacon")

;4. Detect single-character XOR

(defun slist-from-file (file-name)
  (let ((s-file (read-file-into-string file-name)))
    (split #\newline s-file)))

(defun xor-find-crack (slist-cipher ft-ref)
  (let ((res (list "default result" 0 1000)) ;must match the layout of the output from xor-crack above
	(slist-plain (map (lm (x) (xor-crack (bv-from-hs x) ft-ref)) slist-cipher)))
    (doeach (x slist-plain res)
      (if (< (nth x 2) (nth res 2))
		 (setf res x)))))

(defun file-xor-find-crack (file-name ft-ref)
  (nth (xor-find-crack (slist-from-file file-name) ft-ref) 0))

(ok (equalp (file-xor-find-crack "/home/adminuser/4.txt" *frequency-table*)
	    "Now that the party is jumping\n")
    "file-xor-find-crack")

;5. Repeating-key XOR Cipher

(defun repeated-key-xor (bv-plain bv-key)
  (let ((bv-split (subdivide bv-plain (length bv-key))))
    (apply #'append (map-to 'list (lm (x) (bv-xor x bv-key)) bv-split))))

(is (hs-from-bv (repeated-key-xor (bv-from-s "Burning 'em, if you ain't quick and nimble I go crazy when I hear a cymbal")
				  (bv-from-s "ICE")))
    "0b3637272a2b2e63622c2e69692a23693a2a3c6324202d623d63343c2a26226324272765272a282b2f20690a652e2c652a3124333a653e2b2027630c692b20283165286326302e27282f")

;6. Break repeating-key XOR:

;(file-xor-crack "c:\\temp\\xor.txt" dict)

;outputs "Terminator X: Bring the noise" as the key, and some terrible vanila ice song as the plain text.

(defun in-bit-distance (in1 in2)
  (expt (logcount (logxor in1 in2)) 1))

(defun fl-bit-distance (bv1 bv2)
  (/ (reduce #'+ (map-to 'vector #'in-bit-distance bv1 bv2))
     (length bv1)))

(is (fl-bit-distance (bv-from-s "this is a test") (bv-from-s "wokka wokka!!!")) 37/14)

(is (fl-bit-distance #(2 4 8) #(3 5 9)) 1)
(is (fl-bit-distance #(2 4) #(3 5)) 1)

(defun map-pairs (fn seq)
  ;todo:  make this a generic function or something, so that the output type matches the
  ;       input type, instead of always outputing a list
  (iterate (repeat (- (length seq) 1))
	   (for elem first (first seq) then (first rest))
	   (for rest first (subseq seq 1) then (subseq rest 1))
	   (appending (map-to 'list (lm (x) (funcall fn x elem)) rest))))

(is (map-pairs #'+ '(1 2 3 4)) '(3 4 5 5 6 7))
(is (map-pairs #'+ #(1 2 3 4)) '(3 4 5 5 6 7))

(defun fact (in)
  (reduce #'* (iota in :start 1)))

(is (fact 1) 1)
(is (fact 5) 120)

(defun n-choose-r (n r)
  (/ (fact n) (* (fact r) (fact (- n r)))))

(is (n-choose-r 6 2) 15)

(defun lst-xor-block-size (bv-cipher max-size)
  (let ((lens (iota max-size :start 1)))
    (let ((cands (map (lm (x) (xor-block-size-helper bv-cipher x))
		      lens)))
      (take 15 (sort cands (lm (pair1 pair2) (< (cdr pair1) (cdr pair2))))))))

(defun xor-block-size-helper (bv-cipher len)
  (let ((blocks (subdivide bv-cipher len)))
    (cons len
	  (/ (reduce #'+ (map-pairs #'fl-bit-distance blocks))
	     (n-choose-r (length blocks) 2)))))

(defun lst-block-transpose (bv block-len)
  (let ((res '())
	(blocks (subdivide bv block-len)))
    (doeach (i (iota block-len) res)
      (push (map-to 'vector (lm (x) (if (< i (length x)) (elt x i) 0)) blocks) res))
    (nreverse res)))

(ok (equalp (lst-block-transpose #(1 2 3 4 5 6 7 8) 2)
	    (list (vector 1 3 5 7) (vector 2 4 6 8)))
    "lst-block-transpose")

(defun bv-find-repeat-key (bv-cipher)
 (let* ((block-lens (map #'car (lst-xor-block-size bv-cipher 50)))
	(lst-transposes (map (lm (x) (lst-block-transpose bv-cipher x)) block-lens)))
  (let* ((lst-keys (map (lm (transpose) (map-to 'vector (lm (bv) (elt (xor-crack bv *frequency-table*) 1))
						transpose))
			lst-transposes))
	 (lst-bvs (map (lm (key) (repeated-key-xor bv-cipher key))
		       lst-keys)))
    (car (sort lst-bvs (lm (bv1 bv2) (< (fl-frequency-compare (ft-from-bv bv1) *frequency-table*)
					(fl-frequency-compare (ft-from-bv bv2) *frequency-table*))))))))

(defun s-file-find-repeat-key (filename)
  (s-from-bv (bv-find-repeat-key (bv-from-b64-file filename))))

(eval-when (:execute)
  (print (s-file-find-repeat-key "c:\\temp\\xor.txt")))

(eval-when (:execute)
  (print (s-file-find-repeat-key "/home/adminuser/6.txt")))

;7. AES in ECB mode:

(defun bv-AES-encrypt (bv-msg bv-key)
  (let ((bv-res (bv-make (length bv-msg)))
	(cipher (ironclad:make-cipher :AES :mode :ECB :key (coerce bv-key '(vector (unsigned-byte 8))))))
    (ironclad:encrypt cipher (coerce bv-msg '(vector (unsigned-byte 8))) bv-res)
    bv-res))

(defun bv-AES-decrypt (bv-msg bv-key)
  (let ((bv-res (bv-make (length bv-msg)))
	(cipher (ironclad:make-cipher :AES :mode :ECB :key (coerce bv-key '(vector (unsigned-byte 8))))))
    (ironclad:decrypt cipher (coerce bv-msg '(vector (unsigned-byte 8))) bv-res)
    bv-res))

(defun s-AES-encrypt (s-msg s-key)
  (let ((bv-msg (bv-from-s s-msg))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-aes-encrypt bv-msg bv-key))))

(defun s-AES-decrypt (s-msg s-key)
  (let ((bv-msg (bv-from-s s-msg))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-aes-decrypt bv-msg bv-key))))

(defun bv-file-aes-encrypt (file-name bv-key)
  (let ((bv-msg (bv-from-s (read-file-into-string file-name))))
    (bv-aes-encrypt bv-msg bv-key)))

(defun bv-file-aes-decrypt (file-name bv-key)
  (let ((bv-msg (bv-from-s (read-file-into-string file-name))))
    (bv-aes-decrypt bv-msg bv-key)))

(defun s-file-aes-encrypt (file-name s-key)
  (let ((bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-encrypt file-name bv-key))))

(defun s-file-aes-decrypt (file-name s-key)
  (let ((bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-decrypt file-name bv-key))))

(eval-when (:execute)
  (print (s-from-bv (bv-aes-decrypt (bv-from-b64-file "/home/adminuser/7.txt") (bv-from-s "YELLOW SUBMARINE")))))

;8. Detect AES in ECB mode

;this is easy.  The only distinguishing fact about ECB is that identical blocks give identical encryption, so look for identical blocks

(defun bv-find-duplicate-blocks (lst-bvs cb-len)
  (let ((lst-blocks (map (lm (bv) (subdivide bv cb-len)) lst-bvs))
	(res #()))
    (doeach (blocks lst-blocks res)
      (if (not (= (reduce #'+ (map-pairs #'fl-bit-distance blocks)) 0))
	  (setf res (apply #'v-cat blocks))))))

(defun bv-file-find-duplicate-blocks (file-name cb-len)
  (let* ((lst-hs (split #\newline (read-file-into-string file-name)))
	 (lst-bvs (map #'bv-from-hs lst-hs)))
    (bv-find-duplicate-blocks lst-bvs cb-len)))

(eval-when (:execute)
  (print (bv-file-find-duplicate-blocks "/home/adminuser/8.txt" 16)))

;problems from set 2

;9. Implement PKCS#7 padding

(defun bv-pkcs7-pad (bv cb-block-len)
  ;gives a full block of padding for even multiples of the block length
  (let ((cb-padding-len (- cb-block-len (mod (length bv) cb-block-len))))
    (v-cat bv (make-array cb-padding-len :initial-element cb-padding-len))))

(ok (equalp (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 20)
	    #(89 69 76 76 79 87 32 83 85 66 77 65 82 73 78 69 4 4 4 4))
    "bv-pkcs7-pad 1")

(ok (equalp (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 16)
	       #(89 69 76 76 79 87 32 83 85 66 77 65 82 73 78 69 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16))
    "bv-pkcs7-pad 2")

;this is nominally challenge 15, but using it makes #13 easier to implement, so I'm writing it now
(defun bv-pkcs7-unpad (bv cb-block-len)
  ;returns nil for invalid padding
  (iterate (for i from 1)
	   (until (equalp (subseq bv (- (length bv) i)) (bv-make i i)))
	   (until (> i cb-block-len))
	   (finally (if (<= i cb-block-len)
			(return (subseq bv 0 (- (length bv) i)))
			(return 'nil)))))

(ok (equalp (bv-pkcs7-unpad (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 20) 20)
	    (bv-from-s "YELLOW SUBMARINE"))
    "bv-pkcs7-unpad 1")

(ok (equalp (bv-pkcs7-unpad #(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) 16)
	    'nil)
    "bv-pkcs7-unpad 2")

(defun bv-aes-pkcs7-encrypt (bv-msg bv-key)
  (bv-aes-encrypt (bv-pkcs7-pad bv-msg 16) bv-key))

(defun bv-aes-pkcs7-decrypt (bv-msg bv-key)
  (bv-aes-decrypt (bv-pkcs7-unpad bv-msg 16) bv-key))

;10. Implement CBC Mode

(defun bv-aes-cbc-encrypt (bv-msg bv-iv bv-key)
  (let* ((bv-padded (bv-pkcs7-pad bv-msg 16))
	 (blocks (subdivide bv-padded 16))
	 (res (iterate (for next in blocks)
		       (for prev previous ctext initially bv-iv)
		       (for ctext = (bv-aes-encrypt (bv-xor prev next) bv-key))
		       (collecting ctext))))
    (apply #'v-cat res)))

(defun bv-aes-cbc-decrypt (bv-msg bv-iv bv-key)
  (let* ((blocks (subdivide bv-msg 16))
	 (res (iterate (for next in blocks)
		       (for prev previous next initially bv-iv)
		       (collecting (bv-xor (bv-aes-decrypt next bv-key) prev)))))
    (bv-pkcs7-unpad (apply #'v-cat res) 16)))

(defun bv-file-aes-cbc-encrypt (file-name bv-iv bv-key)
  (let ((bv-msg (bv-from-b64-file file-name)))
    (bv-aes-cbc-encrypt bv-msg bv-iv bv-key)))

(defun s-file-aes-cbc-encrypt (file-name s-iv s-key)
  (let ((bv-iv (bv-from-s s-iv))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-cbc-encrypt file-name bv-iv bv-key))))

(defun bv-file-aes-cbc-decrypt (file-name bv-iv bv-key)
  (let ((bv-msg (bv-from-b64-file file-name)))
    (bv-aes-cbc-decrypt bv-msg bv-iv bv-key)))

(defun s-file-aes-cbc-decrypt (file-name s-iv s-key)
  (let ((bv-iv (bv-from-s s-iv))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-cbc-decrypt file-name bv-iv bv-key))))

(ok (equalp (let ((bv-msg (bv-make 48 65))
		  (bv-key (bv-rand 16))
		  (bv-iv (bv-rand 16)))
	      (bv-aes-cbc-decrypt (bv-aes-cbc-encrypt bv-msg bv-iv bv-key) bv-iv bv-key))
	    (bv-make 48 65))
    "bv-aes-cbc-encrypt/decrypt")

;11. An ECB/CBC detection oracle

;This is also easy:  just send a long repeated string as input, check for repeats in the output

(defmacro with-cbc-keys ((sym-iv sym-key) &body body)
  `(let ((,sym-iv (bv-rand 16))
	 (,sym-key (bv-rand 16)))
     ,@body))

(defun ch11-oracle (bv-msg)
  (let ((bv-pre-pad (bv-rand (+ 5 (random 6))))
	(bv-post-pad (bv-rand (+ 5 (random 6)))))
    (with-cbc-keys (bv-iv bv-key)
      (let ((bv-padded (v-cat bv-pre-pad bv-msg bv-post-pad)))
	(if (= (random 2) 0)
	    (progn (print "cbc")
		   (bv-aes-cbc-encrypt bv-padded bv-iv bv-key))
	    (progn (print "ecb")
		   (bv-aes-encrypt bv-padded bv-key)))))))

(defun ?-duplicate-blocks (blocks)
  (some (lm (x) (= x 0)) (map-pairs #'fl-bit-distance blocks)))

(defun ch11-crack ()
  (let* ((bv-msg (bv-make 48 65))
	 (bv-res (coerce (ch11-oracle bv-msg) '(and common-lisp:vector (not simple-array))))
	 (blocks (subdivide bv-res 16)))
    (if (?-duplicate-blocks blocks)
	"ecb"
	"cbc")))

(print (ch11-crack))

;12. Byte-at-a-time ECB decryption (Simple)

(defun ch12-oracle (bv-msg)
  (let ((bv-post-pad (bv-rand (+ 5 (random 6))))
	(bv-secret (bv-from-b64 "Um9sbGluJyBpbiBteSA1LjAKV2l0aCBteSByYWctdG9wIGRvd24gc28gbXkgaGFpciBjYW4gYmxvdwpUaGUgZ2lybGllcyBvbiBzdGFuZGJ5IHdhdmluZyBqdXN0IHRvIHNheSBoaQpEaWQgeW91IHN0b3A/IE5vLCBJIGp1c3QgZHJvdmUgYnkK"))
	(bv-key (bv-rand 16)))
    (bv-aes-encrypt (bv-pkcs7-pad (v-cat bv-msg bv-secret bv-post-pad) 16) bv-key)))

(defun ch12-crack ()
  (let ((bv-res #()))
    (iterate (for i upfrom 1)
	     (for cb-offset = (- 16 (mod i 16)))
	     (for bv-offset = (bv-make cb-offset))
	     (for bv-prefix first (bv-make 15) then (v-cat (subseq bv-prefix 1) (vector by-res)))
	     (for by-res = (iterate (for i from 0 to 255)
				    (for bv-msg = (v-cat bv-prefix (vector i) bv-offset))
				    (for bv-oracle-output = (ch12-oracle bv-msg))
				    (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
				    (finally (return i))))
	     (until (= by-res 256))
	     (after-each (push by-res bv-res))
	     (finally (return (s-from-bv bv-res))))))

(eval-when (:execute)
  (print (ch12-crack)))

;13.  ECB cut-and-paste

(defun ch13-parse (s-cookie)
  (let* ((s-pairs (split #\& s-cookie))
	 ;map doesn't work here, seems to give a list with slightly incorrect structure
	 (s-keys-vals (iterate (for s in s-pairs)
			       (appending (split #\= s)))))
    (apply #'hash-table #'equal s-keys-vals)))

(defun ch13-make-profile (s-email)
  (let ((s-stripped (remove #\= (remove #\& s-email))))
    #"email=${s-stripped}&uid=10&role=user"))

(is (ch13-make-profile "foo@bar.com") "email=foo@bar.com&uid=10&role=user")

(defun ch13-test (bv-ctext bv-key)
  (let* ((s-cookie (s-from-bv (bv-pkcs7-unpad (bv-aes-decrypt bv-ctext bv-key) 16)))
	 (profile-table (ch13-parse s-cookie)))
    (if (equal (getf profile-table "role") "admin")
	"victory"
	"failure")))

(is (ch13-test (bv-aes-encrypt (bv-pkcs7-pad (bv-from-s "email=foo@bar.com&uid=10&role=admin") 16)
			       (bv-make 16)) (bv-make 16))
    "victory")

(defun ch13-enc-profile (s-email bv-key)
  (bv-aes-pkcs7-encrypt (bv-from-s (ch13-make-profile s-email)) bv-key))

(defun ch13-crack ()
  (let ((bv-key (bv-rand 16)))
    (let ((bv-padding (last (subdivide (ch13-enc-profile "fo@ba.com" bv-key) 16))) ;encryption of 16 16's
	  (bv-email (subseq (ch13-enc-profile "bcobu@foo.com" bv-key) 0 32))
	  (bv-admin (elt (subdivide (ch13-enc-profile "foo@bar.coadmin" bv-key) 16) 1)))
      (ch13-test (v-cat bv-email bv-admin bv-padding) bv-key))))

(is (ch13-crack)
    "victory")

;14. Byte-at-a-time ECB decryption (Harder)

;this is identical to #12, except that there's an initial step where we find the length of the 'random' prefix
(defvar *ch14-prefix-len* (+ 5 (random 6)))

(defun ch14-oracle (bv-msg)
  (let ((bv-pre-pad (bv-rand *ch14-prefix-len*))
	(bv-post-pad (bv-rand (+ 5 (random 6))))
	(bv-secret (bv-from-b64 "Um9sbGluJyBpbiBteSA1LjAKV2l0aCBteSByYWctdG9wIGRvd24gc28gbXkgaGFpciBjYW4gYmxvdwpUaGUgZ2lybGllcyBvbiBzdGFuZGJ5IHdhdmluZyBqdXN0IHRvIHNheSBoaQpEaWQgeW91IHN0b3A/IE5vLCBJIGp1c3QgZHJvdmUgYnkK"))
	(bv-key (bv-rand 16)))
    (bv-aes-encrypt (bv-pkcs7-pad (v-cat bv-pre-pad bv-msg bv-secret bv-post-pad) 16) bv-key)))

(defun ch14-prefix-len ()
  (iterate (for i from 0 to 16)
	   (for bv-oracle-output = (ch14-oracle (v-cat (bv-rand i) (bv-make 32))))
	   (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
	   (finally (return i))))

(defun ch14-crack ()
  (let ((bv-res #())
	(cb-prefix-len (ch14-prefix-len)))
    (iterate (for i upfrom 1)
	     (for cb-offset = (- 16 (mod i 16)))
	     (for bv-offset = (bv-make cb-offset))
	     (for bv-prefix first (bv-make (+ cb-prefix-len 15)) then (v-cat (subseq bv-prefix 1) (vector by-res)))
	     (for by-res = (iterate (for i from 0 to 255)
				    (for bv-msg = (v-cat bv-prefix (vector i) bv-offset))
				    (for bv-oracle-output = (ch14-oracle bv-msg))
				    (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
				    (finally (return i))))
	     (until (= by-res 256))
	     (after-each (push by-res bv-res))
	     (finally (return (s-from-bv bv-res))))))

(eval-when (:execute)
  (print (ch14-crack)))

;15. PKCS#7 padding validation

;implementing above under #9, because it's used in #13

;16. CBC bitflipping attacks

(defun ch16-encrypt (s-userdata bv-iv bv-key)
  (let ((s-stripped (remove #\= (remove #\; s-userdata)))
	(s-pre "comment1=cooking%20MCs;userdata=")
	(s-post ";comment2=%20like%20a%20pound%20of%20bacon"))
    (let ((bv-msg (bv-from-s (s-cat s-pre s-stripped s-post))))
      (bv-aes-cbc-encrypt bv-msg bv-iv bv-key))))

(defun ch16-check (bv-ctext bv-iv bv-key)
  (let ((s-ptext (s-from-bv (bv-aes-cbc-decrypt bv-ctext bv-iv bv-key))))
    (search";admin=true;" s-ptext)))

(defun ch16-crack ()
  (with-cbc-keys (bv-iv bv-key)
    (let* ((bv-userdata (bv-make 16 65))
	   (bv-ctext (ch16-encrypt (s-from-bv bv-userdata) bv-iv bv-key))
	   (bv-target (bv-from-s "a;admin=true;aaa"))
	   (bv-edit (bv-xor (bv-xor bv-userdata bv-target) (subseq bv-ctext 16 32))))
      (ch16-check bv-ctext bv-iv bv-key)
      (ch16-check (v-cat (subseq bv-ctext 0 16) bv-edit (subseq bv-ctext 32))
		  bv-iv
		  bv-key))))

(ok (ch16-crack) "Challenge 16")

;problems from set 3

;17. CBC padding oracle

(defun ch17-encrypt (bv-iv bv-key)
  (let ((lst-secrets (list "MDAwMDAwTm93IHRoYXQgdGhlIHBhcnR5IGlzIGp1bXBpbmc="
			   "MDAwMDAxV2l0aCB0aGUgYmFzcyBraWNrZWQgaW4gYW5kIHRoZSBWZWdhJ3MgYXJlIHB1bXBpbic="
			   "MDAwMDAyUXVpY2sgdG8gdGhlIHBvaW50LCB0byB0aGUgcG9pbnQsIG5vIGZha2luZw=="
			   "MDAwMDAzQ29va2luZyBNQydzIGxpa2UgYSBwb3VuZCBvZiBiYWNvbg=="
			   "MDAwMDA0QnVybmluZyAnZW0sIGlmIHlvdSBhaW4ndCBxdWljayBhbmQgbmltYmxl"
			   "MDAwMDA1SSBnbyBjcmF6eSB3aGVuIEkgaGVhciBhIGN5bWJhbA=="
			   "MDAwMDA2QW5kIGEgaGlnaCBoYXQgd2l0aCBhIHNvdXBlZCB1cCB0ZW1wbw=="
			   "MDAwMDA3SSdtIG9uIGEgcm9sbCwgaXQncyB0aW1lIHRvIGdvIHNvbG8="
			   "MDAwMDA4b2xsaW4nIGluIG15IGZpdmUgcG9pbnQgb2g="
			   "MDAwMDA5aXRoIG15IHJhZy10b3AgZG93biBzbyBteSBoYWlyIGNhbiBibG93")))
    (let ((bv-secret (bv-from-b64 (elt lst-secrets (random (length lst-secrets))))))
      (bv-aes-cbc-encrypt bv-secret bv-iv bv-key))))

(defun ch17-oracle (bv-msg bv-iv bv-key)
  (let ((res (bv-aes-cbc-decrypt bv-msg bv-iv bv-key)))
    (if res
	t
	'nil)))

(defun ch17-crack ()
  (with-cbc-keys (bv-iv bv-key)
    (let ((blocks (subdivide (ch17-encrypt bv-iv bv-key) 16)))
      (iterate (for bv-cur-block in blocks)
	       (for bv-cur-iv previous bv-cur-block initially bv-iv)
	       (collecting (bv-cbc-padding-block bv-cur-block bv-cur-iv bv-key)
			   into lst-res)
	       (finally (return (s-from-bv (bv-pkcs7-unpad (apply #'v-cat lst-res) 16))))))))

(defun bv-cbc-padding-block (bv-block bv-iv bv-key)
  (iterate (for i from 1 to 16)
	   (with bv-mask-suffix = #())
	   (for by-cur =
		(iterate (for n from 0 to 255)
			 (for bv-xor-mask = (v-cat
							 (bv-make (- 16 i) 0)
							 #(n)
							 bv-mask-suffix))
			 (until (ch17-oracle (v-cat bv-xor-mask bv-block)
					     bv-iv
					     bv-key))
			 (finally (return (logxor n i (elt bv-iv (- 16 i)))))))
	   (collecting by-cur into bv-res at beginning result-type 'vector)
	   (after-each (setf bv-mask-suffix (bv-xor (bv-xor (subseq bv-iv (- 16 i))
							    bv-res)
						    (bv-make i (+ i 1)))))
	   (finally (return bv-res))))

(eval-when (:execute)
  (print (ch17-crack)))

;18. Implement CTR, the stream cipher mode

(defun bv-aes-ctr-encrypt (bv-msg bv-nonce bv-key)
  (iterate (for i from 0 to (ceiling (length bv-msg) 16))
	   (for bv-counter = (bv-from-in i))
	   (for bv-nonce-counter = (v-cat bv-nonce
					   bv-counter
					   (bv-make (- 8 (length bv-counter)))))
	   (collecting (bv-aes-encrypt bv-nonce-counter bv-key) into lst-res)
	   (finally (return (bv-xor bv-msg (apply #'v-cat lst-res))))))

(defun s-aes-ctr-encrypt (s-msg s-nonce s-key)
  (let ((bv-msg (bv-from-s s-msg))
	(bv-nonce (bv-from-s s-nonce))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-aes-ctr-encrypt bv-msg bv-nonce bv-key))))

(is (s-aes-ctr-encrypt (s-from-b64 "L77na/nrFsKvynd6HzOoG7GHTLXsTVu9qvY/2syLXzhPweyyMTJULu/6/kXX0KSvoOLSFQ==")
			  (s-from-bv (bv-make 8 0))
			  "YELLOW SUBMARINE")
    "Yo, VIP Let's kick it Ice, Ice, baby Ice, Ice, baby ")

;19. Break fixed-nonce CTR mode using substitions

;I'm skipping this challenge because it's explicitly not meant to be automated, the solution
;would be an Excel file

;20. Break fixed-nonce CTR statistically

;this is almost the same problem as challenge 6.  In particular, if one truncates each
;ciphertext to the length of the shortest ciphertext, and then concatenates everything,
;this is exactly the same as #6.

(defun ch20-crack (file-name)
  (let ((lst-ctexts (butlast (map #'bv-from-b64 (split #\Newline (read-file-into-string file-name))))))
    (let* ((min-len (apply #'min (map #'length lst-ctexts)))
	   (lst-truncated (map (lm (vec) (subseq vec 0 min-len)) lst-ctexts)))
      (subdivide (s-from-bv (bv-find-repeat-key (apply #'concatenate 'vector lst-truncated)))
		 min-len))))

(eval-when (:execute)
  (print (ch20-crack "/home/adminuser/20.txt")))

;21. Implement the MT19937 Mersenne Twister RNG

(defun MT-init (seed)
  ;returns a closure
  (let ((u32v-state (make-array 624 :element-type '(unsigned-byte 32)))
	(u32-and-mask (- (expt 2 32) 1)))
    (iterate (for i from 0 to 623)
	     (for u32-cur first seed then
		  (logand u32-and-mask
			  (+ (* 1812433253
				(logxor u32-cur
					(ash u32-cur 30)))
			     i)))
	     (after-each (setf (elt u32v-state i) u32-cur)))
    (MT-extract-closure u32v-state)))

(defun MT-extract-closure (u32v-state)
    (let ((index 0))
      (lambda ()
	;this is the extract number function from the Wikipedia entry for the Mersenne Twister
	(if (= index 0)
	    (setf u32v-state (u32v-MT-generate-array u32v-state)))
	(let ((u32-res (u32-MT-temper (elt u32v-state index))))
	  (setf index (mod (+ index 1) 624))
	  u32-res))))

(defun u32v-MT-generate-array (u32v-state)
  (iterate (for i from 0 to 623)
	   (for y = (+ (ldb (byte 1 31) (elt u32v-state i))
		       (ldb (byte 31 0) (elt u32v-state (mod (+ i 1) 624)))))
	   (after-each (setf (elt u32v-state i) (logxor (elt u32v-state (mod (+ i 397) 624))
							(ash y -1))))
	   (after-each (if (oddp y)
			   (setf (elt u32v-state i) (logxor (elt u32v-state i) 2567483615))))
	   (finally (return u32v-state))))

(defun u32-MT-temper (u32)
  (setf u32 (logxor u32 (ash u32 -11))
	u32 (logxor u32 (logand (ash u32 7) 2636928640))
	u32 (logxor u32 (logand (ash u32 15) 4022730752))
	u32 (logxor u32 (ash u32 -18)))
  u32)

(is (funcall (MT-init 1))
    2724652974)

;22. Crack an MT19937 seed

(defun ch22-seed ()
  (print "ch22 seed")
  (sleep (+ 40 (random 960)))
  (let ((rng (MT-init (get-universal-time))))
    (sleep (+ 40 (random 960)))
    (list (funcall rng) (funcall rng))))

(defun ch22-crack (u32)
  (iterate (for i downfrom (get-universal-time))
	   (for rng = (MT-init i))
	   (until (= (funcall rng)
		     u32))
	   (finally (return rng))))

(eval-when (:execute)
  (let* ((lst (ch22-seed))
	 (first (car lst))
	 (second (cadr lst))
	 (rng (ch22-crack first)))
    (is (funcall rng)
	second)))

;23. Clone an MT19937 RNG from its output

(defun u32-un-right-shift (u32 shift)
  (iterate (for i from 31 downto 0)
	   (for bit = (ldb (byte 1 i) u32))
	   (with u32-res = 0)
	   (after-each (if (> i (- 32 shift))
			   (setf u32-res (dpb bit (byte 1 i) u32-res))
			   (setf u32-res (dpb (logxor bit
						  (ldb (byte 1 (+ i shift)) u32-res))
					      (byte 1 i)
					      u32-res))))
	   (finally (return u32-res))))

(defun u32-un-left-shift (u32 shift u32-magic-num)
  (iterate (for i from 0 to 31)
	   (for bit = (ldb (byte 1 i) u32))
	   (with u32-res = 0)
	   (after-each (if (< i shift)
			   (setf u32-res (dpb bit (byte 1 i) u32-res))
			   (setf u32-res (dpb (logxor bit
						  (logand (ldb (byte 1 (- i shift)) u32-res)
							  (ldb (byte 1 i) u32-magic-num)))
					  (byte 1 i)
					  u32-res))))
	   (finally (return u32-res))))

(defun u32-MT-untemper (u32)
  (setf u32 (u32-un-right-shift u32 18)
	u32 (u32-un-left-shift u32 15 4022730752)
	u32 (u32-un-left-shift u32 7 2636928640)
	u32 (u32-un-right-shift u32 11))
  u32)

(let ((u32 (random (expt 2 32))))
  (is (logxor (u32-MT-untemper (u32-MT-temper u32))
	      u32)
      0))

(defun MT-clone (u32v-input)
  (let ((u32v-state (iterate (for u32-cur in-vector u32v-input)
			     (collecting (u32-MT-untemper u32-cur) result-type 'vector))))
    (MT-extract-closure u32v-state)))

(let ((orig-MT (MT-init (random (expt 2 32)))))
  (let* ((u32v-output (iterate (repeat 624)
			       (for u32-cur = (funcall orig-MT))
			       (collecting u32-cur result-type 'vector)))
	 (clone-MT (MT-clone u32v-output)))
    (is (funcall clone-MT)
	(funcall orig-MT))))

;24. Create the MT19937 stream cipher and break it

;note that while this uses a 16bit key, and is therefore trivially breakable on my laptop,
;MT19937 only admits a 32bit seed, which is still easy to brute force.

(defun bv-MT-encrypt (bv-msg u32-key)
  (let ((rng (MT-init u32-key)))
    (iterate (for bv-cur-msg in (subdivide bv-msg 4))
	     (for bv-cur-key next (bv-from-in (funcall rng)))
	     (collecting (bv-xor bv-cur-msg bv-cur-key) into lst-res)
	     (finally (return (apply #'v-cat lst-res))))))

(let ((bv-test (bv-rand 10))
      (u32-key (random (expt 2 32))))
  (ok (equalp  (bv-MT-encrypt (bv-MT-encrypt bv-test u32-key) u32-key)
	       bv-test)
      "bv-MT-encrypt"))

(defun ch24-encrypt ()
  (let ((u32-key (random (expt 2 16)))
	(bv-msg (v-cat (bv-rand (+ 50 (random 100))) (bv-make 16 65))))
    (values (bv-MT-encrypt bv-msg u32-key) u32-key)))

(defun n-last (seq n)
  (subseq seq (- (length seq) n)))

(defun ch24-crack (bv-ctext)
  (iterate (for u32-cand-key from 0 to (expt 2 16))
	   (for bv-cand-ptext = (bv-MT-encrypt bv-ctext u32-cand-key))
	   (until (equalp (n-last bv-cand-ptext 16) (bv-make 16 65)))
	   (finally (return u32-cand-key))))

(multiple-value-bind (bv-ctext u32-key) (ch24-encrypt)
  (is (ch24-crack bv-ctext)
      u32-key))

;this file is a re-write of my solutions to www.cryptopals.com, trying out cl21 and apps hungarian notation

(eval-when (:execute)
  (ql-dist:install-dist "http://dists.cl21.org/cl21.txt"))

(eval-when (:compile-toplevel :execute)
  (ql:quickload :cl21)
  (ql:quickload :cl-test-more)
  (ql:quickload "ironclad")
  (ql:quickload "hunchentoot")
  (ql:quickload :drakma)
  (ql:quickload :iterate))

(in-package :cl21-user)
(defpackage cryptopals
  (:use :cl21
	:cl-test-more
	:iterate)
  (:shadowing-import-from :iterate :until)
  (:shadowing-import-from :iterate :while))
(in-package :cryptopals)

#|prefixes:
bv  -  byte vector
in  -  int
s   -  string
hs  -  hex string (eg, "12ef" for #x12ef)
hc  -  hex char
b64 -  base64 encoded data, represented as a string
cb  -  count of bytes
by  -  byte
?   -  boolean predicate

|#

;some utility functions
(defun bv-make (cb-length &optional by-initial-element)
  (if by-initial-element
      (make-array cb-length :element-type '(unsigned-byte 8) :initial-element by-initial-element)
      (make-array cb-length :element-type '(unsigned-byte 8) :initial-element 0)))

(defun bv-rand (cb-length)
  (ironclad:make-random-salt cb-length))

(defun bv-pad (bv padded-len)
  (concatenate 'vector (bv-make (- padded-len (length bv))) bv))

(defun bv-cat (&rest args)
  (apply #'concatenate 'vector args))

(defun bv-from-in (in)
   (iterate (for i first in then (/ (- i (mod i 256)) 256))
	    (while (>= i 1))
	    (with res = #())
	    (after-each (push (mod i 256) res))
	    (finally (return (nreverse res)))))

(defun bv-from-s (s)
  (map-to 'vector #'char-code s))

(defun bv-from-hs (hs)
  (let ((nibbles (map-to 'vector #'in-from-hc hs)))
    (let ((pairs (nreverse (subdivide (nreverse nibbles) 2)))) ;to handle odd lengths correctly
      (map-to 'vector (lm (pair) (+ (* 16 (second pair)) (first pair)))
	      pairs))))

(defun in-combine-bytes (high low bit-len)
  (+ (* high (expt 2 bit-len)) low))

(defun in-from-bv (bv)
  (reduce (lm (x y) (in-combine-bytes x y 8)) bv))

(defun in-from-s (s)
  (in-from-bv (bv-from-s s)))

(defun in-from-hc (hc)
  (let ((index "0123456789abcdef")
	(hc-dc (char-downcase hc)))
    (position hc-dc index)))

(defun in-from-hs (hs)
  (in-from-bv (bv-from-hs hs)))

(defun s-from-in (in)
  (s-from-bv (bv-from-in in)))

(defun s-from-bv (bv)
  (map-to 'string #'code-char bv))

(defun s-from-hs (hs)
  (s-from-bv (bv-from-hs hs)))

(defun s-from-seq (seq)
  (with-output-to-string (s)
    (doeach (x seq)
      (princ x s))))

(defun s-make (len &optional (c-initial-element #\a))
  (map-to 'string #'code-char (bv-make len (char-code c-initial-element))))

(defun s-cat (&rest args)
  (apply #'concatenate 'string args))

(defun hs-from-by (by)
  (let ((index "0123456789abcdef")
	(high (floor (/ by 16)))
	(low (mod by 16)))
    (format nil "~{~A~}" (list (getf index high) (getf index low)))))

(defun hs-from-bv (bv)
  (reduce (lm (x y) (s-cat x y))
	  (map-to 'list #'hs-from-by bv)))

(defun hs-from-in (in)
  (hs-from-bv (bv-from-in in)))

(defun hs-from-s (s)
  (hs-from-bv (bv-from-s s)))

;conversion function tests
(ok (equalp (bv-pad #(1 2) 3) #(0 1 2))
    "bv-pad")
(ok (equalp (bv-from-in 258) #(1 2))
    "bv-from-in 1")
(ok (equalp (bv-from-in 123) #(123))
    "bv-from-in 2")
(ok (equalp (bv-from-s "ab") #((char-code #\a) (char-code #\b)))
    "bv-from-s")
(is (in-from-bv #(1 2)) 258)
(is (in-from-hc #\a) 10)
(is (in-from-hs "BC614e") 12345678)
(is (s-from-seq '(#\a #\b #\c #\d #\e #\f)) "abcdef")
(is (s-from-seq #(#\a #\b #\c #\d #\e #\f)) "abcdef")
(is (hs-from-by 255) "ff")
(is (hs-from-bv #(255 0)) "ff00")
(is (s-from-in (+ (* 97 256) 98)) "ab")

;set 1

;1. Convert hex to base64 encoding.  Base64 will be represented as a string in all future cases in this file

(defun mod-remainder (num div)
  (if (= (mod num div) 0)
      0
      (- div (mod num div))))

(defun b64c-from-6bits (n)
  (let ((base64-index "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))
        (getf base64-index n)))

(defun b64-from-3bytes (bv)
  (let ((len-pad (mod-remainder (length bv) 3)))
    (let ((in-padded (in-from-bv (bv-cat bv (bv-make len-pad))))
	  (s-padding (s-from-bv (bv-make len-pad 61))))
	(iterate (for offset in '(0 6 12 18))
		 (for cur-bits = (ldb (byte 6 offset) in-padded))
		 (collecting (b64c-from-6bits cur-bits) into l-res)
		 (finally (return (s-cat
					       (subseq (s-from-seq (nreverse l-res))
						       0
						       (- 4 len-pad))
					       s-padding)))))))

(defun b64-from-bv (bv)
  (s-from-seq (map #'b64-from-3bytes (subdivide bv 3))))

(defun b64-from-hs (hs)
  (b64-from-bv (bv-from-hs hs)))

(defun b64-from-s (s)
  (b64-from-bv (bv-from-s s)))

(defun b64-from-in (in)
  (b64-from-bv (bv-from-in in)))

(is (b64-from-s "l pleasure.") "bCBwbGVhc3VyZS4=")

(defun 6bits-from-b64c (b64c)
  (position b64c "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))

(defun 3bv-from-b64 (b64)
  (let ((len-pad 0))
    (cond ((equalp (getf b64 2) #\=) (setf len-pad 2))
	  ((equalp (getf b64 3) #\=) (setf len-pad 1)))
    (let ((b64-padding (s-make len-pad #\A))
	  (b64-without-pad (subseq b64 0 (- 4 len-pad))))
      (let ((in-total (reduce (lm (high low) (in-combine-bytes high low 6))
			      (map-to 'vector #'6bits-from-b64c (s-cat b64-without-pad b64-padding)))))
	(subseq (bv-pad (bv-from-in in-total) 3) 0 (- 3 len-pad))))))

(defun bv-from-b64 (b64)
  (reduce #'append (map-to 'vector #'3bv-from-b64 (subdivide b64 4))))

(defun in-from-b64 (b64)
  (in-from-bv (bv-from-b64 b64)))

(defun s-from-b64 (b64)
  (s-from-bv (bv-from-b64 b64)))

(defun hs-from-b64 (b64)
  (hs-from-bv (bv-from-b64 b64)))

(defun bv-from-b64-file (file-name)
  (bv-from-b64 (remove #\Newline (remove #\Return (read-file-into-string file-name)))))

(is (b64-from-hs "49276d206b696c6c696e6720796f757220627261696e206c696b65206120706f69736f6e6f7573206d757368726f6f6d")
    "SSdtIGtpbGxpbmcgeW91ciBicmFpbiBsaWtlIGEgcG9pc29ub3VzIG11c2hyb29t")

;2. Fixed XOR

;(int-to-hex-string (hex-string-xor "1c0111001f010100061a024b53535009181c" "686974207468652062756c6c277320657965"))

;output: "746865206b696420646f6e277420706c6179"

(defun bv-xor (bv1 bv2)
  (map-to 'vector #'logxor bv1 bv2))

(defun hs-xor (hs1 hs2)
  (hs-from-bv (bv-xor (bv-from-hs hs1) (bv-from-hs hs2))))

(defun s-xor (s1 s2)
  (s-from-bv (bv-xor (bv-from-s s1) (bv-from-s s2))))

(defun int-xor (&rest ints)
  (apply #'logxor ints))

(is (hs-xor "1c0111001f010100061a024b53535009181c" "686974207468652062756c6c277320657965")
    "746865206b696420646f6e277420706c6179")

;3. Single-character XOR Cipher:

;frequency table derived from http://www.data-compression.com/english.html
(defvar *frequency-table* #H(#\a .0651738 #\b .0124248 #\c .0217339 #\d .0349835 #\e .1041442 #\f .0197881 #\g .0158610 #\h .049288 #\i .0558094 #\j .0009033 #\k .0050529 #\l .0331490 #\m .0202124 #\n .0564513 #\o .0596302 #\p .0137645 #\q .0008606 #\r .0497563 #\s .0515760 #\t .0729357 #\u .0225134 #\v .0082903 #\w .0171272 #\x .0013692 #\y .0145984 #\z .0007836 #\  .1918182 #\newline .01 #\Return .01 #\' .01 #\. .01 #\" .01 #\, .01 #\0 .001 #\1 .001 #\2 .001 #\3 .001 #\4 .001 #\5 .001 #\6 .001 #\7 .001 #\8 .001 #\9 .001))

#|
;frequency table derived from Vanilla Ice lyrics
(defvar *frequency-table* #H(#\! 1/3101 #\1 1/3101 #\0 1/3101 #\. 2/3101 #\5 1/3101 #\z 3/3101 #\q 2/3101 #\j 13/3101 #\- 2/3101 #\x 4/3101 #\u 62/3101 #\? 3/3101 #\f 29/3101 #\m 66/3101 #\w 6/443 #\d 11/443 #\n 137/3101 #\h 109/3101 #\g 51/3101 #\r 78/3101 #\a 204/3101 #\b 76/3101 #\c 107/3101 #\k 47/3101 #\s 110/3101 #\' 33/3101 #\t 173/3101 #\e 257/3101 #\l 151/3101 #\Newline 110/3101 #\p 47/3101 #\i 207/3101 #\v 36/3101 #\  526/3101 #\, 72/3101 #\o 179/3101 #\y 82/3101))
|#

(defun ft-from-string (s)
  (let ((ft #H()))
    (doeach (chr s)
      (inc-hash ft (char-downcase chr)))
    (ft-normalize-hash ft)))

(defun ft-from-file (file)
  (let ((s (read-file-into-string file)))
    (ft-from-string s)))

(defun ft-from-bv (bv)
  (ft-from-string (s-from-bv bv)))

(defun inc-hash (table key)
  (let ((?-exists (nth-value 1 (getf table key))))
    (if ?-exists
        (incf (getf table key))
      (setf (getf table key) 1))))

(defun ft-normalize-hash (ft)
  (let ((sum (reduce #'+ (map-to 'list #'cdr ft))))
    (doeach ((key val) ft)
      (setf (getf ft key) (/ val sum)))
    ft))

(defun fl-frequency-compare (ft-test ft-ref)
  (let ((res 0))
    (doeach ((key val) ft-test res)
      (if (getf ft-ref key)
	  (incf res (expt (abs (- val (getf ft-ref key))) 5))
	  (incf res 100)))))

(defun bv-xor-with-byte (bv by)
  (map (lm (x) (logxor x by)) bv))

(defun xor-crack (bv-ciphertext ft-ref)
  (let ((res (list "default result" 0 1000)))
    (doeach (x (iota 256) res)
      (let ((cand (fl-frequency-compare (ft-from-bv (bv-xor-with-byte bv-ciphertext x))
					ft-ref)))
	(if (< cand (nth res 2))
	    (setf res (list (s-from-bv (bv-xor-with-byte bv-ciphertext x)) x cand)))))))

(is (nth (xor-crack (bv-from-hs "1b37373331363f78151b7f2b783431333d78397828372d363c78373e783a393b3736") *frequency-table*) 0)
    "Cooking MC's like a pound of bacon")

;4. Detect single-character XOR

(defun slist-from-file (file-name)
  (let ((s-file (read-file-into-string file-name)))
    (split #\newline s-file)))

(defun xor-find-crack (slist-cipher ft-ref)
  (let ((res (list "default result" 0 1000)) ;must match the layout of the output from xor-crack above
	(slist-plain (map (lm (x) (xor-crack (bv-from-hs x) ft-ref)) slist-cipher)))
    (doeach (x slist-plain res)
      (if (< (nth x 2) (nth res 2))
		 (setf res x)))))

(defun file-xor-find-crack (file-name ft-ref)
  (nth (xor-find-crack (slist-from-file file-name) ft-ref) 0))

(ok (equalp (file-xor-find-crack "/home/adminuser/4.txt" *frequency-table*)
	    "Now that the party is jumping\n")
    "file-xor-find-crack")

;5. Repeating-key XOR Cipher

(defun repeated-key-xor (bv-plain bv-key)
  (let ((bv-split (subdivide bv-plain (length bv-key))))
    (apply #'append (map-to 'list (lm (x) (bv-xor x bv-key)) bv-split))))

(is (hs-from-bv (repeated-key-xor (bv-from-s "Burning 'em, if you ain't quick and nimble I go crazy when I hear a cymbal")
				  (bv-from-s "ICE")))
    "0b3637272a2b2e63622c2e69692a23693a2a3c6324202d623d63343c2a26226324272765272a282b2f20690a652e2c652a3124333a653e2b2027630c692b20283165286326302e27282f")

;6. Break repeating-key XOR:

;(file-xor-crack "c:\\temp\\xor.txt" dict)

;outputs "Terminator X: Bring the noise" as the key, and some terrible vanila ice song as the plain text.

(defun in-bit-distance (in1 in2)
  (expt (logcount (logxor in1 in2)) 1))

(defun fl-bit-distance (bv1 bv2)
  (/ (reduce #'+ (map-to 'vector #'in-bit-distance bv1 bv2))
     (length bv1)))

(is (fl-bit-distance (bv-from-s "this is a test") (bv-from-s "wokka wokka!!!")) 37/14)

(is (fl-bit-distance #(2 4 8) #(3 5 9)) 1)
(is (fl-bit-distance #(2 4) #(3 5)) 1)

(defun map-pairs (fn seq)
  ;todo:  make this a generic function or something, so that the output type matches the
  ;       input type, instead of always outputing a list
  (iterate (repeat (- (length seq) 1))
	   (for elem first (first seq) then (first rest))
	   (for rest first (subseq seq 1) then (subseq rest 1))
	   (appending (map-to 'list (lm (x) (funcall fn x elem)) rest))))

(is (map-pairs #'+ '(1 2 3 4)) '(3 4 5 5 6 7))
(is (map-pairs #'+ #(1 2 3 4)) '(3 4 5 5 6 7))

(defun fact (in)
  (reduce #'* (iota in :start 1)))

(is (fact 1) 1)
(is (fact 5) 120)

(defun n-choose-r (n r)
  (/ (fact n) (* (fact r) (fact (- n r)))))

(is (n-choose-r 6 2) 15)

(defun lst-xor-block-size (bv-cipher max-size)
  (let ((lens (iota max-size :start 1)))
    (let ((cands (map (lm (x) (xor-block-size-helper bv-cipher x))
		      lens)))
      (take 15 (sort cands (lm (pair1 pair2) (< (cdr pair1) (cdr pair2))))))))

(defun xor-block-size-helper (bv-cipher len)
  (let ((blocks (subdivide bv-cipher len)))
    (cons len
	  (/ (reduce #'+ (map-pairs #'fl-bit-distance blocks))
	     (n-choose-r (length blocks) 2)))))

(defun lst-block-transpose (bv block-len)
  (let ((res '())
	(blocks (subdivide bv block-len)))
    (doeach (i (iota block-len) res)
      (push (map-to 'vector (lm (x) (if (< i (length x)) (elt x i) 0)) blocks) res))
    (nreverse res)))

(ok (equalp (lst-block-transpose #(1 2 3 4 5 6 7 8) 2)
	    (list (vector 1 3 5 7) (vector 2 4 6 8)))
    "lst-block-transpose")

(defun bv-find-repeat-key (bv-cipher)
 (let* ((block-lens (map #'car (lst-xor-block-size bv-cipher 50)))
	(lst-transposes (map (lm (x) (lst-block-transpose bv-cipher x)) block-lens)))
  (let* ((lst-keys (map (lm (transpose) (map-to 'vector (lm (bv) (elt (xor-crack bv *frequency-table*) 1))
						transpose))
			lst-transposes))
	 (lst-bvs (map (lm (key) (repeated-key-xor bv-cipher key))
		       lst-keys)))
    (car (sort lst-bvs (lm (bv1 bv2) (< (fl-frequency-compare (ft-from-bv bv1) *frequency-table*)
					(fl-frequency-compare (ft-from-bv bv2) *frequency-table*))))))))

(defun s-file-find-repeat-key (filename)
  (s-from-bv (bv-find-repeat-key (bv-from-b64-file filename))))

(eval-when (:execute)
  (print (s-file-find-repeat-key "c:\\temp\\xor.txt")))

(eval-when (:execute)
  (print (s-file-find-repeat-key "/home/adminuser/6.txt")))

;7. AES in ECB mode:

(defun bv-AES-encrypt (bv-msg bv-key)
  (let ((bv-res (bv-make (length bv-msg)))
	(cipher (ironclad:make-cipher :AES :mode :ECB :key (coerce bv-key '(vector (unsigned-byte 8))))))
    (ironclad:encrypt cipher (coerce bv-msg '(vector (unsigned-byte 8))) bv-res)
    bv-res))

(defun bv-AES-decrypt (bv-msg bv-key)
  (let ((bv-res (bv-make (length bv-msg)))
	(cipher (ironclad:make-cipher :AES :mode :ECB :key (coerce bv-key '(vector (unsigned-byte 8))))))
    (ironclad:decrypt cipher (coerce bv-msg '(vector (unsigned-byte 8))) bv-res)
    bv-res))

(defun s-AES-encrypt (s-msg s-key)
  (let ((bv-msg (bv-from-s s-msg))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-aes-encrypt bv-msg bv-key))))

(defun s-AES-decrypt (s-msg s-key)
  (let ((bv-msg (bv-from-s s-msg))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-aes-decrypt bv-msg bv-key))))

(defun bv-file-aes-encrypt (file-name bv-key)
  (let ((bv-msg (bv-from-s (read-file-into-string file-name))))
    (bv-aes-encrypt bv-msg bv-key)))

(defun bv-file-aes-decrypt (file-name bv-key)
  (let ((bv-msg (bv-from-s (read-file-into-string file-name))))
    (bv-aes-decrypt bv-msg bv-key)))

(defun s-file-aes-encrypt (file-name s-key)
  (let ((bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-encrypt file-name bv-key))))

(defun s-file-aes-decrypt (file-name s-key)
  (let ((bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-decrypt file-name bv-key))))

(eval-when (:execute)
  (print (s-from-bv (bv-aes-decrypt (bv-from-b64-file "/home/adminuser/7.txt") (bv-from-s "YELLOW SUBMARINE")))))

;8. Detect AES in ECB mode

;this is easy.  The only distinguishing fact about ECB is that identical blocks give identical encryption, so look for identical blocks

(defun bv-find-duplicate-blocks (lst-bvs cb-len)
  (let ((lst-blocks (map (lm (bv) (subdivide bv cb-len)) lst-bvs))
	(res #()))
    (doeach (blocks lst-blocks res)
      (if (not (= (reduce #'+ (map-pairs #'fl-bit-distance blocks)) 0))
	  (setf res (apply #'bv-cat blocks))))))

(defun bv-file-find-duplicate-blocks (file-name cb-len)
  (let* ((lst-hs (split #\newline (read-file-into-string file-name)))
	 (lst-bvs (map #'bv-from-hs lst-hs)))
    (bv-find-duplicate-blocks lst-bvs cb-len)))

(eval-when (:execute)
  (print (bv-file-find-duplicate-blocks "/home/adminuser/8.txt" 16)))

;problems from set 2

;9. Implement PKCS#7 padding

(defun bv-pkcs7-pad (bv cb-block-len)
  ;gives a full block of padding for even multiples of the block length
  (let ((cb-padding-len (- cb-block-len (mod (length bv) cb-block-len))))
    (bv-cat bv (make-array cb-padding-len :initial-element cb-padding-len))))

(ok (equalp (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 20)
	    #(89 69 76 76 79 87 32 83 85 66 77 65 82 73 78 69 4 4 4 4))
    "bv-pkcs7-pad 1")

(ok (equalp (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 16)
	       #(89 69 76 76 79 87 32 83 85 66 77 65 82 73 78 69 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16))
    "bv-pkcs7-pad 2")

;this is nominally challenge 15, but using it makes #13 easier to implement, so I'm writing it now
(defun bv-pkcs7-unpad (bv cb-block-len)
  ;returns nil for invalid padding
  (iterate (for i from 1)
	   (until (equalp (subseq bv (- (length bv) i)) (bv-make i i)))
	   (until (> i cb-block-len))
	   (finally (if (<= i cb-block-len)
			(return (subseq bv 0 (- (length bv) i)))
			(return 'nil)))))

(ok (equalp (bv-pkcs7-unpad (bv-pkcs7-pad (bv-from-s "YELLOW SUBMARINE") 20) 20)
	    (bv-from-s "YELLOW SUBMARINE"))
    "bv-pkcs7-unpad 1")

(ok (equalp (bv-pkcs7-unpad #(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16) 16)
	    'nil)
    "bv-pkcs7-unpad 2")

(defun bv-aes-pkcs7-encrypt (bv-msg bv-key)
  (bv-aes-encrypt (bv-pkcs7-pad bv-msg 16) bv-key))

(defun bv-aes-pkcs7-decrypt (bv-msg bv-key)
  (bv-aes-decrypt (bv-pkcs7-unpad bv-msg 16) bv-key))

;10. Implement CBC Mode

(defun bv-aes-cbc-encrypt (bv-msg bv-iv bv-key)
  (let* ((bv-padded (bv-pkcs7-pad bv-msg 16))
	 (blocks (subdivide bv-padded 16))
	 (res (iterate (for next in blocks)
		       (for prev previous ctext initially bv-iv)
		       (for ctext = (bv-aes-encrypt (bv-xor prev next) bv-key))
		       (collecting ctext))))
    (apply #'bv-cat res)))

(defun bv-aes-cbc-decrypt (bv-msg bv-iv bv-key)
  (let* ((blocks (subdivide bv-msg 16))
	 (res (iterate (for next in blocks)
		       (for prev previous next initially bv-iv)
		       (collecting (bv-xor (bv-aes-decrypt next bv-key) prev)))))
    (bv-pkcs7-unpad (apply #'bv-cat res) 16)))

(defun bv-file-aes-cbc-encrypt (file-name bv-iv bv-key)
  (let ((bv-msg (bv-from-b64-file file-name)))
    (bv-aes-cbc-encrypt bv-msg bv-iv bv-key)))

(defun s-file-aes-cbc-encrypt (file-name s-iv s-key)
  (let ((bv-iv (bv-from-s s-iv))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-cbc-encrypt file-name bv-iv bv-key))))

(defun bv-file-aes-cbc-decrypt (file-name bv-iv bv-key)
  (let ((bv-msg (bv-from-b64-file file-name)))
    (bv-aes-cbc-decrypt bv-msg bv-iv bv-key)))

(defun s-file-aes-cbc-decrypt (file-name s-iv s-key)
  (let ((bv-iv (bv-from-s s-iv))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-file-aes-cbc-decrypt file-name bv-iv bv-key))))

(ok (equalp (let ((bv-msg (bv-make 48 65))
		  (bv-key (bv-rand 16))
		  (bv-iv (bv-rand 16)))
	      (bv-aes-cbc-decrypt (bv-aes-cbc-encrypt bv-msg bv-iv bv-key) bv-iv bv-key))
	    (bv-make 48 65))
    "bv-aes-cbc-encrypt/decrypt")

;11. An ECB/CBC detection oracle

;This is also easy:  just send a long repeated string as input, check for repeats in the output

(defmacro with-cbc-keys ((sym-iv sym-key) &body body)
  `(let ((,sym-iv (bv-rand 16))
	 (,sym-key (bv-rand 16)))
     ,@body))

(defun ch11-oracle (bv-msg)
  (let ((bv-pre-pad (bv-rand (+ 5 (random 6))))
	(bv-post-pad (bv-rand (+ 5 (random 6)))))
    (with-cbc-keys (bv-iv bv-key)
      (let ((bv-padded (bv-cat bv-pre-pad bv-msg bv-post-pad)))
	(if (= (random 2) 0)
	    (progn (print "cbc")
		   (bv-aes-cbc-encrypt bv-padded bv-iv bv-key))
	    (progn (print "ecb")
		   (bv-aes-encrypt bv-padded bv-key)))))))

(defun ?-duplicate-blocks (blocks)
  (some (lm (x) (= x 0)) (map-pairs #'fl-bit-distance blocks)))

(defun ch11-crack ()
  (let* ((bv-msg (bv-make 48 65))
	 (bv-res (coerce (ch11-oracle bv-msg) '(and common-lisp:vector (not simple-array))))
	 (blocks (subdivide bv-res 16)))
    (if (?-duplicate-blocks blocks)
	"ecb"
	"cbc")))

(print (ch11-crack))

;12. Byte-at-a-time ECB decryption (Simple)

(defun ch12-oracle (bv-msg)
  (let ((bv-post-pad (bv-rand (+ 5 (random 6))))
	(bv-secret (bv-from-b64 "Um9sbGluJyBpbiBteSA1LjAKV2l0aCBteSByYWctdG9wIGRvd24gc28gbXkgaGFpciBjYW4gYmxvdwpUaGUgZ2lybGllcyBvbiBzdGFuZGJ5IHdhdmluZyBqdXN0IHRvIHNheSBoaQpEaWQgeW91IHN0b3A/IE5vLCBJIGp1c3QgZHJvdmUgYnkK"))
	(bv-key (bv-rand 16)))
    (bv-aes-encrypt (bv-pkcs7-pad (bv-cat bv-msg bv-secret bv-post-pad) 16) bv-key)))

(defun ch12-crack ()
  (let ((bv-res #()))
    (iterate (for i upfrom 1)
	     (for cb-offset = (- 16 (mod i 16)))
	     (for bv-offset = (bv-make cb-offset))
	     (for bv-prefix first (bv-make 15) then (bv-cat (subseq bv-prefix 1) (vector by-res)))
	     (for by-res = (iterate (for i from 0 to 255)
				    (for bv-msg = (bv-cat bv-prefix (vector i) bv-offset))
				    (for bv-oracle-output = (ch12-oracle bv-msg))
				    (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
				    (finally (return i))))
	     (until (= by-res 256))
	     (after-each (push by-res bv-res))
	     (finally (return (s-from-bv bv-res))))))

(eval-when (:execute)
  (print (ch12-crack)))

;13.  ECB cut-and-paste

(defun ch13-parse (s-cookie)
  (let* ((s-pairs (split #\& s-cookie))
	 ;map doesn't work here, seems to give a list with slightly incorrect structure
	 (s-keys-vals (iterate (for s in s-pairs)
			       (appending (split #\= s)))))
    (apply #'hash-table #'equal s-keys-vals)))

(defun ch13-make-profile (s-email)
  (let ((s-stripped (remove #\= (remove #\& s-email))))
    #"email=${s-stripped}&uid=10&role=user"))

(is (ch13-make-profile "foo@bar.com") "email=foo@bar.com&uid=10&role=user")

(defun ch13-test (bv-ctext bv-key)
  (let* ((s-cookie (s-from-bv (bv-pkcs7-unpad (bv-aes-decrypt bv-ctext bv-key) 16)))
	 (profile-table (ch13-parse s-cookie)))
    (if (equal (getf profile-table "role") "admin")
	"victory"
	"failure")))

(is (ch13-test (bv-aes-encrypt (bv-pkcs7-pad (bv-from-s "email=foo@bar.com&uid=10&role=admin") 16)
			       (bv-make 16)) (bv-make 16))
    "victory")

(defun ch13-enc-profile (s-email bv-key)
  (bv-aes-pkcs7-encrypt (bv-from-s (ch13-make-profile s-email)) bv-key))

(defun ch13-crack ()
  (let ((bv-key (bv-rand 16)))
    (let ((bv-padding (last (subdivide (ch13-enc-profile "fo@ba.com" bv-key) 16))) ;encryption of 16 16's
	  (bv-email (subseq (ch13-enc-profile "bcobu@foo.com" bv-key) 0 32))
	  (bv-admin (elt (subdivide (ch13-enc-profile "foo@bar.coadmin" bv-key) 16) 1)))
      (ch13-test (bv-cat bv-email bv-admin bv-padding) bv-key))))

(is (ch13-crack)
    "victory")

;14. Byte-at-a-time ECB decryption (Harder)

;this is identical to #12, except that there's an initial step where we find the length of the 'random' prefix
(defvar *ch14-prefix-len* (+ 5 (random 6)))

(defun ch14-oracle (bv-msg)
  (let ((bv-pre-pad (bv-rand *ch14-prefix-len*))
	(bv-post-pad (bv-rand (+ 5 (random 6))))
	(bv-secret (bv-from-b64 "Um9sbGluJyBpbiBteSA1LjAKV2l0aCBteSByYWctdG9wIGRvd24gc28gbXkgaGFpciBjYW4gYmxvdwpUaGUgZ2lybGllcyBvbiBzdGFuZGJ5IHdhdmluZyBqdXN0IHRvIHNheSBoaQpEaWQgeW91IHN0b3A/IE5vLCBJIGp1c3QgZHJvdmUgYnkK"))
	(bv-key (bv-rand 16)))
    (bv-aes-encrypt (bv-pkcs7-pad (bv-cat bv-pre-pad bv-msg bv-secret bv-post-pad) 16) bv-key)))

(defun ch14-prefix-len ()
  (iterate (for i from 0 to 16)
	   (for bv-oracle-output = (ch14-oracle (bv-cat (bv-rand i) (bv-make 32))))
	   (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
	   (finally (return i))))

(defun ch14-crack ()
  (let ((bv-res #())
	(cb-prefix-len (ch14-prefix-len)))
    (iterate (for i upfrom 1)
	     (for cb-offset = (- 16 (mod i 16)))
	     (for bv-offset = (bv-make cb-offset))
	     (for bv-prefix first (bv-make (+ cb-prefix-len 15)) then (bv-cat (subseq bv-prefix 1) (vector by-res)))
	     (for by-res = (iterate (for i from 0 to 255)
				    (for bv-msg = (bv-cat bv-prefix (vector i) bv-offset))
				    (for bv-oracle-output = (ch14-oracle bv-msg))
				    (until (?-duplicate-blocks (subdivide bv-oracle-output 16)))
				    (finally (return i))))
	     (until (= by-res 256))
	     (after-each (push by-res bv-res))
	     (finally (return (s-from-bv bv-res))))))

(eval-when (:execute)
  (print (ch14-crack)))

;15. PKCS#7 padding validation

;implementing above under #9, because it's used in #13

;16. CBC bitflipping attacks

(defun ch16-encrypt (s-userdata bv-iv bv-key)
  (let ((s-stripped (remove #\= (remove #\; s-userdata)))
	(s-pre "comment1=cooking%20MCs;userdata=")
	(s-post ";comment2=%20like%20a%20pound%20of%20bacon"))
    (let ((bv-msg (bv-from-s (s-cat s-pre s-stripped s-post))))
      (bv-aes-cbc-encrypt bv-msg bv-iv bv-key))))

(defun ch16-check (bv-ctext bv-iv bv-key)
  (let ((s-ptext (s-from-bv (bv-aes-cbc-decrypt bv-ctext bv-iv bv-key))))
    (search";admin=true;" s-ptext)))

(defun ch16-crack ()
  (with-cbc-keys (bv-iv bv-key)
    (let* ((bv-userdata (bv-make 16 65))
	   (bv-ctext (ch16-encrypt (s-from-bv bv-userdata) bv-iv bv-key))
	   (bv-target (bv-from-s "a;admin=true;aaa"))
	   (bv-edit (bv-xor (bv-xor bv-userdata bv-target) (subseq bv-ctext 16 32))))
      (ch16-check bv-ctext bv-iv bv-key)
      (ch16-check (bv-cat (subseq bv-ctext 0 16) bv-edit (subseq bv-ctext 32))
		  bv-iv
		  bv-key))))

(ok (ch16-crack) "Challenge 16")

;problems from set 3

;17. CBC padding oracle

(defun ch17-encrypt (bv-iv bv-key)
  (let ((lst-secrets (list "MDAwMDAwTm93IHRoYXQgdGhlIHBhcnR5IGlzIGp1bXBpbmc="
			   "MDAwMDAxV2l0aCB0aGUgYmFzcyBraWNrZWQgaW4gYW5kIHRoZSBWZWdhJ3MgYXJlIHB1bXBpbic="
			   "MDAwMDAyUXVpY2sgdG8gdGhlIHBvaW50LCB0byB0aGUgcG9pbnQsIG5vIGZha2luZw=="
			   "MDAwMDAzQ29va2luZyBNQydzIGxpa2UgYSBwb3VuZCBvZiBiYWNvbg=="
			   "MDAwMDA0QnVybmluZyAnZW0sIGlmIHlvdSBhaW4ndCBxdWljayBhbmQgbmltYmxl"
			   "MDAwMDA1SSBnbyBjcmF6eSB3aGVuIEkgaGVhciBhIGN5bWJhbA=="
			   "MDAwMDA2QW5kIGEgaGlnaCBoYXQgd2l0aCBhIHNvdXBlZCB1cCB0ZW1wbw=="
			   "MDAwMDA3SSdtIG9uIGEgcm9sbCwgaXQncyB0aW1lIHRvIGdvIHNvbG8="
			   "MDAwMDA4b2xsaW4nIGluIG15IGZpdmUgcG9pbnQgb2g="
			   "MDAwMDA5aXRoIG15IHJhZy10b3AgZG93biBzbyBteSBoYWlyIGNhbiBibG93")))
    (let ((bv-secret (bv-from-b64 (elt lst-secrets (random (length lst-secrets))))))
      (bv-aes-cbc-encrypt bv-secret bv-iv bv-key))))

(defun ch17-oracle (bv-msg bv-iv bv-key)
  (let ((res (bv-aes-cbc-decrypt bv-msg bv-iv bv-key)))
    (if res
	t
	'nil)))

(defun ch17-crack ()
  (with-cbc-keys (bv-iv bv-key)
    (let ((blocks (subdivide (ch17-encrypt bv-iv bv-key) 16)))
      (iterate (for bv-cur-block in blocks)
	       (for bv-cur-iv previous bv-cur-block initially bv-iv)
	       (collecting (bv-cbc-padding-block bv-cur-block bv-cur-iv bv-key)
			   into lst-res)
	       (finally (return (s-from-bv (bv-pkcs7-unpad (apply #'bv-cat lst-res) 16))))))))

(defun bv-cbc-padding-block (bv-block bv-iv bv-key)
  (iterate (for i from 1 to 16)
	   (with bv-mask-suffix = #())
	   (for by-cur =
		(iterate (for n from 0 to 255)
			 (for bv-xor-mask = (bv-cat
							 (bv-make (- 16 i) 0)
							 #(n)
							 bv-mask-suffix))
			 (until (ch17-oracle (bv-cat bv-xor-mask bv-block)
					     bv-iv
					     bv-key))
			 (finally (return (logxor n i (elt bv-iv (- 16 i)))))))
	   (collecting by-cur into bv-res at beginning result-type 'vector)
	   (after-each (setf bv-mask-suffix (bv-xor (bv-xor (subseq bv-iv (- 16 i))
							    bv-res)
						    (bv-make i (+ i 1)))))
	   (finally (return bv-res))))

(eval-when (:execute)
  (print (ch17-crack)))

;18. Implement CTR, the stream cipher mode

(defun bv-aes-ctr-encrypt (bv-msg bv-nonce bv-key)
  (print (length bv-key))
  (iterate (for i from 0 to (ceiling (length bv-msg) 16))
	   (for bv-counter = (bv-from-in i))
	   (for bv-nonce-counter = (bv-cat bv-nonce
					   bv-counter
					   (bv-make (- 8 (length bv-counter)))))
	   (collecting (bv-aes-encrypt bv-nonce-counter bv-key) into lst-res)
	   (finally (return (bv-xor bv-msg (apply #'bv-cat lst-res))))))

(defun s-aes-ctr-encrypt (s-msg s-nonce s-key)
  (let ((bv-msg (bv-from-s s-msg))
	(bv-nonce (bv-from-s s-nonce))
	(bv-key (bv-from-s s-key)))
    (s-from-bv (bv-aes-ctr-encrypt bv-msg bv-nonce bv-key))))

(is (s-aes-ctr-encrypt (s-from-b64 "L77na/nrFsKvynd6HzOoG7GHTLXsTVu9qvY/2syLXzhPweyyMTJULu/6/kXX0KSvoOLSFQ==")
			  (s-from-bv (bv-make 8 0))
			  "YELLOW SUBMARINE")
    "Yo, VIP Let's kick it Ice, Ice, baby Ice, Ice, baby ")

;19. Break fixed-nonce CTR mode using substitions

;I'm skipping this challenge because it's explicitly not meant to be automated, the solution
;would be an Excel file

;20. Break fixed-nonce CTR statistically

;this is almost the same problem as challenge 6.  In particular, if one truncates each
;ciphertext to the length of the shortest ciphertext, and then concatenates everything,
;this is exactly the same as #6.

(defun ch20-crack (file-name)
  (let ((lst-ctexts (butlast (map #'bv-from-b64 (split #\Newline (read-file-into-string file-name))))))
    (let* ((min-len (apply #'min (map #'length lst-ctexts)))
	   (lst-truncated (map (lm (vec) (subseq vec 0 min-len)) lst-ctexts)))
      (subdivide (s-from-bv (bv-find-repeat-key (apply #'concatenate 'vector lst-truncated)))
		 min-len))))

(eval-when (:execute)
  (print (ch20-crack "/home/adminuser/20.txt")))

;21. Implement the MT19937 Mersenne Twister RNG

(defun MT-init (seed)
  ;returns a closure
  (let ((u32v-state (make-array 624 :element-type '(unsigned-byte 32)))
	(u32-and-mask (- (expt 2 32) 1)))
    (iterate (for i from 0 to 623)
	     (for u32-cur first seed then
		  (logand u32-and-mask
			  (+ (* 1812433253
				(logxor u32-cur
					(ash u32-cur 30)))
			     i)))
	     (after-each (setf (elt u32v-state i) u32-cur)))
    (MT-extract-closure u32v-state)))

(defun MT-extract-closure (u32v-state)
    (let ((index 0))
      (lambda ()
	;this is the extract number function from the Wikipedia entry for the Mersenne Twister
	(if (= index 0)
	    (setf u32v-state (u32v-MT-generate-array u32v-state)))
	(let ((u32-res (u32-MT-temper (elt u32v-state index))))
	  (setf index (mod (+ index 1) 624))
	  u32-res))))

(defun u32v-MT-generate-array (u32v-state)
  (iterate (for i from 0 to 623)
	   (for y = (+ (ldb (byte 1 31) (elt u32v-state i))
		       (ldb (byte 31 0) (elt u32v-state (mod (+ i 1) 624)))))
	   (after-each (setf (elt u32v-state i) (logxor (elt u32v-state (mod (+ i 397) 624))
							(ash y -1))))
	   (after-each (if (oddp y)
			   (setf (elt u32v-state i) (logxor (elt u32v-state i) 2567483615))))
	   (finally (return u32v-state))))

(defun u32-MT-temper (u32)
  (setf u32 (logxor u32 (ash u32 -11))
	u32 (logxor u32 (logand (ash u32 7) 2636928640))
	u32 (logxor u32 (logand (ash u32 15) 4022730752))
	u32 (logxor u32 (ash u32 -18)))
  u32)

(is (funcall (MT-init 1))
    2724652974)

;22. Crack an MT19937 seed

(defun ch22-seed ()
  (print "ch22 seed")
  (sleep (+ 40 (random 960)))
  (let ((rng (MT-init (get-universal-time))))
    (sleep (+ 40 (random 960)))
    (list (funcall rng) (funcall rng))))

(defun ch22-crack (u32)
  (iterate (for i downfrom (get-universal-time))
	   (for rng = (MT-init i))
	   (until (= (funcall rng)
		     u32))
	   (finally (return rng))))

(eval-when (:execute)
  (let* ((lst (ch22-seed))
	 (first (car lst))
	 (second (cadr lst))
	 (rng (ch22-crack first)))
    (is (funcall rng)
	second)))

;23. Clone an MT19937 RNG from its output

(defun u32-un-right-shift (u32 shift)
  (iterate (for i from 31 downto 0)
	   (for bit = (ldb (byte 1 i) u32))
	   (with u32-res = 0)
	   (after-each (if (> i (- 32 shift))
			   (setf u32-res (dpb bit (byte 1 i) u32-res))
			   (setf u32-res (dpb (logxor bit
						  (ldb (byte 1 (+ i shift)) u32-res))
					      (byte 1 i)
					      u32-res))))
	   (finally (return u32-res))))

(defun u32-un-left-shift (u32 shift u32-magic-num)
  (iterate (for i from 0 to 31)
	   (for bit = (ldb (byte 1 i) u32))
	   (with u32-res = 0)
	   (after-each (if (< i shift)
			   (setf u32-res (dpb bit (byte 1 i) u32-res))
			   (setf u32-res (dpb (logxor bit
						  (logand (ldb (byte 1 (- i shift)) u32-res)
							  (ldb (byte 1 i) u32-magic-num)))
					  (byte 1 i)
					  u32-res))))
	   (finally (return u32-res))))

(defun u32-MT-untemper (u32)
  (setf u32 (u32-un-right-shift u32 18)
	u32 (u32-un-left-shift u32 15 4022730752)
	u32 (u32-un-left-shift u32 7 2636928640)
	u32 (u32-un-right-shift u32 11))
  u32)

(let ((u32 (random (expt 2 32))))
  (is (logxor (u32-MT-untemper (u32-MT-temper u32))
	      u32)
      0))

(defun MT-clone (u32v-input)
  (let ((u32v-state (iterate (for u32-cur in-vector u32v-input)
			     (collecting (u32-MT-untemper u32-cur) result-type 'vector))))
    (MT-extract-closure u32v-state)))

(let ((orig-MT (MT-init (random (expt 2 32)))))
  (let* ((u32v-output (iterate (repeat 624)
			       (for u32-cur = (funcall orig-MT))
			       (collecting u32-cur result-type 'vector)))
	 (clone-MT (MT-clone u32v-output)))
    (is (funcall clone-MT)
	(funcall orig-MT))))


renders every time now, make sure we're not using pango to write directly to the surface

(proclaim '(optimize (speed 0) (safety 3) (debug 3)))

(ql:quickload '(alexandria iterate anaphora cl-cairo2 cl-cairo2-xlib cl-pango) :silent t)

(defpackage arboreta
  (:use cl iterate anaphora cl-cairo2))

(in-package arboreta)

(defparameter context nil)
(defparameter layout nil)
(defparameter font nil)

(defparameter w 600)
(defparameter h 400)

(defun main ()
   (setf context (create-xlib-image-context w h :window-name "pango-test"))
   (with-context (context)
      (set-source-rgb 1 1 1)
		(rectangle 0 0 w h)
		(fill-path)

		;; had to do it without the helper macros, because they cause context errors for some reason
		;; you might not have this font, change it to a good non-bitmap monospaced font you do have.

		;; we're going to need to macro the shit out of this

		(setf layout (pango:pango_cairo_create_layout (slot-value cairo:*context* 'cairo::pointer)))
		(setf font (pango:pango_font_description_from_string "Fantasque Sans Mono 12"))
		(pango:pango_layout_set_font_description layout font)

		;; (cairo:save)

		(pango:pango_layout_set_text layout
			(format nil "~{~a~%~}"
				'("Hello, glorious pango text rendering!"
				  "いあだ〜〜ずかしいです〜〜"
              "Τη γλώσσα μου έδωσαν ελληνική"
              "ᚠᛇᚻ᛫ᛒᛦᚦ᛫ᚠᚱᚩᚠᚢᚱ᛫ᚠᛁᚱᚪ᛫ᚷᛖᚻᚹᛦᛚᚳᚢᛗ"
              "ಬಾ ಇಲ್ಲಿ ಸಂಭವಿಸು ಇಂದೆನ್ನ ಹೃದಯದಲಿ "
              "मैं काँच खा सकता हूँ और मुझे उससे कोई चोट नहीं पहुंचती"))
			-1)

		(new-path)
		(move-to 0 0)
		(set-source-rgb 81/255 81/255 81/255)

		(pango:pango_cairo_update_layout (slot-value *context* 'cairo::pointer) layout)
		(pango:pango_cairo_layout_path (slot-value *context* 'cairo::pointer) layout)
		(fill-preserve)

		;; (cairo:restore)

		(princ "press enter here to exit")
		(finish-output)
		(when (read-line)
		   (cairo:destroy context))
		   (sb-ext:exit)))

(sb-ext:save-lisp-and-die "arboreta" :toplevel #'main :executable t)
;;(main)

(proclaim '(optimize (speed 0) (safety 3) (debug 3)))

(ql:quickload '(alexandria iterate anaphora cl-cairo2 cl-cairo2-xlib cl-pango) :silent t)

(defpackage arboreta
  (:use cl iterate anaphora cl-cairo2))

(in-package arboreta)

(defparameter context nil)
(defparameter layout nil)
(defparameter font nil)

(defparameter w 600)
(defparameter h 400)

(defun main ()
   (setf context (create-xlib-image-context w h :window-name "pango-test"))
   (let ((cairo::*context* context))
      (set-source-rgb 37/255 46/255 50/255)
      (paint)

      (translate 0 0)
      (set-source-rgb 148/255 163/255 165/255)

      ;; had to do it without the helper macros, because they cause context errors for some reason
      ;; you might not have this font, change it to something you do have.

      ;; sometimes the window doesn't display the text, it should work if you close out the window
      ;; and re-run (arboreta::main) from the REPL

      ;; it seems to be time based, I can't tell if the text isn't rendering at all, or if it's just
      ;; the same color as the background, or the background is getting rendered first.

      ;; we're going to need to macro the shit out of this

      (setf layout (pango:pango_cairo_create_layout (slot-value context 'cairo::pointer)))
      (setf font (pango:pango_font_description_from_string "Fantasque Sans Mono 12"))
      (pango:pango_layout_set_font_description layout font)

      (cairo:save)

      (pango:pango_layout_set_text layout "Hello, glorious pango text rendering!" -1)
      (pango:pango_cairo_update_layout (slot-value context 'cairo::pointer) layout)
      (pango:pango_cairo_show_layout (slot-value context 'cairo::pointer) layout)

      (cairo:restore)

      (sleep 5)))

;; (sb-ext:save-lisp-and-die "arboreta" :toplevel #'main :executable t)
(main)