177 lines
5.9 KiB
Plaintext
177 lines
5.9 KiB
Plaintext
(de *Md4-W .
|
|
(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
|
|
1 5 9 13 2 6 10 14 3 7 11 15 4 8 12 16
|
|
1 9 5 13 3 11 7 15 2 10 6 14 4 12 8 16 .))
|
|
(de *Md4-R1 . (3 7 11 19 .))
|
|
(de *Md4-R2 . (3 5 9 13 .))
|
|
(de *Md4-R3 . (3 9 11 15 .))
|
|
|
|
(de mod32 (N)
|
|
(& N `(hex "FFFFFFFF")) )
|
|
|
|
(de not32 (N)
|
|
(x| N `(hex "FFFFFFFF")) )
|
|
|
|
(de add32 @
|
|
(mod32 (pass +)) )
|
|
|
|
(de leftRotate (X C)
|
|
(| (mod32 (>> (- C) X)) (>> (- 32 C) X)) )
|
|
|
|
(de md4 (Str)
|
|
(let Len (length Str)
|
|
(setq Str
|
|
(conc
|
|
(need
|
|
(- 8 (* 64 (/ (+ Len 1 8 63) 64))) # Pad to 64-8 bytes
|
|
(conc
|
|
(mapcar char (chop Str)) # Works only with ASCII characters
|
|
(cons `(hex "80")) ) # '1' bit
|
|
0 ) # Pad with '0'
|
|
(make
|
|
(setq Len (* 8 Len))
|
|
(do 8
|
|
(link (& Len 255))
|
|
(setq Len (>> 8 Len )) ) ) ) ) )
|
|
(let
|
|
(H0 `(hex "67452301")
|
|
H1 `(hex "EFCDAB89")
|
|
H2 `(hex "98BADCFE")
|
|
H3 `(hex "10325476")
|
|
R2 `(hex "5A827999")
|
|
R3 `(hex "6ED9EBA1") )
|
|
(while Str
|
|
(let
|
|
(A H0 B H1 C H2 D H3
|
|
W (make
|
|
(do 16
|
|
(link
|
|
(apply |
|
|
(mapcar >> (0 -8 -16 -24) (cut 4 'Str)) ) ) ) ) )
|
|
(for I 12
|
|
(cond
|
|
((>= 4 I)
|
|
(setq
|
|
A (leftRotate
|
|
(add32
|
|
A
|
|
(| (& B C) (& (not32 B) D))
|
|
(get W (pop '*Md4-W)) )
|
|
(pop '*Md4-R1) )
|
|
D (leftRotate
|
|
(add32
|
|
D
|
|
(| (& A B) (& (not32 A) C))
|
|
(get W (pop '*Md4-W)) )
|
|
(pop '*Md4-R1) )
|
|
C (leftRotate
|
|
(add32
|
|
C
|
|
(| (& D A) (& (not32 D) B))
|
|
(get W (pop '*Md4-W)) )
|
|
(pop '*Md4-R1) )
|
|
B (leftRotate
|
|
(add32
|
|
B
|
|
(| (& C D) (& (not32 C) A))
|
|
(get W (pop '*Md4-W)) )
|
|
(pop '*Md4-R1) ) ) )
|
|
((>= 8 I)
|
|
(setq
|
|
A (leftRotate
|
|
(add32
|
|
A
|
|
(|
|
|
(& B (| C D))
|
|
(& C D) )
|
|
(get W (pop '*Md4-W))
|
|
R2 )
|
|
(pop '*Md4-R2) )
|
|
D (leftRotate
|
|
(add32
|
|
D
|
|
(|
|
|
(& A (| B C))
|
|
(& B C) )
|
|
(get W (pop '*Md4-W))
|
|
R2 )
|
|
(pop '*Md4-R2) )
|
|
C (leftRotate
|
|
(add32
|
|
C
|
|
(|
|
|
(& D (| A B))
|
|
(& A B) )
|
|
(get W (pop '*Md4-W))
|
|
R2 )
|
|
(pop '*Md4-R2) )
|
|
B (leftRotate
|
|
(add32
|
|
B
|
|
(|
|
|
(& C (| D A))
|
|
(& D A) )
|
|
(get W (pop '*Md4-W))
|
|
R2 )
|
|
(pop '*Md4-R2) ) ) )
|
|
(T
|
|
(setq
|
|
A (leftRotate
|
|
(add32
|
|
A
|
|
(x| B C D)
|
|
(get W (pop '*Md4-W))
|
|
R3 )
|
|
(pop '*Md4-R3) )
|
|
D (leftRotate
|
|
(add32
|
|
D
|
|
(x| A B C)
|
|
(get W (pop '*Md4-W))
|
|
R3 )
|
|
(pop '*Md4-R3) )
|
|
C (leftRotate
|
|
(add32
|
|
C
|
|
(x| D A B)
|
|
(get W (pop '*Md4-W))
|
|
R3 )
|
|
(pop '*Md4-R3) )
|
|
B (leftRotate
|
|
(add32
|
|
B
|
|
(x| C D A)
|
|
(get W (pop '*Md4-W))
|
|
R3 )
|
|
(pop '*Md4-R3) ) ) ) ) )
|
|
(setq
|
|
H0 (add32 H0 A)
|
|
H1 (add32 H1 B)
|
|
H2 (add32 H2 C)
|
|
H3 (add32 H3 D) ) ) )
|
|
(make
|
|
(for N (list H0 H1 H2 H3)
|
|
(do 4
|
|
(link (& N 255))
|
|
(setq N (>> 8 N)) ) ) ) ) )
|
|
|
|
(let Str "Rosetta Code"
|
|
(println
|
|
(pack
|
|
(mapcar
|
|
'((B) (pad 2 (hex B)))
|
|
(md4 Str) ) ) )
|
|
(println
|
|
(pack
|
|
(mapcar
|
|
'((B) (pad 2 (hex B)))
|
|
(native
|
|
"libcrypto.so"
|
|
"MD4"
|
|
'(B . 16)
|
|
Str
|
|
(length Str)
|
|
'(NIL (16)) ) ) ) ) )
|
|
|
|
(bye)
|