MODULE CryptoDES;
IMPORT S := SYSTEM, Ciphers := CryptoCiphers, U := CryptoUtils, Out := KernelLog, Files;
CONST
datafile = "CryptoDES.Data";
TYPE
Block* = ARRAY 2 OF SET;
KeyBlock = ARRAY 32 OF SET;
VAR
skb : ARRAY 8, 64 OF SET;
T : ARRAY 8, 64 OF SET;
TYPE
Cipher* = OBJECT (Ciphers.Cipher)
VAR
keys: KeyBlock;
iv: Block;
PROCEDURE InitKey*( CONST src: ARRAY OF CHAR; pos: LONGINT; keybits: LONGINT );
CONST Shifts = {2..7, 9..14}; Mask28 = {0..27};
VAR c, d, t, s: SET; i, j: LONGINT;
BEGIN
ASSERT( keybits = 64 );
InitKey^( src, pos, keybits );
c := U.LESetFrom( src, pos );
d := U.LESetFrom( src, pos + 4 );
perm( d, c, 4, 0F0F0F0FH );
hperm( c ); hperm( d );
perm( d, c, 1, 55555555H );
perm( c, d, 8, 00FF00FFH );
perm( d, c, 1, 55555555H );
d := S.LSH( d*{0..7}, 16 ) + d*{8..15} + S.LSH( d, -16 )*{0..7} + S.LSH( c, -4 )*{24..27};
c := c*Mask28;
FOR i := 0 TO 15 DO
IF i IN Shifts THEN
c := (S.LSH( c, -2 ) + S.LSH( c, 26 ))*Mask28;
d := (S.LSH( d, -2 ) + S.LSH( d, 26 ))*Mask28;
ELSE
c := (S.LSH( c, -1 ) + S.LSH( c, 27 ))*Mask28;
d := (S.LSH( d, -1 ) + S.LSH( d, 27 ))*Mask28;
END;
s :=
skb[0, sm( c, 0, 3FH )] +
skb[1, sm( c, -6, 03H ) + sm( c, -7, 3CH )] +
skb[2, sm( c, -13, 0FH ) + sm( c, -14, 30H )] +
skb[3, sm( c, -20, 01H ) + sm( c, -21, 06H ) + sm( c, -22, 38H )];
t :=
skb[4, sm( d, 0, 3FH )] +
skb[5, sm( d, -7, 03H ) + sm( d, -8, 3CH )] +
skb[6, sm( d, -15, 3FH )] +
skb[7, sm( d, -21, 0FH ) + sm( d, -22, 30H )];
j := 2*i;
keys[j] := S.ROT( S.LSH( t, 16 ) + s*{0..15}, -30 );
keys[j+1] := S.ROT( S.LSH( s, -16 ) + t*{16..31}, -26 )
END;
END InitKey;
PROCEDURE SetIV*( CONST src: ARRAY OF CHAR; p: LONGINT );
BEGIN
SetIV^( src, p );
U.CharsToBlockLE( src, p, iv )
END SetIV;
PROCEDURE Encrypt*( VAR buf: ARRAY OF CHAR; ofs, len: LONGINT );
VAR i: LONGINT; b: Block;
BEGIN
ASSERT( isKeyInitialized );
ASSERT( len MOD blockSize = 0 );
i := 0;
WHILE i < len DO
U.CharsToBlockLE( buf, ofs + i, b );
IF mode = Ciphers.CBC THEN U.XORBlock( b, iv ) END;
IP( b[0], b[1] );
Encrypt0( b );
FP( b[0], b[1] );
U.BlockToCharsLE( b, buf, ofs + i );
IF mode = Ciphers.CBC THEN iv := b END;
INC( i, blockSize )
END
END Encrypt;
PROCEDURE Encrypt0*( VAR block: Block );
VAR r, l: SET; i: LONGINT;
BEGIN
r := block[0]; l := block[1];
l := S.ROT( l, -29 ); r := S.ROT(r, -29 );
FOR i := 0 TO 7 DO
Round( l, r, 4*i + 0 );
Round( r, l, 4*i + 2 );
END;
block[0] := S.ROT( l, -3 ); block[1] := S.ROT( r, -3 );
END Encrypt0;
PROCEDURE Decrypt*( VAR buf: ARRAY OF CHAR; ofs, len: LONGINT );
VAR i: LONGINT; b0, b: Block;
BEGIN
ASSERT( isKeyInitialized );
ASSERT( len MOD blockSize = 0 );
i := 0;
WHILE i < len DO
U.CharsToBlockLE( buf, ofs + i, b );
IF mode = Ciphers.CBC THEN b0 := b END;
IP( b[0], b[1] );
Decrypt0( b );
FP( b[0], b[1] );
IF mode = Ciphers.CBC THEN U.XORBlock( b, iv ); iv := b0 END;
U.BlockToCharsLE( b, buf, ofs + i );
INC( i, blockSize )
END
END Decrypt;
PROCEDURE Decrypt0*( VAR block: Block );
VAR r, l: SET; i: LONGINT;
BEGIN
r := block[0]; l := block[1];
l := S.ROT( l, -29 ); r := S.ROT(r, -29 );
FOR i := 7 TO 0 BY -1 DO
Round( l, r, 4*i + 2 );
Round( r, l, 4*i + 0 );
END;
block[0] := S.ROT( l, -3 ); block[1] := S.ROT( r, -3 );
END Decrypt0;
PROCEDURE Round( VAR l, r: SET; i: LONGINT );
VAR a0, a1, a2, a3, b0, b1, b2, b3: LONGINT;
BEGIN
split( r / keys[i], b0, b1, b2, b3 );
split( S.ROT( r / keys[i + 1], -4 ), a0, a1, a2, a3 );
l := l / ( T[0, b0] / T[2, b1] / T[4, b2] / T[6, b3] / T[1, a0] / T[3, a1] / T[5, a2] / T[7, a3] );
END Round;
PROCEDURE & Init*;
BEGIN
SetNameAndBlocksize( "des", 8 );
END Init;
END Cipher;
PROCEDURE NewCipher*(): Ciphers.Cipher;
VAR cipher: Cipher;
BEGIN
NEW( cipher ); RETURN cipher
END NewCipher;
PROCEDURE hperm( VAR a: SET );
VAR t: SET;
BEGIN
t := (S.LSH( a, 18 ) / a)*S.VAL( SET, LONGINT( 0CCCC0000H ) );
a := a / t / S.LSH( t, -18 )
END hperm;
PROCEDURE perm( VAR a, b: SET; n, m: LONGINT );
VAR t: SET;
BEGIN
t := (S.LSH( a, -n ) / b)*S.VAL( SET, m );
b := b / t;
a := a / S.LSH( t, n )
END perm;
PROCEDURE sm( s: SET; n, m: LONGINT ): LONGINT;
BEGIN
RETURN S.VAL( LONGINT, S.LSH( s, n )*S.VAL( SET, m ) );
END sm;
PROCEDURE IP*( VAR l, r: SET );
BEGIN
perm( r, l, 4, 0F0F0F0FH );
perm( l, r, 16, 0000FFFFH );
perm( r, l, 2, 33333333H );
perm( l, r, 8, 00FF00FFH );
perm( r, l, 1, 55555555H );
END IP;
PROCEDURE FP*( VAR l, r: SET );
BEGIN
perm( r, l, 1, 55555555H );
perm( l, r, 8, 00FF00FFH );
perm( r, l, 2, 33333333H );
perm( l, r, 16, 0000FFFFH );
perm( r, l, 4, 0F0F0F0FH );
END FP;
PROCEDURE split( s: SET; VAR i0, i1, i2, i3: LONGINT );
BEGIN
i0 := S.VAL( LONGINT, S.LSH( s, -2 ) ) MOD 40H;
i1 := S.VAL( LONGINT, S.LSH( s, -10 ) ) MOD 40H;
i2 := S.VAL( LONGINT, S.LSH( s, -18 ) ) MOD 40H;
i3 := S.VAL( LONGINT, S.LSH( s, -26 ) ) MOD 40H;
END split;
PROCEDURE StringToKey*( CONST str: ARRAY OF CHAR; VAR key: ARRAY OF CHAR );
VAR i, l, ll, j, k: LONGINT; skey: ARRAY 8 OF SET; s: SET; odd: BOOLEAN;
BEGIN
FOR i := 0 TO 7 DO skey[i] := {} END;
FOR i := 0 TO LEN( str ) - 1 DO
l := ORD( str[i] );
IF i MOD 16 < 8 THEN
k := i MOD 8;
skey[k] := skey[k] / S.VAL( SET, l*2 );
ELSE
ll := 0; k := 7 - (i MOD 8);
FOR j := 0 TO 7 DO
ll := 2 * ll;
IF ODD( l ) THEN INC( ll ) END;
l := l DIV 2
END;
skey[k] := skey[k] / S.VAL( SET, ll )
END
END;
FOR i := 0 TO 7 DO
s := skey[i]; odd := FALSE;
FOR j := 0 TO 7 DO
IF j IN s THEN odd := ~odd END
END;
IF ~odd THEN
IF 0 IN s THEN EXCL( s, 0 ) ELSE INCL( s, 0 ) END;
skey[i] := s
END;
END;
FOR i := 0 TO 7 DO key[i] := CHR( S.VAL( LONGINT, skey[i] ) ) END
END StringToKey;
PROCEDURE Init;
VAR
i, j, val: LONGINT;
r: Files.Reader;
f: Files.File;
token: ARRAY 64 OF CHAR;
PROCEDURE FError;
BEGIN
Out.String( "Format error in " ); Out.String( datafile ); Out.String( ", pos " );
Out.Int( r.Pos(), 1 ); Out.Ln
END FError;
BEGIN
f := Files.Old( datafile );
IF f = NIL THEN
Out.String( "File '" ); Out.String( datafile ); Out.String( "' not found" ); Out.Ln
ELSE
Files.OpenReader( r, f, 0 ); r.SkipWhitespace; r.Token( token );
IF token # "des.skb" THEN FError; RETURN END;
FOR i := 0 TO 7 DO
FOR j := 0 TO 63 DO
IF r.GetInteger( val, TRUE ) THEN skb[i, j] := S.VAL( SET, val )
ELSE FError; RETURN
END
END;
END;
r.SkipWhitespace; r.Token( token );
IF token # "des.SPtrans" THEN FError; RETURN END;
FOR i := 0 TO 7 DO
FOR j := 0 TO 63 DO
IF r.GetInteger( val, TRUE ) THEN T[i, j] := S.VAL( SET, val )
ELSE FError; RETURN
END
END;
END;
END
END Init;
BEGIN
ASSERT( S.VAL( LONGINT, {0} ) = 1 );
Init
END CryptoDES.