;; This is a description of the "Content Scramble System" (CSS)
;; descrambling algorithm in the pure lambda calculus. At the same
;; time it is also a valid expression in the Scheme programming
;; language which evaluates to the same descrambling function and
;; which can be used by other Scheme code.
;;
;; The lambda calculus, invented by Alonzo Church in the 1930s, is
;; a mathematical model of computation based around the operations of
;; "abstraction" (defining functions) and "application" (evaluating
;; them at a point). Nothing else is permitted -- in particular,
;; there are no numbers, variables, or data structures of any kind.
;;
;; THE INTERFACE
;; ~~~~~~~~~~~~~
;; The descrambling function in this file takes a single argument,
;; which is a functional representation of the decryption key (see
;; below for details). It returns a CSS descrambling function which
;; has been "seeded" with that key. This new function takes a single
;; argument, being a functional representation of a single 2048-byte
;; block of data, and returns the decrypted form of that block (or
;; the original block if it wasn't encrypted).
;;
;; Since everything in this implementation is a function, the
;; arguments and return values of the decoder have to be represented
;; as functions somehow.
;;
;; First I'll explain how to represent a single byte. The byte with
;; numerical value N is represented by a function which, when given a
;; function as its argument, returns the N-fold composition of that
;; function with itself. For example:
;;
;; 0 is (lambda (f) (lambda (x) x))
;; 1 is (lambda (f) (lambda (x) (f x))), or just (lambda (f) f)
;; 2 is (lambda (f) (lambda (x) (f (f x))))
;; 3 is (lambda (f) (lambda (x) (f (f (f x)))))
;;
;; ... and so on. Functions of this type are called "Church numerals."
;;
;; Now I'll explain how to represent a list of bytes. A list of bytes
;; is a function taking a single argument. If passed Church numeral 0,
;; it returns the first byte in the list. If passed Church numeral 1,
;; it returns a list of all the bytes except the first. So if f is
;; a list of bytes and z0 and z1 are the first two Church numerals,
;; then (f z0) is the first byte, ((f z1) z0) is the second byte,
;; (((f z1) z1) z0) is the third byte, and so on. This representation
;; was inspired by Scheme lists, which work in much the same way.
;;
;; In case that wasn't perfectly clear, here are some functions
;; defining the conversion from ordinary Scheme numbers and lists into
;; their pure-functional representations and back again:
;;
;; (define (int->Church i)
;; (if (zero? i)
;; (lambda (f) (lambda (x) x))
;; (let ((m (int->Church (- i 1))))
;; (lambda (f) (lambda (x) ((m f) (f x)))) )))
;;
;; (define (Church->int ch)
;; ((ch add1) 0) )
;;
;; (define (list->zlist lst)
;; (if (null? lst)
;; (lambda (x) x)
;; (let ((zcar (int->Church (car lst)))
;; (zcdr (list->zlist (cdr lst))) )
;; (lambda (i)
;; ((i (lambda (x) zcdr)) zcar) ))))
;;
;; (define (zlist->list len zlst)
;; (define z0 (lambda (x) (lambda (y) y)))
;; (define z1 (lambda (x) x))
;; (if (zero? len)
;; ()
;; (cons (Church->int (zlst z0))
;; (zlist->list (- len 1) (zlst z1)) )))
;;
;; THE IMPLEMENTATION
;; ~~~~~~~~~~~~~~~~~~
;; Constructing this function was a very interesting exercise.
;;
;; A lot of operations that one tends to take for granted in ordinary
;; programming -- like testing for equality -- become very difficult
;; in the pure lambda calculus. The reason is that everything you
;; work with is a function closure, and there's no way to "look
;; inside" a function closure and see what it does. All you can do
;; is probe its behavior by evaluating it at different points. And
;; of course the result of that evaluation is itself a function
;; closure, which can't be identified except by calling it, and so
;; on.
;;
;; Here are some general notes:
;;
;; Almost all other CSS implementations operate at the byte level.
;; This one operates at the bit level. There are no lookup tables;
;; everything is done with logic gates.
;;
;; Since there are no variables, the idiom
;; ((lambda (myfunc) ...) function-definition) is used to bind
;; functions to descriptive names.
;;
;; To multiply two Church numerals, just compose them. To raise one
;; to the power of another, just apply the exponent to the base.
;; For example, (7 2) is 128. Addition is slightly more complicated.
;;
;; Internally most calculations are done using boolean values, with
;; false being the first Church numeral (z0) and true being the
;; second (z1). Remarkably enough, when false and true are
;; represented this way the function call (p q) is equivalent to
;; p=>q. From this one can construct elegant (if opaque)
;; representations of other useful logical operations.
;;
;; The descrambler does not use recursion at all. It is possible to
;; write recursive functions within the lambda calculus, but it is
;; impossible to stop at the base case without relying on knowledge of
;; the underlying language's evaluation order. Since I wanted a
;; formula which was completely independent of any particular
;; language, I chose to avoid recursion.
;;
;; How can I write loops without recursion? Keep reading and see if
;; you can figure it out.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ==============
;; css-descramble
;; ==============
;; This function takes a key (5 bytes) and a sector (2048 bytes) as input. It
;; checks the bit in the sector header which flags an encrypted sector, and
;; returns the original sector header plus either the original sector body (if
;; the encryption bit is clear) or the decrypted sector body (if it's set).
;; The function is curried so that if it's bound to css-descramble, then
;; (css-descramble key) gets you a descrambler that will work for any sector
;; in a VOB file.
;;
;; Note that the current implementation does not reset the encryption flag
;; when it decrypts. The advantage of this is that it makes the decryption
;; function bijective, and hence invertible (otherwise it would be 2-to-1).
;; The disadvantage is that it means the decryption function is not
;; idempotent: if you pass in the same block twice you'll get garbage the
;; second time, if it was originally encrypted.
;;
;; This function is very nearly its own inverse. To invert it you only need
;; to make two changes:
;;
;; 1. Move the "unmangle" call in the crypt subfunction so that it applies
;; to the result of xor-bitstreams, instead of to sector-body.
;;
;; 2. Change the "permute" subfunction to its inverse permutation. The
;; easiest way to do this is to call permute three times in unmangle
;; instead of just once. (This is an order-4 permutation, so its
;; inverse is also its third power.)
;;
;; 2.5. You might want to rename "unmangle" to "mangle" also.
;;
((lambda (z0 z1 z2 z3 z5 z7 z* z+ zifn zcons zcar zcdr) ; <-- subfunctions
((lambda (reversed-join generalized-filter z4 z8 z1920 zxor) ; <-- more subfunctions
((lambda (stream->bitstream bitstream->stream xor-bitstreams) ; <-- more subfunctions
((lambda (test-encryption-flag get-sector-key crypt) ; <-- more subfunctions
(lambda (key)
(lambda (sector)
(zifn (test-encryption-flag sector)
sector
(generalized-filter ; this just appends the first 128 bytes of the sector to the decrypted remainder
sector
(z7 z2)
(lambda (s tail) (zcons (zcar s) tail)) ; simple copy
zcdr
(bitstream->stream z1920
(crypt (get-sector-key key sector)
(stream->bitstream z1920 (((z7 z2) zcdr) sector)) )))))))
;; ====================
;; test-encryption-flag: returns bit 4 of byte 20 of the sector, which indicates whether the sector is encrypted.
;; ====================
(lambda (sector)
(zcar ((z4 zcdr) (stream->bitstream z1 ((z4 (z5 zcdr)) sector)))) )
;; ==============
;; get-sector-key: returns the sector key, which is the title key xor'd with bytes 84-88 of the sector.
;; ==============
(lambda (key sector)
(xor-bitstreams (z* z8 z5)
(stream->bitstream z5 key)
(stream->bitstream z5 ((z2 (z2 (z3 (z7 zcdr)))) sector)) ))
;; =====
;; crypt: does the actual decryption, using unmangle and cipher-bitstream.
;; =====
((lambda (cipher-bitstream unmangle) ; <-- subfunctions
(lambda (key sector-body)
(xor-bitstreams (z* z8 z1920) (unmangle sector-body) (cipher-bitstream key)) ))
;; ================
;; cipher-bitstream
;; ================
;; This function returns the pseudo-random bitstream generated
;; by the given key. The random number generator uses two
;; LFSRs, one of 17 bits and the other of 25 bits, initialized
;; from the "key" argument. The outputs of the two LFSRs are
;; added together (with carry) to produce the final result.
;; The 17-bit LFSR's output is negated before the addition.
((lambda (tap-lfsr17 tap-lfsr25 make-bitstream negate-bitstream add-bitstreams) ; <-- subfunctions
(lambda (key)
(add-bitstreams (z* z8 z1920)
(negate-bitstream (z* z8 z1920)
(make-bitstream tap-lfsr17 z8 key) )
(make-bitstream tap-lfsr25 z3 (((z2 z4) zcdr) key)) )))
;; ==========
;; tap-lfsr17: the feedback function for the smaller LFSR: xor(bit 14, bit 0).
;; ==========
(lambda (s)
(zxor (((z2 zcdr) s) z0) ((((z4 z2) zcdr) s) z0)) )
;; ==========
;; tap-lfsr25: the feedback function for the larger LFSR: xor(bit 12, bit 4, bit 3, bit 0).
;; ==========
(lambda (s)
((lambda (s12)
(zxor (s12 z0)
((lambda (s20)
(zxor (s20 z0)
(zxor ((s20 z1) z0)
(((z4 zcdr) s20) z0) )))
((z8 zcdr) s12) )))
((z4 (z3 zcdr)) s) ))
;; ==============
;; make-bitstream
;; ==============
;; The output bitstream from a single LFSR is composed of
;; the bits that are shifted on to it. Rather than save
;; these bits in a separate stream, I use an LFSR of
;; unlimited length and just let the bits accumulate.
;; When I have enough (1920 bytes' worth) I extract them
;; with reversed-join.
((lambda (insert-1-bit lfsr-clocker) ; <-- subfunctions
(lambda (feedback-func extra-bit-pos seed)
(reversed-join (z* z1920 z8)
((z1920 (z8 (lfsr-clocker feedback-func))) (insert-1-bit extra-bit-pos seed))
z1 )))
;; ============
;; insert-1-bit: inserts a "1" at position pos in the given stream.
;; ============
(lambda (pos stream)
(reversed-join pos (reversed-join pos stream z1)
(zcons z1 ((pos zcdr) stream)) ))
;; ============
;; lfsr-clocker
;; ============
;; This function "shifts" (really adds) one bit onto the
;; front of the LFSR. It is curried so that it can be
;; raised to the (1920*8)th power in make-bitstream above.
(lambda (feedback-func)
(lambda (lfsr-bits)
(zcons (feedback-func lfsr-bits) lfsr-bits) )) )
;; ================
;; negate-bitstream
;; ================
(lambda (n bs)
(generalized-filter
bs
n
(lambda (s tail) (zcons ((zcar s) z0) tail))
zcdr
z1 ))
;; ==============
;; add-bitstreams: add two streams of bits, with carry
;; ==============
((lambda (zor) ; <-- subfunctions
(lambda (n bs1 bs2)
(generalized-filter
(zcons z0 (zcons bs1 bs2))
n
(lambda (s tail)
; admittedly, this is not as clear as it could be...
(zcons (((zcar s) zcar) (((zcar (zcar (zcdr s))) zcar) (((zcar (zcdr (zcdr s))) zcar) z0)))
tail ))
(lambda (s)
(zcons ((zifn (zcar s) z* zor) (zcar (zcar (zcdr s))) (zcar (zcdr (zcdr s))))
(zcons (zcdr (zcar (zcdr s))) (zcdr (zcdr (zcdr s)))) ))
z1 )))
(lambda (a b) ((a z0) b)) ) ) ; === zor ===
;; ========
;; unmangle
;; ========
;; This function passes the encoded data through a reversible
;; per-byte scrambling function prior to its being xor'd with
;; the cipher bitstream. The complete operation is twiddle-
;; permute-twiddle, where twiddle and permute are as defined
;; below.
((lambda (twiddle permute) ; <-- subfunctions
(lambda (s)
(twiddle z1920 (permute z1920 (twiddle z1920 s))) ) )
;; =======
;; twiddle
;; =======
;; This performs the following operations on each byte, where a..h
;; are the bits of the byte, least significant first:
;; c ^= !(a&b);
;; d ^= !(a&b);
;; g ^= !(e&f);
;; h ^= !(e|f);
(lambda (n s)
(generalized-filter
s
n
(lambda (s tail)
((lambda (half-twiddle znor znand) ; <-- subfunctions
(half-twiddle znand znand s (half-twiddle znand znor (zcdr (zcdr (zcdr (zcdr s)))) tail)) )
;; ============
;; half-twiddle
;; ============
;; This computes a single nibble of output:
;; c ^= !(a op1 b);
;; d ^= !(a op2 b);
(lambda (op1 op2 s tail)
(zcons (zcar s)
(zcons (zcar (zcdr s))
(zcons (zxor (zcar (zcdr (zcdr s)))
(op1 (zcar s) (zcar (zcdr s))) )
(zcons (zxor (zcar (zcdr (zcdr (zcdr s))))
(op2 (zcar s) (zcar (zcdr s))) )
tail )))))
(lambda (a b) (((a z0) b) z0)) ; === znor ===
(lambda (a b) (a (b z0))) )) ; === znand ===
(z8 zcdr)
z1 ))
;; =======
;; permute
;; =======
;; This applies the permutation (agbd)(cehf) to the bits of each
;; byte, where a..h are defined as above.
(lambda (n s)
(generalized-filter
s
n
(lambda (s tail)
((lambda (s+4)
(zcons ((((s z1) z1) z1) z0) ; 3
(zcons (((s+4 z1) z1) z0) ; 6
(zcons ((s+4 z1) z0) ; 5
(zcons ((s z1) z0) ; 1
(zcons (((s z1) z1) z0) ; 2
(zcons ((((s+4 z1) z1) z1) z0) ; 7
(zcons (s z0) ; 0
(zcons (s+4 z0) ; 4
tail )))))))))
((((s z1) z1) z1) z1) ))
(z8 zcdr)
z1 )) ) ) ))
;; =================
;; stream->bitstream
;; =================
((lambda (byte->bitstream) ; <-- subfunctions
(lambda (n stream)
(generalized-filter
stream
n
(lambda (s tail)
(byte->bitstream (zcar s) tail) )
zcdr
z1 )))
;; ===============
;; byte->bitstream
;; ===============
((lambda (shift) ; <-- subfunctions
(lambda (i tail)
(generalized-filter
(shift i)
z8
(lambda (bits tail)
(zcons (zcar bits) tail) )
(lambda (bits)
(shift (zcdr bits)) )
tail )))
;; =====
;; shift: returns pair(n&1,n>>1).
;; =====
(lambda (n)
((n (lambda (state)
(zcons ((state z0) z0) (z+ (state z1) (state z0))) ))
(lambda (x) z0) )) ) )
;; =================
;; bitstream->stream
;; =================
;; This function converts a stream of bits (of length n*8) to a
;; stream of bytes (of length n). It works in three stages,
;; each of which decreases the stream length by half.
((lambda (accumulate-bits) ; <-- subfunctions
(lambda (n bitstream)
(accumulate-bits
n (z2 z4)
(accumulate-bits
(z* z2 n) z4
(accumulate-bits
(z* z4 n) z2
bitstream )))))
;; ===============
;; accumulate-bits
;; ===============
;; This returns a stream whose elements are (a + b * base) for
;; each pair a,b of elements in the source stream.
(lambda (n base stream)
(generalized-filter
stream
n
(lambda (s tail)
(zcons (z+ (zcar s) (z* base (zcar (zcdr s))))
tail ))
(z2 zcdr)
z1 )) )
;; ==============
;; xor-bitstreams
;; ==============
(lambda (n bs1 bs2)
(generalized-filter
(zcons bs1 bs2)
n
(lambda (s tail)
(zcons (zxor (zcar (zcar s)) (zcar (zcdr s)))
tail ))
(lambda (s)
(zcons (zcdr (zcar s)) (zcdr (zcdr s))) )
z1 )) ))
;; =============
;; reversed-join: returns the reverse of lst1 with lst2 appended to the end
;; =============
(lambda (n lst1 lst2)
((lambda (helper)
(((n helper) (zcons lst1 lst2)) z1) )
(lambda (state)
(zcons ((state z0) z1)
(zcons ((state z0) z0) (state z1)) ))))
;; ==================
;; generalized-filter
;; ==================
;; This is the main workhorse function of the descrambler.
;; It has the following parameters:
;; src: the source list (or other datum)
;; count: the number of times to iterate dst-next and src-next
;; dst-next: returns the next "piece" of the output
;; src-next: returns the updated src for the next iteration
;; final-tail: the tail of the output list
;;
;; The most interesting thing about this function is that it does not
;; reverse the input list. Iterated list operations usually reverse the
;; list if implemented in the obvious way (see reversed-join above for
;; an example). generalized-filter avoids this by an interesting trick.
;; I can't think of any way to describe the trick that's any clearer
;; than the code below.
;;
(lambda (src count dst-next src-next final-tail)
((zcar ((count (lambda (state)
(zcons (lambda (tail)
((zcar state) (dst-next (zcdr state) tail)) )
(src-next (zcdr state)) )))
(zcons (lambda (x) x) src) ))
final-tail ))
(z2 z2) ; === z4 ===
(z3 z2) ; === z8 ===
(z* (z7 z2) (z* z3 z5)) ; === z1920 === (# of encrypted bytes per sector)
(lambda (a b) ((a b) ((b a) z0))) )) ; === zxor ===
(lambda (f) (lambda (x) x)) ; === z0 ===
(lambda (f) f) ; === z1 === (also used as the identity function, and as an infinite list of zeros)
(lambda (f) (lambda (x) (f (f x)))) ; === z2 ===
(lambda (f) (lambda (x) (f (f (f x))))) ; === z3 ===
(lambda (f) (lambda (x) (f (f (f (f (f x))))))) ; === z5 ===
(lambda (f) (lambda (x) (f (f (f (f (f (f (f x))))))))) ; === z7 ===
(lambda (a b) (lambda (f) (a (b f)))) ; === z* === (also used as logical and)
(lambda (a b) (lambda (f) (lambda (x) ((b f) ((a f) x))))) ; === z+ ===
(lambda (pred then else) ((pred (lambda (x) else)) then)) ; === zifn ===
(lambda (a b) (lambda (p) ((p (lambda (x) b)) a))) ; === zcons ===
(lambda (c) (c (lambda (f) (lambda (x) x)))) ; === zcar === ((zcar x) <=> (x z0))
(lambda (c) (c (lambda (f) f))) ) ; === zcdr === ((zcdr x) <=> (x z1))