(* Ulm's Oberon Library
   Copyright (C) 1989-1997 by University of Ulm, SAI, D-89069 Ulm, Germany
   ----------------------------------------------------------------------------
   Ulm's Oberon Library is free software; you can redistribute it
   and/or modify it under the terms of the GNU Library General Public
   License as published by the Free Software Foundation; either version
   2 of the License, or (at your option) any later version.

   Ulm's Oberon Library is distributed in the hope that it will be
   useful, but WITHOUT ANY WARRANTY; without even the implied warranty
   of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Library General Public License for more details.

   You should have received a copy of the GNU Library General Public
   License along with this library; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   ----------------------------------------------------------------------------
   E-mail contact: oberon@mathematik.uni-ulm.de
   ----------------------------------------------------------------------------
   $Id: TCrypt.om,v 1.1 1997/04/02 11:54:02 borchert Exp borchert $
   ----------------------------------------------------------------------------
   $Log: TCrypt.om,v $
   Revision 1.1  1997/04/02  11:54:02  borchert
   Initial revision

   ----------------------------------------------------------------------------
*)

MODULE ulmTCrypt; (* Michael Szczuka *)

   (* Trautner's association method for key exchange *)

   IMPORT AsymmetricCiphers := ulmAsymmetricCiphers, BlockCiphers := ulmBlockCiphers, Ciphers := ulmCiphers, Conclusions := ulmConclusions, Events := ulmEvents,
      NetIO := ulmNetIO, PersistentObjects := ulmPersistentObjects, Random := ulmRandomGenerators, RelatedEvents := ulmRelatedEvents,
      Services := ulmServices, Streams := ulmStreams, SYS := SYSTEM;

   CONST 
      M = 16; (* size of an element of CC(M) [ring of Circular Convolution] *)
      MaxVar = 8;   (* number of variables of a polynomial *)
      MaxNrExp = 4;  (* maxiumum number of different exponts used during
			initialisaton *)
      Dim = 2;  (* dimension of the linear recursion *)
      Rounds = 16;   (* length of the linear recursion in rounds *)
      LastRounds = 4;   (* use the last LastRounds polynomial vectors as 
			   the composed function eta *)
      reg = 1;  sing = 2;  random = 3;
      LIST = TRUE; NOLIST = FALSE;
      MaxTerms = 1000;

   CONST
      writeSetFailed = 0;
      readSetFailed = 1;
      notRegular = 2;
      errorcodes = 3;

   TYPE
      (* an element out of CC(M) *)
      CCMElement = SET;
      Exponent = ARRAY MaxVar OF SHORTINT;

   TYPE
      (* a polynomial with coefficients out of CC(M) *)
      Polynom = POINTER TO PolynomRec;
      PolynomRec = RECORD
	 koeff : CCMElement;
	 exp : Exponent; 
	 next : Polynom;
      END;

   TYPE
      VektorCCM = ARRAY Dim OF CCMElement;
      VektorPolynom = ARRAY Dim OF Polynom;
      MatCCM = ARRAY Dim, Dim OF CCMElement;
      MatPolynom = ARRAY Dim, Dim OF Polynom;
      ListCCM = ARRAY Rounds OF CCMElement;
      ListPolynom = ARRAY Rounds OF Polynom;
      ChainCCM = ARRAY Rounds OF VektorCCM;
      ChainPolynom = ARRAY Rounds OF VektorPolynom;
      (* to increase the performance of the algorithm there shouldn't be too
	 many different exponents to start with  *)
      ListExp = ARRAY MaxNrExp OF Exponent;

   TYPE
      (* this type is the input of the TCrypt method *)
      TCryptInput = POINTER TO TCryptInputRec;
      TCryptInputRec = RECORD
	 arg : ARRAY MaxVar OF CCMElement;
      END;

   TYPE
      (* result type after encryption with the public key *)
      TCryptTmp = POINTER TO TCryptTmpRec;
      TCryptTmpRec = RECORD
	 numerator : ChainCCM;
	 denominator : ListCCM;
      END;

   TYPE
      (* result type of the algorithm *)
      TCryptRes = POINTER TO TCryptResRec;
      TCryptResRec = RECORD
	 arg : ARRAY LastRounds OF VektorCCM;
      END;

   TYPE
      (* this type represents the public function f resp. phi *)
      Phi = POINTER TO PhiRec;
      PhiRec = RECORD
	 num :  ChainPolynom;
	 denom : ListPolynom;
      END;

   TYPE
      (* the private/secret function g resp. psi consisting of an inital matrix
	 and a permutation *)
      Psi = POINTER TO PsiRec;
      PsiRec = RECORD
	 (* although the inital matrix consists only of elements out of CC(M)
	    this generalization is useful since all other matrces consist of
	    polynomials *)
	 initialmatrix : MatCCM;
	 (* correcting factors *)
	 korrNum : ChainCCM;
	 korrDenom : ListCCM;
      END;

   (* the public function h resp. eta being the composition of f/phi
      and g/psi *)
   TYPE 
      Eta = POINTER TO EtaRec;
      EtaRec = RECORD
	 p : ARRAY LastRounds OF VektorPolynom;
      END;

   TYPE
      (* the declaration of a basic type which PublicCipher and PrivateCipher
	 are descendents from seems a good idea ... at least to me :)  *)
      Cipher* = POINTER TO CipherRec;
      CipherRec* = RECORD (AsymmetricCiphers.CipherRec) END;
      (* the specific format of a public key for Trautner's technique *)
      PublicCipher = POINTER TO PublicCipherRec;
      PublicCipherRec = RECORD
	 (CipherRec)
	 phi : Phi;
	 eta : Eta;
      END;
      (* the specific format of a key for Trautner's technique *)
      PrivateCipher = POINTER TO PrivateCipherRec;
      PrivateCipherRec = RECORD
	 (CipherRec)
	 phi : Phi;
	 psi : Psi;
	 eta : Eta;
      END;

   TYPE
      ErrorEvent = POINTER TO ErrorEventRec;
      ErrorEventRec = RECORD
	 (Events.EventRec)
	 errorcode : SHORTINT;
      END;

   VAR
      pubType, privType, cipherType : Services.Type;
      pubIf, privIf, cipherIf : PersistentObjects.Interface;
      NullCCM, EinsCCM : CCMElement;   (* the zero and unit of CC(M) *)
      NullExp : Exponent;	(* consists of zero exponents *)
      NullExpList : ListExp;  (* a pseudo list for CreatePolynom *)
      GlobalExpList : ListExp;  (* contains the exponents which should be used
				   when calling CreatePolynom *)
      NullPolynom : Polynom;  (* the zero polynomial *)
      PolFeld : ARRAY MaxTerms OF Polynom;  (* used for sorting purposes *)
      PreEvalArg : ARRAY M OF TCryptInput;  (* precomputed values to speed 
	   up evaluation of a polynomial *)
      k : SHORTINT;  (* simple counter during initialisation *)
      error : Events.EventType;
      errormsg : ARRAY errorcodes OF Events.Message;


   (* ***** error handling ***** *)

   PROCEDURE InitErrorHandling;
   BEGIN
      Events.Define(error);
      errormsg[writeSetFailed] := "couldn't write set";
      errormsg[readSetFailed] := "couldn't read set";
      errormsg[notRegular] := "element isn't regular";
   END InitErrorHandling;

   PROCEDURE Error(s: Streams.Stream; errorcode: SHORTINT);
      VAR
	 event: ErrorEvent;
   BEGIN
      NEW(event);
      event.message := errormsg[errorcode];
      event.type := error;
      event.errorcode := errorcode;
      RelatedEvents.Raise(s, event);
   END Error;

   (* ***** arithmetic functions for elements out of CC(M) ***** *)

   PROCEDURE RegulaerCCM (x: CCMElement) : BOOLEAN;
      (* tests x for regularity [a regular CCMElement contains an odd number of
	 set bits]; returns TRUE when x is regular, FALSE otherwise *)
      VAR
	 res, i : SHORTINT;
   BEGIN
      i := 0;
      res := 0;
      REPEAT		(* counting the set bits *)
	 IF i IN x THEN
	    INC(res);
	 END;
	 INC(i);
      UNTIL i>=M;
      RETURN ((res MOD 2) = 1);
   END RegulaerCCM;

   PROCEDURE EqualCCM (x, y: CCMElement) : BOOLEAN;
      (* compares x and y for equality; if x and y are equal TRUE is returned,
	 FALSE otherwise *)
      VAR
	 i : SHORTINT;
   BEGIN
      i := 0;
      WHILE i < M DO
	 IF ((i IN x) & (~(i IN y))) OR ((~(i IN x)) & (i IN y)) THEN
	    RETURN FALSE;
	 END;
	 INC(i);
      END;
      RETURN TRUE;
   END EqualCCM;

   PROCEDURE AddCCM (x, y: CCMElement; VAR z: CCMElement);
      (* add x and y in CC(M) *)
      VAR
	 i : SHORTINT;
   BEGIN
      z := NullCCM;
      i := 0;
      REPEAT
	 IF ((i IN x) & (~(i IN y))) OR ((~(i IN x)) & (i IN y)) THEN
	    z := z + {i};
	 END;
	 INC(i);
      UNTIL i>=M;
   END AddCCM;

   PROCEDURE MulCCM (x, y: CCMElement; VAR z: CCMElement);
      (* multiply x and y in CC(M) *)
      VAR
	 i, j, diff : SHORTINT;
	 tmp : INTEGER;
   BEGIN
      z := NullCCM;
      i := 0; 
      REPEAT
	 j := 0;
	 tmp := 0;
	 REPEAT
	    diff := i-j;
	    IF diff >= 0 THEN
	       IF (j IN x) & (diff IN y) THEN
		  INC(tmp);
	       END;
	    ELSE
	       IF (j IN x) & ((M+diff) IN y) THEN
		  INC(tmp);
	       END;
	    END;
	    INC(j);
	 UNTIL j>=M;
	 IF (tmp MOD 2) = 1 THEN
	    z := z + {i};
	 END;
	 INC(i);
      UNTIL i>=M;
   END MulCCM;

   PROCEDURE PowerCCM (x: CCMElement; exp: INTEGER; VAR z: CCMElement);
      (* raises x to the power exp in CC(M) *)
      VAR
	 tmp : CCMElement;
   BEGIN
      (* some special cases first *)
      IF exp >= M THEN
	 IF ~RegulaerCCM(x) THEN
	 (* x is singular -> result is zero *)
	    z := NullCCM;
	    RETURN;
	 END;
	 (* x is regular -> compute the modulus of exp mod M and use this
	    instead of exp *)
	 exp := exp MOD M;
      END;
      IF exp = 0 THEN
	 z := EinsCCM;
	 RETURN;
      END;
      IF exp = 1 THEN
	 z := x;
	 RETURN;
      END;

      (* default case; use a "square and multiply" technique *)
      tmp := x;
      z := EinsCCM;
      REPEAT
	 IF exp MOD 2 = 1 THEN
	    MulCCM(z, tmp, z);
	 END;
	 exp := exp DIV 2;
	 MulCCM(tmp, tmp, tmp);
      UNTIL exp < 1;
   END PowerCCM;

   PROCEDURE CreateCCM (VAR x: CCMElement; mode: SHORTINT);
      (* creates a random element out of CC(M) depending on mode which
	 can be reg, sing or random;
	 the result is in any case different from the zero *)
      VAR
	 i, SetBits: SHORTINT;
   BEGIN
      x := NullCCM;
      REPEAT
	 i := 0;
	 SetBits := 0;
	 REPEAT
	    IF Random.Flip() THEN
	       (* set bit *)
	       x := x + {i};
	       INC(SetBits);
	    END;
	    INC(i);
	 UNTIL i >= (M-1);
      UNTIL SetBits > 0;   (* at least one bit must be set so that the result
			      differs from zero *)

      CASE mode OF
	 random:	
	    IF Random.Flip() THEN
	       x := x + {M-1};
	    END;
      |  sing: 		(* singular element - even # of bits *)
	    IF (SetBits MOD 2) = 1 THEN
	       x := x + {M-1};
	    END;
      |  reg:		(* regular element - odd # of bits *)
	    IF ((SetBits + 1) MOD 2) = 1 THEN
	       x := x + {M-1};
	    END;
      END;
   END CreateCCM;

   (* ***** arithmetic functions for polynomials over CC(M) ***** *)

   PROCEDURE LengthPolynom(p: Polynom) : INTEGER;
      (* returns the number of terms which make up the polynomial p *)
      VAR
	 i : INTEGER;
   BEGIN
      i := 0;
      WHILE p # NIL DO
	 INC(i);
	 p := p.next;
      END;
      RETURN i;
   END LengthPolynom;

   PROCEDURE RegulaerPolynom (p: Polynom) : BOOLEAN;
      (* tests the regularity of a polynomial [a polynomial is regular
	 iff the # of regular coefficients is odd] *)
      VAR
	 regkoeffs : SHORTINT;
   BEGIN
      regkoeffs := 0;
      WHILE p # NIL DO
	 IF RegulaerCCM(p.koeff) THEN
	 (* count # of reg. coefficients *)
	    INC(regkoeffs);
	 END;
	 p := p.next;
      END;
      RETURN (regkoeffs MOD 2) = 1;
   END RegulaerPolynom;

   PROCEDURE CmpExp (exp1, exp2: Exponent) : SHORTINT;
      (* compares two exponent vectors and returns 0 on equality, a
	 positive value if exp1>exp2 and a negative value if exp1<exp2;
	 the absolute value can be 1 or 2 : 2 if the sums of the
	 vectors differ, 1 otherwise; this distinction isn't used, but
	 it could be useful for later versions *)
      VAR
	 i : SHORTINT;
	 e1, e2: INTEGER; diff: BOOLEAN; cmp: SHORTINT;
	 sum1, sum2 : INTEGER;
   BEGIN
      i := 0;
      sum1 := 0; sum2 := 0; diff := FALSE; cmp := 0;
      REPEAT
	 e1 := exp1[i]; e2 := exp2[i];
	 INC(sum1, e1); INC(sum2, e2);
	 IF ~diff THEN
	    IF e1 < e2 THEN
	       cmp := -1; diff := TRUE;
	    ELSIF e1 > e2 THEN
	       cmp := 1; diff := TRUE;
	    END;
	 END;
	 INC(i);
      UNTIL i >= MaxVar;

      IF sum1 < sum2 THEN
	 RETURN -2;
      END;
      IF sum1 > sum2 THEN
	 RETURN 2;
      END;

      RETURN cmp
   END CmpExp;

   PROCEDURE ArrangePolynom (VAR p: Polynom);
      (* arrange a polynomial according to the order given by CmpExp *)
      VAR
	 r : Polynom;
	 cnt : INTEGER;

      PROCEDURE SortPolynom(left, right: INTEGER);
	 (* sort the global field PolFeld with the quicksort algorithm *)
	 VAR 
	    mid : INTEGER;

	 PROCEDURE Partition(l, r: INTEGER) : INTEGER;
	    VAR
	       koeff : CCMElement;
	       exp : Exponent;
	       cmp : Exponent;
	       i, j : INTEGER;
	 BEGIN
	    cmp := PolFeld[(l+r) DIV 2].exp;
	    i := l-1;
	    j := r+1;
	    LOOP
	       REPEAT
		  DEC(j);
	       UNTIL CmpExp(PolFeld[j].exp, cmp) >= 0;
	       REPEAT
		  INC(i);
	       UNTIL CmpExp(PolFeld[i].exp, cmp) <= 0;
	       IF i < j THEN
		  koeff := PolFeld[i].koeff;
		  exp := PolFeld[i].exp;
		  PolFeld[i].koeff := PolFeld[j].koeff;
		  PolFeld[i].exp := PolFeld[j].exp;
		  PolFeld[j].koeff := koeff;
		  PolFeld[j].exp := exp;
	       ELSE
		  RETURN j;
	       END;
	    END;
	 END Partition;

      BEGIN
	 IF left < right THEN
	    mid := Partition(left, right);
	    SortPolynom(left, mid);
	    SortPolynom(mid+1, right);
	 END;
      END SortPolynom;

   BEGIN (* ArrangePolynom *)
      IF p = NIL THEN
	 RETURN;
      END;
      r := p;
      cnt := 0;
      WHILE (p # NIL) & (cnt < MaxTerms) DO
	 PolFeld[cnt] := p;
	 INC(cnt);
	 p := p.next;
      END;
      (* polynomial contains too many terms; this shouldn't happen if all
	 parameters are set to reasonable values and MaxTerms is high
	 enough *)
      ASSERT(cnt<MaxTerms);
      IF cnt > 1 THEN
	 SortPolynom(0, cnt-1);
      END;
      p := r;
   END ArrangePolynom;

   PROCEDURE CopyPolynom (s: Polynom; VAR t: Polynom);
      (* copy the source polynomial s to a new target t *)
      VAR
	 troot : Polynom;
   BEGIN
      IF s = NIL THEN
	 t := NIL;
	 RETURN;
      END;
      NEW(t);
      troot := t;		(* save the root of t *)
      WHILE s # NIL DO
	 troot.koeff := s.koeff;
	 troot.exp := s.exp;
	 s := s.next;
	 IF s # NIL THEN
	    NEW(troot.next);
	    troot := troot.next;
	 ELSE
	    troot.next := NIL;
	 END;
      END;
   END CopyPolynom;

   PROCEDURE AddPolynom (p, q: Polynom; VAR r: Polynom);
      (* add two polynomial; the polynomials must be sorted by the exponents as
	 is the result *)
      VAR
	 term1, term2 : Polynom;	
	 last : Polynom;		(* the last term of the result *)
	 tmp : Polynom;
	 cmpres : SHORTINT;
   BEGIN
      IF (p = NIL) & (q = NIL) THEN
	 r := NIL;
	 RETURN;
      END;
      NEW(r);
      term1 := p;	(* term1 runs through all terms of p *)
      term2 := q;	(* same with term2 for q *)
      tmp := r;	(* save the root of r *)
      last := tmp;
      REPEAT
	 IF (term1 = NIL) OR (term2 = NIL) THEN
	    IF term2 = NIL THEN
	    (* no further terms in q *)
	       WHILE term1 # NIL DO
	       (* copy the remaining terms of p *)
		  tmp.koeff := term1.koeff;
		  tmp.exp := term1.exp;
		  term1 := term1.next;
		  IF ~EqualCCM(tmp.koeff, NullCCM) THEN
		     last := tmp;
		     NEW(tmp.next);
		     tmp := tmp.next;
		  END;
	       END;
	    ELSE   (* no further terms in p *)
	       WHILE term2 # NIL DO
		  tmp.koeff := term2.koeff;
		  tmp.exp := term2.exp;
		  term2 := term2.next;
		  IF ~EqualCCM(tmp.koeff, NullCCM) THEN
		     last := tmp;
		     NEW(tmp.next);
		     tmp := tmp.next;
		  END;
	       END;
	    END;
	 ELSE	(* both p and q still have a term *)
	    cmpres := CmpExp(term1.exp, term2.exp);
	    IF cmpres = 0 THEN	(* add when exponents are equal *)
	       AddCCM(term1.koeff, term2.koeff, tmp.koeff);
	       tmp.exp := term1.exp;
	       term1 := term1.next;
	       term2 := term2.next;
	    ELSE
	       IF cmpres < 0 THEN	(* exp2 > exp1 *)
		  tmp.koeff := term2.koeff;
		  tmp.exp := term2.exp;
		  term2 := term2.next;
	       ELSE			(* exp1 > exp2 *)
		  tmp.koeff := term1.koeff;
		  tmp.exp := term1.exp;
		  term1 := term1.next;
	       END;
	    END;
	    (* zero coefficients = zero terms shouldn't occur in the result *)
	    IF ~EqualCCM(tmp.koeff, NullCCM) THEN
	       NEW(tmp.next);
	       last := tmp;
	       tmp := tmp.next;
	    END;
	 END;
      UNTIL (term1 = NIL) & (term2 = NIL);

      (* forget last created term *)
      last.next := NIL;
   END AddPolynom;

   PROCEDURE MulTerm (p, term: Polynom; VAR r: Polynom);
      (* multiply a polynomial with a single term; is used by MulPolynom *)
      VAR
	 tmp : Polynom;
	 last : Polynom;

      (* add two exponent vetors; addition is modulo M *)
      PROCEDURE AddExp (exp1, exp2 : Exponent; VAR res: Exponent);
	 VAR
	    i : SHORTINT;
      BEGIN
	 i := 0;
	 WHILE i<MaxVar DO
	    res[i] := (exp1[i] + exp2[i]) MOD M;
	    INC(i);
	 END;
      END AddExp;

   BEGIN (* MulTerm *)
      IF (p = NIL) OR (term = NIL) THEN
	 r := NIL;
	 RETURN;
      END;
      NEW(r);
      tmp := r;		(* copy root *)
      last := r;
      WHILE p # NIL DO
	 (* multiply coefficients *)
	 MulCCM(p.koeff, term.koeff, tmp.koeff);
	 (* no zero terms allowed *)
	 IF ~EqualCCM(tmp.koeff, NullCCM) THEN
	    (* add exponents *)
	    AddExp(p.exp, term.exp, tmp.exp);
	    NEW(tmp.next);
	    last := tmp;
	    tmp := tmp.next;
	 END;
	 p := p.next;
      END;
      (* forget last term (is zero anyway) *)
      last.next := NIL;
      (* result must be arranged first before returned *)
      ArrangePolynom(r);
   END MulTerm;

   PROCEDURE MulPolynom (p, q: Polynom; VAR r: Polynom);
      (* multiply two polynomials over CC(M); must be sorted *)
      VAR
	 tmp, qterm : Polynom;
   BEGIN
      r := NIL;
      IF (p = NIL) OR (q = NIL) THEN
	 RETURN;
      END;
      qterm := q;
      WHILE qterm # NIL DO
	 MulTerm(p,qterm,tmp);	(* multiply p with current term of q *)
	 AddPolynom(tmp,r,r);	(* add up results *)
	 qterm := qterm.next;
      END;
      ArrangePolynom(r);
   END MulPolynom;

   PROCEDURE MulPolynomWithCCM (p: Polynom; c: CCMElement; VAR r: Polynom);
      (* multiplies a polynomial with a single element out of CC(M) *)
      VAR
	 tmp : Polynom;
   BEGIN
      IF p = NIL THEN
	 r := NIL;
	 RETURN;
      END;
      CopyPolynom(p, r);
      tmp := r;
      WHILE tmp # NIL DO
	 MulCCM(tmp.koeff, c, tmp.koeff);
	 tmp := tmp.next;
      END;
   END MulPolynomWithCCM;

   PROCEDURE InvertPolynom (p: Polynom; VAR res: Polynom);
      (* inverts a regular polynomial; if p is illegal (NIL) or singular the
	 result is NIL *)
      VAR
	 exp : SHORTINT;
	 tmp : Polynom;
   BEGIN
      IF (p = NIL) OR ~RegulaerPolynom(p) THEN
	 res := NIL;
	 RETURN;
      END;
      CopyPolynom(p, tmp);
      CopyPolynom(NullPolynom, res);
      res.koeff := EinsCCM;
      (* works the same way as PowerCCM ["square-and-multiply"] *)
      exp := M - 1;	(* inverse means "power M-1" *)
      WHILE exp > 0 DO
	 IF (exp MOD 2) = 1 THEN
	    MulPolynom(res, tmp, res);
	 END;
	 MulPolynom(tmp, tmp, tmp);
	 exp := exp DIV 2;
      END;
   END InvertPolynom;

   PROCEDURE EvalPolynom (p: Polynom; VAR res: CCMElement);
      (* evaluate p; a precomputed list of all the powers of the argument can
	 be found in the global variable PreEvalArg *)
      VAR
	 i : SHORTINT;
	 pow, prod : CCMElement;
   BEGIN
      res := NullCCM;
      IF p = NIL THEN
	 RETURN;
      END;
      WHILE p # NIL DO
	 prod := PreEvalArg[p.exp[0]].arg[0];
	 i := 1;
	 REPEAT
	    pow := PreEvalArg[p.exp[i]].arg[i];
	    MulCCM(prod, pow, prod);
	    INC(i);
	 UNTIL i >= MaxVar;
	 MulCCM(prod, p.koeff, prod);
	 AddCCM(res, prod, res);
	 p := p.next;
      END;
   END EvalPolynom;

   PROCEDURE CreateExp (VAR exp: Exponent);
      (* creates a random vector of exponents *)
      VAR
	 i : SHORTINT;
   BEGIN
      i := 0;
      WHILE i<MaxVar DO
	 exp[i] := SHORT(SHORT(Random.Val(0, M-1)));
	 INC(i);
      END;
   END CreateExp;

   PROCEDURE CreateExpList (VAR explist : ListExp);
      (* create a list of MaxNrExp different exponents *)
      VAR
	 i : SHORTINT;
   BEGIN
      i := 0;
      WHILE i < MaxNrExp DO
	 CreateExp(explist[i]);
	 INC(i);
      END;
   END CreateExpList;

   PROCEDURE CreatePolynom (VAR p: Polynom; terms: SHORTINT; mode: SHORTINT; 
			    UseList: BOOLEAN; explist: ListExp);
      (* creates a random polynomial depending on mode (can be reg,
	 sing or random);
	 if terms = 0 then the zero polynomial is returnded; if UseList
	 is TRUE the exponents of the new polynomial will not be
	 created entirely randomly but will be chosen form a list of
	 precomputed exponents *)
      VAR
	 regkoeffs, i : SHORTINT;
	 expindex : SHORTINT;
	 proot, tmp : Polynom;
	 doubleexp : BOOLEAN;

   BEGIN
      IF terms = 0 THEN
	 CopyPolynom(NullPolynom, p);
	 RETURN;
      END;

      NEW(p);
      proot := p;		(* save root of p *)
      regkoeffs := 0;	(* # of regular coeff. in p *)
      i := 0;
      WHILE i<terms DO
	 p.next := NIL;
	 REPEAT
	    tmp := proot;
	    doubleexp := FALSE;
	    IF UseList THEN
	       (* use one of the precomputed exponents *)
	       expindex := SHORT(SHORT(Random.Val(0, MaxNrExp-1)));
	       p.exp := explist[expindex];
	    ELSE
	       (* choose a exponent randomly *)
	       CreateExp(p.exp);
	    END;
	    (* run through polynomial and search for same exponent as the last
	       created *)
	    WHILE tmp.next # NIL DO
	       IF CmpExp(tmp.exp, p.exp) = 0 THEN
		  (* ok, found one; so we have to start again with this 
		     term *)
		  doubleexp := TRUE;
	       END;
	       tmp := tmp.next;
	    END;
	 UNTIL ~doubleexp;
	 INC(i);

	 (* the last term must be created manually so that the result is
	    regular/singular (depending on mode) *)
	 IF i # terms THEN
	    CreateCCM(p.koeff, random);
	    IF RegulaerCCM(p.koeff) THEN
	       INC(regkoeffs);
	    END;
	    NEW(p.next);
	    p := p.next;
	 END;
      END;

      CASE mode OF
	 random:
	    CreateCCM(p.koeff, random);
       | reg: 
	    IF (regkoeffs MOD 2) = 1 THEN
	       CreateCCM(p.koeff, sing);
	    ELSE
	       CreateCCM(p.koeff, reg);
	    END;
       | sing:
	    IF (regkoeffs MOD 2) = 0 THEN
	       CreateCCM(p.koeff, sing);
	    ELSE
	       CreateCCM(p.koeff, reg);
	    END;
      END;

      p := proot;
      (* arrange the result at last *)
      ArrangePolynom(p);
   END CreatePolynom;


   (* ***** arithmetic functions for matrices ***** *)

   PROCEDURE DetMatrix(mat: MatPolynom; VAR res: Polynom);
      (* computes the determinant of a matrix *)
      VAR
	 mul1, mul2, add : Polynom;
   BEGIN
      (* because of a rather unsatisfying performance, let's try the whole
	 thing with 2x2 matrices ... *)
      MulPolynom(mat[0][0], mat[1][1], mul1);
      MulPolynom(mat[0][1], mat[1][0], mul2);
      AddPolynom(mul1, mul2, res);
   END DetMatrix;

   PROCEDURE ChangeCol (mat: MatPolynom; vek: VektorPolynom; col: INTEGER;
			VAR res: MatPolynom);
      (* replaces the column #col in mat with vek *)
      VAR
	 dx, dy : INTEGER;
   BEGIN
      dx := 0;
      WHILE dx < Dim DO
	 dy := 0;
	 WHILE dy < Dim DO
	    IF dx = col THEN
	       CopyPolynom(vek[dy], res[dy][dx]);
	    ELSE
	       CopyPolynom(mat[dy][dx], res[dy][dx]);
	    END;
	    INC(dy);
	 END;
	 INC(dx);
      END;
   END ChangeCol;

   PROCEDURE ChooseInitialMatrix(VAR mat: MatPolynom);
      (* choose an initial matrix for the recursion *)
      VAR
	 dx, dy : SHORTINT;
   BEGIN
      (* the starting matrix consists only of regular components *)
      dy := 0;
      WHILE dy < Dim DO
	 dx := 0;
	 WHILE dx < Dim DO
	    CopyPolynom(NullPolynom, mat[dy][dx]);
	    CreateCCM(mat[dy][dx].koeff, reg);
	    INC(dx);
	 END;
	 INC(dy);
      END;
      CreateCCM(mat[1][1].koeff, sing);
   END ChooseInitialMatrix;

   PROCEDURE ChooseMatrix (VAR mat: MatPolynom; prev: MatPolynom;
			   vek: VektorPolynom);
      (* chooses a matrix for the next round of the recursion; the components of
	 the matrix are polynomials *)
   BEGIN
   (* the pattern of the matrix mat is given by a proposition by Trautner
      [see Trautner's work on TCRYPT II, p. 3.5] *)
   (* former versions used 4x4 matrices; now it's only 2x2 *)
      IF Dim # 2 THEN
	 RETURN;
      END;
      CopyPolynom(prev[0][1], mat[0][0]);
      CopyPolynom(prev[1][1], mat[1][0]);
      CopyPolynom(vek[0], mat[0][1]);
      CopyPolynom(vek[1], mat[1][1]);
   END ChooseMatrix;

   PROCEDURE MulMatrix (mat: MatCCM; col: VektorCCM; VAR res: VektorCCM);
      (* multiplies the matrix mat with the vector col *)
      VAR
	 x, y : SHORTINT;
	 addres, mulres : CCMElement;
   BEGIN
      x := 0;
      WHILE x < Dim DO
	 y := 0;
	 addres := NullCCM;
	 WHILE y < Dim DO
	    MulCCM(mat[x][y], col[y], mulres);
	    AddCCM(addres, mulres, addres);
	    INC(y);
	 END;
	 res[x] := addres;
	 INC(x);
      END;
   END MulMatrix;

   PROCEDURE BuildMatrix (VAR mat: MatCCM; prev: MatCCM; vek: VektorCCM);
      (* build a new matrix for the evaluation recursion *)
   BEGIN
      mat[0][0] := prev[0][1];
      mat[1][0] := prev[1][1];
      mat[0][1] := vek[0];
      mat[1][1] := vek[1];
   END BuildMatrix;


   (* ***** basis functions of the TCRYPT algorithm ***** *)

   PROCEDURE CreateMaps (VAR phi: Phi; VAR psi: Psi; 
			 VAR eta: Eta);
      (* create random but suiting maps phi, psi and eta for a pair of
	 public and private keys *)
   VAR
      r, d, idx : SHORTINT;
      regindex, singindex : SHORTINT;
      dx, dy : SHORTINT;
      A : ChainPolynom;
      E : ARRAY Rounds OF MatPolynom;
      num : ChainPolynom;
      tmpKorr : CCMElement;
      korrNum : ChainCCM;
      denom : ListPolynom;
      korrDenom : ListCCM;
      mat : MatPolynom;

   BEGIN
      (* choose a sequence of polynomial vectors A(n), n=1,..,Rounds *)
      (* the vectors have to suffice a specific pattern so that the
	 matrices during the recursion will be regular *)
      r := 0;
      WHILE r < (Rounds-1) DO
	 CreatePolynom(A[r][0], 2, reg, NOLIST, GlobalExpList);
	 IF ODD(r) THEN
	    CreatePolynom(A[r][1], 2, sing, NOLIST, GlobalExpList);
	 ELSE
	    CreatePolynom(A[r][1], 2, reg, NOLIST, GlobalExpList);
	 END;
	 INC(r);
      END;
      (* the last vector can be choosen randomly *)
      d := 0;
      WHILE d < Dim DO
	 CreatePolynom(A[Rounds-1][d], 2, random, NOLIST, GlobalExpList);
	 INC(d);
      END;

      (* choose a starting matrix for the recrusion *)
      ChooseInitialMatrix(E[0]);

      (* chosse the following matrices E(n) of the recursion *)
      r := 1;
      WHILE r < Rounds DO
	 (* choose a matrix E(r) for the next round of the recursion *)
	 ChooseMatrix(E[r], E[r-1], A[r-1]);
	 INC(r);
      END;

      r := 0;
      (* with the knowledge of E(n) and A(n) the a(n) can be computed
	 by using Cramer's rule *)
      (* the elements of the a(n) are multiplied with randomly chosen
	 regular constants and the corresponding inverts are stored in
	 the private part; this is used for purposes of informtaion hiding
	 in the public part *)
      WHILE r < Rounds DO
	 (* compute determinant of current matrix = denominator of fraction *)
	 DetMatrix(E[r], denom[r]);
	 CreateCCM(tmpKorr, reg);
	 (* multiply it with a correction factor ... *)
	 MulPolynomWithCCM(denom[r], tmpKorr, denom[r]);
	 (* ... and store the invert *)
	 PowerCCM(tmpKorr, M-1, korrDenom[r]);
	 d := 0;
	 WHILE d < Dim DO
	    (* compute the numerators and apply same technique like above *)
	    ChangeCol(E[r], A[r], d, mat);
	    DetMatrix(mat, num[r][d]);
	    CreateCCM(tmpKorr, reg);
	    MulPolynomWithCCM(num[r][d], tmpKorr, num[r][d]);
	    PowerCCM(tmpKorr, M-1, korrNum[r][d]);
	    INC(d);
	 END;
	 INC(r);
      END;

      (* a(n), n=1,...,Rounds, := phi *)
      NEW(phi);
      r := 0;
      WHILE r < Rounds DO
	 d := 0;
	 WHILE d < Dim DO
	    CopyPolynom(num[r][d], phi.num[r][d]);
	    INC(d);
	 END;
	 CopyPolynom(denom[r], phi.denom[r]);
	 INC(r);
      END;

      (* E(n), n=1,...,Rounds, und sigma := psi *)
      NEW(psi);
      dy := 0;
      WHILE dy < Dim DO
	 dx := 0;
	 WHILE dx < Dim DO
	    psi.initialmatrix[dy][dx] := E[0][dy][dx].koeff;
	    INC(dx);
	 END;
	 INC(dy);
      END;
      r := 0;
      WHILE r < Rounds DO
	 d := 0;
	 WHILE d < Dim DO
	    psi.korrNum[r][d] := korrNum[r][d];
	    INC(d);
	 END;
	 psi.korrDenom[r] := korrDenom[r];
	 INC(r);
      END;

      (* A(Rounds) := eta *)
      NEW(eta);
      r := 0;
      idx := Rounds - LastRounds;
      WHILE idx < Rounds DO
	 d := 0;
	 WHILE d < Dim DO
	    CopyPolynom(A[idx][d], eta.p[r][d]);
	    INC(d);
	 END;
	 INC(r);
	 INC(idx);
      END;
   END CreateMaps;

   PROCEDURE PreComputeArgs(arg: TCryptInput);
      (* used for preevaluation of a polynomial argument *)
      VAR
	 k, i, kk, ii : INTEGER;
	 tmp : CCMElement;
   BEGIN
      i := 0;
      WHILE i < MaxVar DO
	 PreEvalArg[1].arg[i] := arg.arg[i];
	 INC(i);
      END;
      i := 0;
      WHILE i < MaxVar DO
	 k := 2;
	 tmp := arg.arg[i];
	 WHILE k < M DO
	    MulCCM(tmp, tmp, tmp);
	    PreEvalArg[k].arg[i] := tmp;
	    INC(k,k);
	 END;
	 k := 3;
	 WHILE k < M DO
	    kk := k;
	    ii := 1;
	    tmp := EinsCCM;
	    WHILE kk > 0 DO
	       IF (kk MOD 2) = 1 THEN
		  MulCCM(tmp, PreEvalArg[ii].arg[i], tmp);
	       END;
	       INC(ii,ii);
	       kk := kk DIV 2;
	    END;
	    PreEvalArg[k].arg[i] := tmp;
	    INC(k);
	 END;
	 INC(i);
      END;
   END PreComputeArgs;

   PROCEDURE EvaluatePhi (arg: TCryptInput; data: Phi) : TCryptTmp;
      (* evaluate the public function phi (represented by data) with
	 argument arg *)
      VAR
	 res : TCryptTmp;
	 r, d : SHORTINT;
   BEGIN
      NEW(res);
      PreComputeArgs(arg);
      r := 0;
      WHILE r < Rounds DO
	 d := 0;
	 WHILE d < Dim DO
	    EvalPolynom(data.num[r][d], res.numerator[r][d]);
	    INC(d);
	 END;
	 EvalPolynom(data.denom[r], res.denominator[r]);
	 INC(r);
      END;
      RETURN res;
   END EvaluatePhi;

   PROCEDURE EvaluatePsi (arg: TCryptTmp; data: Psi) : TCryptRes;
      (* evalute the private function psi *)
      VAR
	 res : TCryptRes;
	 mat, prev : MatCCM;
	 num, denom, inv : CCMElement;
	 vek : VektorCCM;
	 A : ChainCCM;
	 r, d : SHORTINT;
   BEGIN
      (* first correct the input with the correlating inverts *)
      MulCCM(arg.denominator[0], data.korrDenom[0], denom);
      PowerCCM(denom, M-1, inv);
      MulCCM(arg.numerator[0][0], data.korrNum[0][0], num);
      MulCCM(num, inv, vek[0]);
      MulCCM(arg.numerator[0][1], data.korrNum[0][1], num);
      MulCCM(num, inv, vek[1]);
      MulMatrix(data.initialmatrix, vek, A[0]);
      prev := data.initialmatrix;
      r := 1;
      WHILE r < Rounds DO
	 (* the matrix for the current round of the recursion must be computed
	    each round *)
	 BuildMatrix(mat, prev, A[r-1]);
	 prev := mat;
	 MulCCM(arg.denominator[r], data.korrDenom[r], denom);
	 PowerCCM(denom, M-1, inv);
	 MulCCM(arg.numerator[r][0], data.korrNum[r][0], num);
	 MulCCM(num, inv, vek[0]);
	 MulCCM(arg.numerator[r][1], data.korrNum[r][1], num);
	 MulCCM(num, inv, vek[1]);
	 MulMatrix(mat, vek, A[r]);
	 INC(r);
      END;
      NEW(res);
      r := 0;
      WHILE r < LastRounds DO
	 d := 0;
	 WHILE d < Dim DO
	    res.arg[r][d] := A[Rounds-LastRounds+r][d];
	    INC(d);
	 END;
	 INC(r);
      END;
      RETURN res;
   END EvaluatePsi;

   PROCEDURE EvaluateEta (arg: TCryptInput; data: Eta) : TCryptRes;
      (* evaluate the public function eta (composition of phi and psi) *)
      VAR
	 l, d : SHORTINT;
	 res : TCryptRes;
   BEGIN
      NEW(res);
      PreComputeArgs(arg);
      l := 0;
      WHILE l < LastRounds DO
	 d := 0;
	 WHILE d < Dim DO
	    EvalPolynom(data.p[l][d], res.arg[l][d]);
	    INC(d);
	 END;
	 INC(l);
      END;
      RETURN res;
   END EvaluateEta;

   PROCEDURE Eof (s: Streams.Stream) : BOOLEAN;
      (* returns TRUE if no bytes are left to read from stream s *)
      VAR
	 b : SYS.BYTE;
   BEGIN
      RETURN ~Streams.ReadByte(s, b) OR ~Streams.Back(s);
   END Eof;

   PROCEDURE Encrypt (msg: Streams.Stream; key: Ciphers.Cipher; 
		      length: INTEGER; s: Streams.Stream) : BOOLEAN;
      (* interface procedure for Ciphers.Encrypt *)
      VAR
	 i, j : SHORTINT;
	 ccmarg : TCryptInput;
	 ccmres : TCryptTmp;
	 wholeStream : BOOLEAN;
   BEGIN
      (* check if the whole stream msg shall be encrypted or only a certain 
	 amount of bytes *)
      IF length <= 0 THEN
	 wholeStream := TRUE;
      ELSE
	 wholeStream := FALSE
      END;
      NEW(ccmarg);
      WHILE ~Eof(msg) & (wholeStream OR (length > 0)) DO
	 i := 0;
	 WHILE i < MaxVar DO
	    IF ~NetIO.ReadSet(msg, ccmarg.arg[i]) THEN   
	       Error(msg, readSetFailed);
	       RETURN FALSE;
	    END;
	    IF ~RegulaerCCM(ccmarg.arg[i]) THEN
	       Error(msg, notRegular);
	       RETURN FALSE;
	    END;
	    INC(i);
	 END;
	 IF key IS PublicCipher THEN
	    ccmres := EvaluatePhi(ccmarg, key(PublicCipher).phi);
	 ELSE
	    ccmres := EvaluatePhi(ccmarg, key(PrivateCipher).phi);
	 END;
	 i := 0;
	 WHILE i < Rounds DO
	    j := 0;
	    WHILE j < Dim DO
	       IF ~NetIO.WriteSet(s, ccmres.numerator[i][j]) THEN
		  Error(s, writeSetFailed);
		  RETURN FALSE;
	       END;
	       INC(j);
	    END;
	    IF ~NetIO.WriteSet(s, ccmres.denominator[i]) THEN
	       Error(s, writeSetFailed);
	       RETURN FALSE;
	    END;
	    INC(i);
	 END;
	 DEC(length, MaxVar*(M DIV 8));
      END;
      RETURN TRUE;
   END Encrypt;

   PROCEDURE Decrypt (msg: Streams.Stream; key: Ciphers.Cipher; 
		      length: INTEGER; s: Streams.Stream) : BOOLEAN;
      (* interface procedure for Ciphers.Decrypt *)
      VAR
	 i, j : SHORTINT;
	 inNum, inDenom, out : ARRAY (M DIV 8) OF SYS.BYTE;
	 ccmarg : TCryptTmp;
	 ccmres : TCryptRes;
	 wholeStream : BOOLEAN;
   BEGIN
      IF length < 0 THEN
	 wholeStream := TRUE;
      ELSE
	 wholeStream := FALSE;
      END;
      WITH key:PrivateCipher DO
	 NEW(ccmarg);
	 WHILE ~Eof(msg) & (wholeStream OR (length > 0)) DO
	    i := 0;
	    WHILE i < Rounds DO
	       j := 0; 
	       WHILE j < Dim DO
		  IF ~NetIO.ReadSet(msg, ccmarg.numerator[i][j]) THEN
		     Error(msg, readSetFailed);
		     RETURN FALSE;
		  END;
		  INC(j);
	       END;
	       IF ~NetIO.ReadSet(msg, ccmarg.denominator[i]) THEN
		  Error(msg, readSetFailed);
		  RETURN FALSE;
	       END;
	       INC(i);
	    END;
	    ccmres := EvaluatePsi(ccmarg, key.psi);
	    i := 0;
	    WHILE i < LastRounds DO
	       j := 0;
	       WHILE j < Dim DO
		  IF ~NetIO.WriteSet(s, ccmres.arg[i][j]) THEN
		     Error(s, writeSetFailed);
		     RETURN FALSE;
		  END;
		  INC(j);
	       END;
	       INC(i);
	    END;
	    DEC (length, Rounds*Dim*(M DIV 8));
	 END;
      END;
      RETURN TRUE;
   END Decrypt;

   PROCEDURE ComposedEncrypt (msg: Streams.Stream; key: Ciphers.Cipher; 
			      length: INTEGER; s: Streams.Stream) : BOOLEAN;
      (* interface procedure for AsymmetricCiphers.ComposedEncrypt *)
      VAR
	 i, j : SHORTINT;
	 ccmarg : TCryptInput;
	 ccmres : TCryptRes;
	 in, out : ARRAY (M DIV 8) OF SYS.BYTE;
	 wholeStream : BOOLEAN;
   BEGIN
      IF length < 0 THEN
	 wholeStream := TRUE;
      ELSE
	 wholeStream := FALSE;
      END;
      NEW(ccmarg);
      WHILE ~Eof(msg) & (wholeStream OR (length > 0)) DO
	 i := 0;
	 WHILE i < MaxVar DO
	    IF ~NetIO.ReadSet(msg, ccmarg.arg[i]) THEN
	       Error(msg, readSetFailed);
	       RETURN FALSE;
	    END;
	    INC(i);
	 END;
	 IF key IS PublicCipher THEN
	    ccmres := EvaluateEta(ccmarg, key(PublicCipher).eta);
	 ELSE
	    ccmres := EvaluateEta(ccmarg, key(PrivateCipher).eta);
	 END;
	 i := 0;
	 WHILE i < LastRounds DO
	    j := 0;
	    WHILE j < Dim DO
	       IF ~NetIO.WriteSet(s, ccmres.arg[i][j]) THEN
		  Error(s, writeSetFailed);
		  RETURN FALSE;
	       END;
	       INC(j);
	    END;
	    INC(i);
	 END;
	 DEC (length, MaxVar*(M DIV 8));
      END;
      RETURN TRUE;
   END ComposedEncrypt;

   PROCEDURE RandomStream (s: Streams.Stream);
      (* writes some random elements of CC(M) to the stream s which can then
	 be used as an input for Trautner's TCRYPT *)
      VAR
	 ccm : CCMElement;
	 bytes : ARRAY M DIV 8 OF SYS.BYTE;
	 i : INTEGER;
   BEGIN
      i := 0;
      WHILE i < MaxVar DO
	 CreateCCM(ccm, reg);
	 IF ~NetIO.WriteSet(s, ccm) THEN
	    Error(s, writeSetFailed);
	 END;
	 INC(i);
      END;
   END RandomStream;

   PROCEDURE PublicCipherCreate (VAR obj: PersistentObjects.Object);
      (* constructor for a public cipher *)
      VAR
	 pub : PublicCipher;
	 if : AsymmetricCiphers.Interface;
	 caps : AsymmetricCiphers.CapabilitySet;
   BEGIN
      NEW(pub); NEW(pub.phi); NEW(pub.eta);
      PersistentObjects.Init(pub, pubType);
      NEW(if); if.encrypt := Encrypt; if.decrypt := NIL;
      if.compencrypt := ComposedEncrypt; if.split := NIL;
      if.randomStream := RandomStream;
      caps := {AsymmetricCiphers.composed};
      AsymmetricCiphers.Init(pub, if, caps, M*MaxVar, M*Dim);
      obj := pub;
   END PublicCipherCreate;

   PROCEDURE Split (VAR public: AsymmetricCiphers.Cipher; 
		    key: AsymmetricCiphers.Cipher);
      (* interface procedure for asymmetric interface *)
      VAR
	 pub: PublicCipher;
   BEGIN
      WITH key:PrivateCipher DO
	 PublicCipherCreate(SYS.VAL(PersistentObjects.Object, pub));
	 pub.phi := key.phi;
	 pub.eta := key.eta;
	 public := pub;
      END;
   END Split;

   PROCEDURE CipherCreate (VAR obj: PersistentObjects.Object);
      (* constructor for a private cipher *)
      VAR
	 key : PrivateCipher;
	 if : AsymmetricCiphers.Interface;
	 caps : AsymmetricCiphers.CapabilitySet;
   BEGIN
      NEW(key); NEW(key.phi); NEW(key.psi); NEW(key.eta); 
      PersistentObjects.Init(key, privType);
      NEW(if); if.encrypt := Encrypt; if.decrypt := Decrypt;
      if.compencrypt := ComposedEncrypt; if.split := Split;
      if.randomStream := RandomStream;
      caps := {AsymmetricCiphers.composed, AsymmetricCiphers.isPrivateKey};
      AsymmetricCiphers.Init(key, if, caps, M*MaxVar, M*Dim);
      obj := key;
   END CipherCreate;

   PROCEDURE Create* (VAR key: Ciphers.Cipher);
      (* creates a cipher for the use with Trautner's TCRYPT algorithm *)
      VAR
	 tmpKey : PrivateCipher;
	 phi : Phi;
	 psi : Psi;
	 eta : Eta;
   BEGIN
      CipherCreate(SYS.VAL(PersistentObjects.Object, tmpKey));
      CreateMaps(tmpKey.phi, tmpKey.psi, tmpKey.eta);
      key := tmpKey;
   END Create;

   PROCEDURE WritePolynom (s: Streams.Stream; p: Polynom) : BOOLEAN;
      (* writes the polynomial p onto the stream s *)
      CONST
	 index = M DIV 8;
      VAR
	 nrOfTerms, i : INTEGER;
	 bytes : ARRAY index OF SYS.BYTE;
   BEGIN
      nrOfTerms := LengthPolynom(p);
      IF ~NetIO.WriteInteger(s, nrOfTerms) THEN
	 RETURN FALSE;
      END;
      WHILE nrOfTerms > 0 DO
	 IF ~NetIO.WriteSet(s, p.koeff) THEN
	    RETURN FALSE;
	 END;
	 i :=  0;
	 WHILE i < MaxVar DO
	    IF ~NetIO.WriteShortInt(s, p.exp[i]) THEN
	       RETURN FALSE;
	    END;
	    INC(i);
	 END;
	 p := p.next;
	 DEC(nrOfTerms);
      END;
      RETURN TRUE;
   END WritePolynom;

   PROCEDURE ReadPolynom (s: Streams.Stream; VAR p: Polynom) : BOOLEAN;
      (* reads a polynomial from stream s *)
      CONST
	 index = M DIV 8;
      VAR
	 nrOfTerms, i : INTEGER;
	 pol : Polynom;
	 bytes : ARRAY index OF SYS.BYTE;
   BEGIN
      IF ~NetIO.ReadInteger(s, nrOfTerms) THEN
	 RETURN FALSE;
      END;
      NEW(p);
      pol := p;
      WHILE nrOfTerms > 0 DO
	 IF ~NetIO.ReadSet(s, pol.koeff) THEN
	    RETURN FALSE;
	 END;
	 i :=  0;
	 WHILE i < MaxVar DO
	    IF ~NetIO.ReadShortInt(s, pol.exp[i]) THEN
	       RETURN FALSE;
	    END;
	    INC(i);
	 END;
	 DEC(nrOfTerms);
	 IF nrOfTerms > 0 THEN
	    NEW(pol.next);
	    pol := pol.next;
	 END
      END;
      RETURN TRUE;
   END ReadPolynom;

   PROCEDURE PhiWrite (s: Streams.Stream; data: Phi) : BOOLEAN;
      (* writes the data structure for the public function phi onto a stream *)
      VAR
	 r, d, k : INTEGER;
   BEGIN
      r := 0;
      WHILE r < Rounds DO
	 d := 0;
	 WHILE d < Dim DO
	    IF ~WritePolynom(s, data.num[r][d]) THEN
	       RETURN FALSE;
	    END;
	    INC(d);
	 END;
	 IF ~WritePolynom(s, data.denom[r]) THEN
	    RETURN FALSE;
	 END;
	 INC(r);
      END;
      RETURN TRUE;
   END PhiWrite;

   PROCEDURE PhiRead (s: Streams.Stream; VAR data: Phi) : BOOLEAN;
      (* reads the data structure for the public function phi from a stream *)
      VAR
	 r, d, k : INTEGER;
   BEGIN
      NEW(data);
      r := 0;
      WHILE r < Rounds DO
	 d := 0;
	 WHILE d < Dim DO
	    IF ~ReadPolynom(s, data.num[r][d]) THEN
	       RETURN FALSE;
	    END;
	    INC(d);
	 END;
	 IF ~ReadPolynom(s, data.denom[r]) THEN
	    RETURN FALSE;
	 END;
	 INC(r);
      END;
      RETURN TRUE;
   END PhiRead;

   PROCEDURE PsiWrite (s: Streams.Stream; data: Psi) : BOOLEAN;
      (* writes the data structure for the private function psi onto a stream *)
      CONST
	 index = M DIV 8;
      VAR
	 dx, dy, r, d : INTEGER;
	 bytes : ARRAY index OF SYS.BYTE;
   BEGIN
      dy := 0;
      WHILE dy < Dim DO
	 dx := 0;
	 WHILE dx < Dim DO
	    IF ~NetIO.WriteSet(s, data.initialmatrix[dy][dx]) THEN
	       RETURN FALSE;
	    END;
	    INC(dx);
	 END;
	 INC(dy);
      END;
      r := 0;
      WHILE r < Rounds DO
	 d := 0;
	 WHILE d < Dim DO
	    IF ~NetIO.WriteSet(s, data.korrNum[r][d]) THEN
	       RETURN FALSE;
	    END;
	    INC(d);
	 END;
	 IF ~NetIO.WriteSet(s, data.korrDenom[r]) THEN
	    RETURN FALSE;
	 END;
	 INC(r);
      END;
      RETURN TRUE;
   END PsiWrite;

   PROCEDURE PsiRead (s: Streams.Stream; VAR data: Psi) : BOOLEAN;
      (* reads the data structure for the private function psi from a stream *)
      CONST
	 index = M DIV 8;
      VAR
	 dy, dx, r, d : INTEGER;
	 bytes : ARRAY index OF SYS.BYTE;
   BEGIN
      dy := 0;
      WHILE dy < Dim DO
	 dx := 0;
	 WHILE dx < Dim DO
	    IF ~NetIO.ReadSet(s, data.initialmatrix[dy][dx]) THEN
	       RETURN FALSE;
	    END;
	    INC(dx);
	 END;
	 INC(dy);
      END;
      r := 0;
      WHILE r < Rounds DO
	 d := 0;
	 WHILE d < Dim DO
	    IF ~NetIO.ReadSet(s, data.korrNum[r][d]) THEN
	       RETURN FALSE;
	    END;
	    INC(d);
	 END;
	 IF ~NetIO.ReadSet(s, data.korrDenom[r]) THEN
	    RETURN FALSE;
	 END;
	 INC(r);
      END;
      RETURN TRUE;
   END PsiRead;

   PROCEDURE EtaWrite (s: Streams.Stream; data: Eta) : BOOLEAN;
      (* writes the data structure for the public function eta onto a stream *)
      VAR
	 l, d : INTEGER;
   BEGIN
      l := 0;
      WHILE l < LastRounds DO
	 d := 0;
	 WHILE d < Dim DO
	    IF ~WritePolynom(s, data.p[l][d]) THEN
	       RETURN FALSE;
	    END;
	    INC(d);
	 END;
	 INC(l);
      END;
      RETURN TRUE;
   END EtaWrite;

   PROCEDURE EtaRead (s: Streams.Stream; VAR data: Eta) : BOOLEAN;
      (* reads the data structure for the public function eta from a stream *)
      VAR
	 l, d : INTEGER;
   BEGIN
      NEW(data);
      l := 0;
      WHILE l < LastRounds DO
	 d := 0;
	 WHILE d < Dim DO
	    IF ~ReadPolynom(s, data.p[l][d]) THEN
	       RETURN FALSE;
	    END;
	    INC(d);
	 END;
	 INC(l);
      END;
      RETURN TRUE;
   END EtaRead;

   PROCEDURE PubWrite (s: Streams.Stream;
                       obj: PersistentObjects.Object) : BOOLEAN;
      (* interface procedure for PersistentObjects *)
   BEGIN
      WITH obj:PublicCipher DO
	 RETURN PhiWrite(s, obj.phi) & EtaWrite(s, obj.eta);
      END;
   END PubWrite;

   PROCEDURE CipherWrite (s: Streams.Stream;
                          obj: PersistentObjects.Object) : BOOLEAN;
      (* interface procedure for PersistentObjects *)
   BEGIN
      WITH obj:PrivateCipher DO
	 RETURN PhiWrite(s, obj.phi) &
		PsiWrite(s, obj.psi) &
		EtaWrite(s, obj.eta);
      END;
   END CipherWrite;

   PROCEDURE PubRead (s: Streams.Stream;
                      obj: PersistentObjects.Object) : BOOLEAN;
      (* interface procedure for PersistentObjects *)
   BEGIN
      WITH obj:PublicCipher DO
	 IF ~PhiRead(s, obj.phi) OR ~EtaRead(s, obj.eta) THEN
	    RETURN FALSE;
	 END;
      END;
      RETURN TRUE;
   END PubRead;

   PROCEDURE CipherRead (s: Streams.Stream; 
			 obj: PersistentObjects.Object) : BOOLEAN;
      (* interface procedure for PersistentObjects *)
   BEGIN
      WITH obj:PrivateCipher DO
	 IF ~PhiRead(s, obj.phi) OR
	    ~PsiRead(s, obj.psi) OR
	    ~EtaRead(s, obj.eta) THEN
	       RETURN FALSE;
	 END;
      END;
      RETURN TRUE;
   END CipherRead;

BEGIN
   (* init of the zero and unit of CC(M) *)
   NullCCM := {};
   EinsCCM := {0};

   (* init of the zero exponent *)
   k := 0;
   WHILE k<MaxVar DO
      NullExp[k] := 0;
      INC(k);
   END;

   (* init of an pseudo list of exponents *)
   k := 0;
   WHILE k<MaxNrExp DO
      NullExpList[k] := NullExp;
      INC(k);
   END;

   k := 0;
   WHILE k < MaxNrExp DO
      CreateExp(GlobalExpList[k]);
      INC(k);
   END;

   (* init of the zero polynomial *)
   NEW(NullPolynom);
   NullPolynom.koeff := NullCCM;	(* Koeffizient = Null *)
   NullPolynom.exp := NullExp;		(* alle Exponenten = Null *)
   NullPolynom.next := NIL;		(* nur ein Term *)
   
   k := 0;
   WHILE k < M DO
      NEW(PreEvalArg[k]);
      IF k < MaxVar THEN
	 PreEvalArg[0].arg[k] := EinsCCM;
      END;
      INC(k);
   END;

   (* no interface needed for cipherType since it serves only as a
      common type for public and private ciphers *)
   PersistentObjects.RegisterType(cipherType, "TCrypt.Cipher", 
	"AsymmetricCiphers.Cipher", NIL);

   NEW(pubIf);
   pubIf.create := PublicCipherCreate;
   pubIf.write := PubWrite;
   pubIf.read := PubRead;
   pubIf.createAndRead := NIL;
   PersistentObjects.RegisterType(pubType, "TCrypt.PublicCipher",
	"TCrypt.Cipher", pubIf);

   NEW(privIf);
   privIf.create := CipherCreate;
   privIf.write := CipherWrite;
   privIf.read := CipherRead;
   privIf.createAndRead := NIL;
   PersistentObjects.RegisterType(privType, "TCrypt.PrivateCipher",
	"TCrypt.Cipher", privIf);

   InitErrorHandling;
END ulmTCrypt.
