Data Encryption Standard: Part 1
August 31, 2010
The Data Encryption Standard has been one of the most successful ciphers in history, and is still in use today, especially in its Triple DES variant. The Data Encryption Standard is officially described by FIPS 46-3, though if you are not fond of reading algorithm descriptions written by government lawyers there are many other descriptions available on the internet.
DES is a block cipher, operating on 64 bits at a time. Here is an example:
PT P r o g P r a x
HEX 50 72 6F 67 50 72 61 78
KEY 01 23 45 67 89 AB CD EF
CT CC 99 EA 46 B1 6E 28 90
There is more than one way to encrypt a message longer than 64 bits; we will examine them in a later exercise.
Your task is to write the code to encipher and decipher a single 64-bit block using the Data Encryption Standard. When you are finished, you are welcome to read or run a suggested solution, or to post your own solution or discuss the exercise in the comments below.
Programming Praxis 
;; Uses 1 and 0 for bits !
;; Extremely not efficient, but still a working prototype (with Gambit)!
;; Contains a lot of useless code.
(define IP
(vector
58 50 42 34 26 18 10 2
60 52 44 36 28 20 12 4
62 54 46 38 30 22 14 6
64 56 48 40 32 24 16 8
57 49 41 33 25 17 9 1
59 51 43 35 27 19 11 3
61 53 45 37 29 21 13 5
63 55 47 39 31 23 15 7))
(define IP^-1
(vector
40 8 48 16 56 24 64 32
39 7 47 15 55 23 63 31
38 6 46 14 54 22 62 30
37 5 45 13 53 21 61 29
36 4 44 12 52 20 60 28
35 3 43 11 51 19 59 27
34 2 42 10 50 18 58 26
33 1 41 9 49 17 57 25))
(define P
(vector
16 7 20 21
29 12 28 17
1 15 23 26
5 18 31 10
2 8 24 14
32 27 3 9
19 13 30 6
22 11 4 25))
(define (S i)
(list-ref
(list
(vector
14 4 13 1 2 15 11 8 3 10 6 12 5 9 0 7
0 15 7 4 14 2 13 1 10 6 12 11 9 5 3 8
4 1 14 8 13 6 2 11 15 12 9 7 3 10 5 0
15 12 8 2 4 9 1 7 5 11 3 14 10 0 6 13)
(vector
15 1 8 14 6 11 3 4 9 7 2 13 12 0 5 10
3 13 4 7 15 2 8 14 12 0 1 10 6 9 11 5
0 14 7 11 10 4 13 1 5 8 12 6 9 3 2 15
13 8 10 1 3 15 4 2 11 6 7 12 0 5 14 9)
(vector
10 0 9 14 6 3 15 5 1 13 12 7 11 4 2 8
13 7 0 9 3 4 6 10 2 8 5 14 12 11 15 1
13 6 4 9 8 15 3 0 11 1 2 12 5 10 14 7
1 10 13 0 6 9 8 7 4 15 14 3 11 5 2 12)
(vector
7 13 14 3 0 6 9 10 1 2 8 5 11 12 4 15
13 8 11 5 6 15 0 3 4 7 2 12 1 10 14 9
10 6 9 0 12 11 7 13 15 1 3 14 5 2 8 4
3 15 0 6 10 1 13 8 9 4 5 11 12 7 2 14)
(vector
2 12 4 1 7 10 11 6 8 5 3 15 13 0 14 9
14 11 2 12 4 7 13 1 5 0 15 10 3 9 8 6
4 2 1 11 10 13 7 8 15 9 12 5 6 3 0 14
11 8 12 7 1 14 2 13 6 15 0 9 10 4 5 3)
(vector
12 1 10 15 9 2 6 8 0 13 3 4 14 7 5 11
10 15 4 2 7 12 9 5 6 1 13 14 0 11 3 8
9 14 15 5 2 8 12 3 7 0 4 10 1 13 11 6
4 3 2 12 9 5 15 10 11 14 1 7 6 0 8 13)
(vector
4 11 2 14 15 0 8 13 3 12 9 7 5 10 6 1
13 0 11 7 4 9 1 10 14 3 5 12 2 15 8 6
1 4 11 13 12 3 7 14 10 15 6 8 0 5 9 2
6 11 13 8 1 4 10 7 9 5 0 15 14 2 3 12)
(vector
13 2 8 4 6 15 11 1 10 9 3 14 5 0 12 7
1 15 13 8 10 3 7 4 12 5 6 11 0 14 9 2
7 11 4 1 9 12 14 2 0 6 10 13 15 3 5 8
2 1 14 7 4 10 8 13 15 12 9 0 3 5 6 11))
(- i 1)))
(define PC1
(vector
57 49 41 33 25 17 9
1 58 50 42 34 26 18
10 2 59 51 43 35 27
19 11 3 60 52 44 36
63 55 47 39 31 23 15
7 62 54 46 38 30 22
14 6 61 53 45 37 29
21 13 5 28 20 12 4))
(define PC2
(vector
14 17 11 24 1 5
3 28 15 6 21 10
23 19 12 4 26 8
16 7 27 20 13 2
41 52 31 37 47 55
30 40 51 45 33 48
44 49 39 56 34 53
46 42 50 36 29 32))
(define l-shifts
(list 1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1))
(define E
(vector
32 1 2 3 4 5
4 5 6 7 8 9
8 9 10 11 12 13
12 13 14 15 16 17
16 17 18 19 20 21
20 21 22 23 24 25
24 25 26 27 28 29
28 29 30 31 32 1))
;; Creates all the Kn’s.
(define (make-schedule k . decode?)
(let ((c0d0 (permut k PC1)))
(let loop-1 ((kk c0d0) (i 0) (lr ‘()))
(if (= i 16)
(begin
(lambda (x) (list-ref (if (pair? decode?) lr (reverse lr)) x)))
(begin
(rotate-l kk (list-ref l-shifts i))
(rotate-r kk (list-ref l-shifts i))
(loop-1 (vector-copy kk) (+ i 1) (cons (permut kk PC2) lr)))))))
;; Rotate whatever part of a vector
(define-macro (make-rotate from to)
` (lambda (v n)
(let loop-2 ((i 0))
(if (= i n)
v
(let ((tmp (vector-ref v ,from)))
(map (lambda (i) (vector-set! v i (vector-ref v (+ i 1)))) (iota ,from ,(- to 2)))
(vector-set! v ,(- to 1) tmp)
(loop-2 (+ i 1)))))))
(define rotate-l (make-rotate 0 28))
(define rotate-r (make-rotate 28 56))
(define-macro (merge l r)
`(vector-append ,l ,r))
;; Apply a permutation
(define (permut obj table)
(let* ((l (vector-length table))
(v (make-vector l)))
(let loop-4 ((idx 0))
(if (= idx l)
v
(begin
(vector-set! v idx (vector-ref obj (- (vector-ref table idx) 1)))
(loop-4 (+ idx 1)))))))
;; Take the i-th octet of a 64 bit word.
(define (Bi v48 i)
(let ((v (make-vector 6)))
(let loop-5 ((j 0) (i (* 6 (- i 1))))
(if (= j 6)
v
(begin
(vector-set! v j (vector-ref v48 i))
(loop-5 (+ j 1) (+ i 1)))))))
;; The Feistel carnage
(define (f rn kn)
(let* ((one-to-eight (iota 1 8))
(Bis (map (lambda (i) (Bi (vector-xor kn (permut rn E)) i)) one-to-eight))
(SiBis (map (lambda (bi i) (S-apply bi (S i))) Bis one-to-eight)))
(permut (apply vector-append SiBis) P)))
;; Pick up the value from an S-box
(define (S-apply six table)
(let ((i (+ (* 2 (vector-ref six 0)) (vector-ref six 5)))
(j (+ (* 8 (vector-ref six 1)) (* 4 (vector-ref six 2)) (* 2 (vector-ref six 3)) (vector-ref six 4))))
(let ((tmp (integer->bitvector (vector-ref table (+ j (* 16 i))))))
(case (vector-length tmp)
((0) (vector 0 0 0 0))
((1) (vector-append (vector 0 0 0) tmp))
((2) (vector-append (vector 0 0) tmp))
((3) (vector-append (vector 0) tmp))
(else tmp)))))
(define (aes message key . decode?)
(display (list ‘message message)) (newline)
(let ((v (make-vector 64)))
(map (lambda (pos letter) (vector-set! v pos letter))
(iota 63)
(apply append (map char->bitstring (string->list message))))
(let ((input (permut v IP)))
(let* ((l0 (l input))
(r0 (r input))
(k (key-hexa->bitvector key))
(schedule (if (pair? decode?) (make-schedule k) (make-schedule k ‘decode))))
(let loop-7 ((ln l0) (rn r0) (n 0))
(if (= n 16)
(let ((res (permut (merge rn ln) IP^-1)))
(pp (list ‘res-as-hex (bitstring->hexchars res))) (newline)
(pp (list ‘res-as-string (bitstring->string res))) (newline)
(bitstring->string res))
(loop-7 rn (vector-xor ln (f rn (schedule n))) (+ n 1))))))))
(define (vector-xor v1 v2)
(let ((v (make-vector (vector-length v1))))
(let loop-8 ((i 0))
(if (= i (vector-length v))
v
(begin
(vector-set! v i (bitwise-xor (vector-ref v1 i) (vector-ref v2 i)))
(loop-8 (+ i 1)))))))
(define-macro (make-split from to)
` (lambda(v64)
(let ((v32 (make-vector 32)))
(let loop-9 ((i 0))
(if (= i ,(- to from))
v32
(begin
(vector-set! v32 i (vector-ref v64 (+ ,from i)))
(loop-9 (+ i 1))))))))
(define l (make-split 0 32))
(define r (make-split 32 64))
(define (integer->bitvector n)
(let loop-6 ((n n) (l ‘()))
(if (= 0 n)
(list->vector l)
(loop-6 (arithmetic-shift n -1) (cons (modulo n 2) l)))))
(define (char->bitstring c)
(map
(lambda (p)
(bitwise-and 1 (arithmetic-shift (char->integer c) (- p))))
(reverse (iota 7))))
(define (key-hexa->bitvector hk-l)
(list->vector (apply append (map char->bitstring hk-l))))
(define-macro (bitstring->foo fun)
` (lambda (v64)
(let loop ((c 0) (i 0) (j 0) (t 0) (seen ‘()))
(if (= t (vector-length v64))
(apply string-append (map ,fun (reverse (cons c seen))))
(if (= i 8)
(loop 0 0 (+ j 1) t (cons c seen))
(loop (bitwise-ior c (arithmetic-shift (vector-ref v64 (+ (* 8 j) i)) (- 7 i))) (+ i 1) j (+ t 1) seen))))))
(define bitstring->hexchars (bitstring->foo dec->hex-string))
(define bitstring->string (bitstring->foo (lambda(x)(string(integer->char x)))))
(define (conv n)
(if (< n 10)
(number->string n)
(case n
((10) “A”)
((11) “B”)
((12) “C”)
((13) “D”)
((14) “E”)
(else “F”))))
(define (dec->hex-string n)
(let ((ent (quotient n 16))
(rem (remainder n 16)))
(string-append (conv ent) (conv rem))))
(define (test)
(let ((key (list #\x01 #\x23 #\x45 #\x67 #\x89 #\xAB #\xCD #\xEF)))
(aes (aes “ProgPrax” key) key ‘decode)))
(test)
Ah, and I wrote “aes” instead of “des”. And some comments are wrong too…
There was a bug in
ascii->bits. It has been fixed.