(FILECREATED "30-Dec-85 13:54:57" {ERIS}<LISPUSERS>KOTO>CRYPT.;2 7273
changes to: (VARS CRYPTCOMS)
previous date: "27-Sep-84 18:10:20" {ERIS}<LISPUSERS>KOTO>CRYPT.;1)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CRYPTCOMS)
(RPAQQ CRYPTCOMS ((FNS CheckKey CorrectParity CryptData EncryptBlock DecryptBlock GetRandomCryptKey
GetRandomIV MakeCryptKey ParityTable XOR64)
(VARS (EvenParityFor7Bits '(T NIL NIL T NIL T T NIL NIL T T NIL T NIL NIL T NIL T T NIL T NIL
NIL T T NIL NIL T NIL T T NIL NIL T T NIL T NIL NIL T T NIL NIL
T NIL T T NIL T NIL NIL T NIL T T NIL NIL T T NIL T NIL NIL T
NIL T T NIL T NIL NIL T T NIL NIL T NIL T T NIL T NIL NIL T NIL
T T NIL NIL T T NIL T NIL NIL T T NIL NIL T NIL T T NIL NIL T T
NIL T NIL NIL T NIL T T NIL T NIL NIL T T NIL NIL T NIL T T NIL)
)
(OddParity (ParityTable EvenParityFor7Bits))
(DESNullKey (PROGN (* note that this has incorrect parity)
(ARRAY 8 '(BITS 8)
0 0)))
(\DESScratchIV1 (ARRAY 8 '(BITS 8)
0 0))
(\DESScratchIV2 (ARRAY 8 '(BITS 8)
0 0)))
(GLOBALVARS EvenParityFor7Bits OddParity DESNullKey \DESScratchIV1 \DESScratchIV2)
(CONSTANTS (\DESBlockSize 4))
(FILES SIGNAL)))
(DEFINEQ
(CheckKey
[LAMBDA (key) (* ht: "25-Sep-84 09:36")
(OR (for i from 0 to 7 always ([LAMBDA (elt)
(LOGAND elt 1)=(ELT OddParity (LRSH elt 1]
(ELT key i)))
(Signal 'BadParityKey
key])
(CorrectParity
[LAMBDA (key parity) (* ht: "26-Sep-84 20:16")
(* force the low order bit so as to make whole byte odd
parity)
(OR parity parity←OddParity)
[for i from 0 to 7 do ((ELT key i)←([LAMBDA (high7)
(LOGOR (LLSH high7 1)
(ELT parity high7]
(LRSH (ELT key i)
1]
key])
(CryptData
[LAMBDA (key nBlks from to direction mode uSeed) (* ht: "26-Sep-84 20:11")
(* * Basic En/Decryption of collections of quad-words. From and to must either be identical or non-overlapping.
nBlks is number of quad-words to mung. key and uSeed are arrays containing 1 quad-word. Direction is in {encrypt,
decrypt}. mode is in {ecb, cbc, cbcCheck, checksum}, of which checksum is not implemented. The implementation is as
per cedar RPC%'s DESDummy, which does NOT implement the official DES algorithms!)
(CheckKey key)
key←key:ARRAYP.BASE
(PROG ((newSeed (\DESScratchIV1:ARRAYP.BASE))
(seed (\DESScratchIV2:ARRAYP.BASE)))
(SELECTQ mode
(checkSum (Signal 'NotImplemented
mode))
[cbcCheck (if (ARRAYP uSeed)
then (\BLT seed uSeed:ARRAYP.BASE 4)
else (Signal 'InvalidSeed
uSeed))
(if (AND direction= 'encrypt
(IGREATERP nBlks 0))
then (bind (lastBlk ←(\ADDBASE from (LLSH (SUB1 nBlks)
2)))
for i from 0 to (LLSH nBlks-2 2) by 4
do (XOR64 lastBlk (\ADDBASE from i)
lastBlk]
(cbc (if (ARRAYP uSeed)
then (\BLT seed uSeed:ARRAYP.BASE 4)
else (Signal 'InvalidSeed
uSeed)))
(ecb)
(Signal 'InvalidMode
mode))
[for i from 0 to (LLSH nBlks-1 2) by 4
do (if mode~=%'ecb
then (SELECTQ direction
(encrypt (XOR64 (\ADDBASE from i)
seed
(\ADDBASE from i)))
(decrypt (\BLT newSeed (\ADDBASE from i)
4))
(Signal 'InvalidDirection
direction)))
(XOR64 key (\ADDBASE from i)
(\ADDBASE to i))
(if mode~=%'ecb
then (SELECTQ direction
(encrypt seed← (\ADDBASE to i))
(decrypt (XOR64 (\ADDBASE to i)
seed
(\ADDBASE to i))
(\BLT seed newSeed 4))
(SHOULDNT]
(if (AND mode= 'cbcCheck
direction=
'decrypt
(IGREATERP nBlks 0))
then (bind (lastBlk ←(\ADDBASE to (LLSH (SUB1 nBlks)
2)))
for i from 0 to (LLSH nBlks-2 2) by 4 do (XOR64 lastBlk (\ADDBASE to i)
lastBlk])
(EncryptBlock
[LAMBDA (key from to) (* ht: "25-Sep-84 17:03")
(CryptData key 1 from to 'encrypt
'ecb])
(DecryptBlock
[LAMBDA (key from to) (* ht: "27-Sep-84 17:47")
(CryptData key 1 from to 'decrypt
'ecb])
(GetRandomCryptKey
[LAMBDA NIL (* ht: "25-Sep-84 09:15")
(CorrectParity (GetRandomIV])
(GetRandomIV
[LAMBDA NIL (* ht: "25-Sep-84 09:15")
(RANDSET T)
(bind (iv←(ARRAY 8 '(BITS 8)
0 0))
for i from 0 to 7 do ((ELT iv i)←(RAND 0 255)) finally (RETURN iv])
(MakeCryptKey
[LAMBDA (string) (* ht: "25-Sep-84 08:56")
(CorrectParity (GV.MAKEKEY string)
OddParity])
(ParityTable
[LAMBDA (oneBits) (* ht: "25-Sep-84 07:57")
(bind (res ←(ARRAY (LENGTH oneBits)
'BIT
0 0))
for bit in oneBits as i from 0 when bit do ((ELT res i)←1) finally (RETURN res])
(XOR64
[LAMBDA (inp1 inp2 outp) (* ht: "25-Sep-84 07:43")
[for i from 3 by -1 to 0 do (\PUTBASE (\ADDBASE outp i)
0
(LOGXOR (\GETBASE (\ADDBASE inp1 i)
0)
(\GETBASE (\ADDBASE inp2 i)
0]
outp])
)
(RPAQQ EvenParityFor7Bits (T NIL NIL T NIL T T NIL NIL T T NIL T NIL NIL T NIL T T NIL T NIL NIL T
T NIL NIL T NIL T T NIL NIL T T NIL T NIL NIL T T NIL NIL T NIL T T
NIL T NIL NIL T NIL T T NIL NIL T T NIL T NIL NIL T NIL T T NIL T NIL
NIL T T NIL NIL T NIL T T NIL T NIL NIL T NIL T T NIL NIL T T NIL T
NIL NIL T T NIL NIL T NIL T T NIL NIL T T NIL T NIL NIL T NIL T T NIL
T NIL NIL T T NIL NIL T NIL T T NIL))
(RPAQ OddParity (ParityTable EvenParityFor7Bits))
(RPAQ DESNullKey (PROGN (* note that this has incorrect parity)
(ARRAY 8 '(BITS 8)
0 0)))
(RPAQ \DESScratchIV1 (ARRAY 8 '(BITS 8)
0 0))
(RPAQ \DESScratchIV2 (ARRAY 8 '(BITS 8)
0 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS EvenParityFor7Bits OddParity DESNullKey \DESScratchIV1 \DESScratchIV2)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \DESBlockSize 4)
(CONSTANTS (\DESBlockSize 4))
)
(FILESLOAD SIGNAL)
(PUTPROPS CRYPT COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1326 6214 (CheckKey 1336 . 1635) (CorrectParity 1637 . 2131) (CryptData 2133 . 4605) (
EncryptBlock 4607 . 4772) (DecryptBlock 4774 . 4939) (GetRandomCryptKey 4941 . 5096) (GetRandomIV 5098
. 5386) (MakeCryptKey 5388 . 5560) (ParityTable 5562 . 5874) (XOR64 5876 . 6212)))))
STOP