;;; **************************************** ;;; CS-CRYPT ;;; ;;; Version 1.2 ;;; ;;; A very open implementation of the ;;; Cramer-Shoup Algorithm (1998) ;;; **************************************** ;;; ;;; M. Oliver M"oller [It's a German Umlaut and not my fault.] ;;; BEGUN 27/04/1999 ;;; VERSION DATE 21/10/2006 ;;; ;;; REMARKS: ;;; ;;; 1) This implementation is rather for curiosity than for ;;; an daily-usage setting. It was done during a lecture at the BRICS ;;; PhD school taught by Ivan Damgaard. ;;; At a few points I'm not 100% sure that I do not violate the ;;; (provable) integrity of the system; those are marked with (**). ;;; ;;; 2) The Key Generation ;;; a.is no doubt a VERY slow process... ;;; for keys of ~10000 bits allow approx. 1 week(?) calculation ;;; time. ;;; To give an estimate of the dependency ;;; (Compiled Allegro Common Lisp, on a Pentium 130MHz): ;;; 50 bits ~ 5 sec. [on a SPARC Ultra, Maple V R.3] ;;; 100 bits ~ 30 sec. ~ 1 sec. ;;; 200 bits ~ 4 min. ~ 1 min. ;;; 500 bits ~ 2 hours ~ 16 min. ;;; 1000 bits ~ ? ~ 53 min. ;;; 5000 bits ~ ? ~ ? ;;; [note that these are random experiments!] ;;; The part that takes so incredibly long is the construction of ;;; a prime p with p = 2*q+1, q also a prime; ;;; If you are capable of constructing p by means of a different ;;; tool (eg. the maple command ;;; > with(numtheory):safeprime(2^); ;;; ;;; Just insert the prime and the factorization ;;; [i.e. '( ("11" . 1) ( (int2bitnum (/ (p-1) 2)) . 1)) ] ;;; at the appropriate places. ;;; It is checked whether the factoization is correct, ;;; so you won't get an faulty key-pair by accident. ;;; ;;; b. A feasible alternative is not to produce a pair (p,q) with ;;; the relaxed property ;;; p = 2*r*q+1 ;;; where r is 'small' with respect to p; i.e. if p has 1000 bits ;;; then r could have 20 bits. Recall all we need is the factorization of ;;; (p-1), we need this in order to recognise generators. Recall the simple ;;; facts: ;;; 1. Z_p^* is a group ;;; 2. Z_p^* has a generator, i.e. is of order |Z_p^*|= p-1 [Euler] ;;; 3. every element a of this group has a order m, i.e. a^m == 1 (mod p) ;;; 4. m is a divisor of p-1 ;;; 5. If for no divisor t of p-1 it holds that a^t == 1 (mod p) then ;;; p-1 is the smallest number m such that a^m == 1 (mod p); ;;; Then a is a generator of Z_p^*. ;;; ;;; c. The format the factoization is represented in is a list ;;; ( (t_1 . m_1) (t_2 . m_2) ... (t_l . m_l)) ;;; where t_i are prime, m_i integers >= 1 and ;;; p-1 = t_1 ^ m_1 * t_2 ^ m_2 * ... * t_l ^ m_l ;;; The search for such a p is performed by choosing a big q first and than ;;; incrementally finding a proper r such that 2*r*q+1 is prime. We can ;;; beforehand cancel out some r, namely those where 2*r*q+1 has a small ;;; prime divisor (3,5,7,11,13 or 17); ;;; See the function ;;; (create-prime-pair ;;; ) ;;; It is recommended to choose a randomized starting point, e.g. by ;;; calling the function (about-expt-2 k) which returns a number ;;; between 2^k and 2^k+1. ;;; Here is a sketch of some computation times (compiled Allegro Common Lisp) ;;; 50/ 66 bits ~ 7 sec. ;;; 100/ 111 bits ~ 10 sec. ;;; 200/ 213 bits ~ 40 sec. ;;; 500/ 507 bits ~ 5 min. ;;; 1000/1020 bits ~ 1.5 hours ;;; 2000/2014 bits ~ 12 hours ;;; 5000/5020 bits ~ 750 hours ;;; ;;; 3) As a hash-function, I follow the Chaum-vonHeijst-Pfitzmann ;;; suggestion, i.e. h(a1,a2) -> g3^a1 * g4^a2 MOD p, where a1,a2 ;;; are elements of the group Z_q, p = 2*q+1. and g3,g4 are ;;; generators of Z_p^*. ;;; It is known that finding a collision of this h is at least as ;;; difficult as computing the discrete log of g3 with respect to ;;; g4,p (i.e. h is strong collision free under the Discrete Log ;;; assumption). ;;; ;;; 4) Security issues: ;;; a. The security of the crypto system relies on the DDH assumption ;;; (Decision- Diffie-Hellman) which is the weakest reasonable ;;; assumption up to date. The nice property of this protocol is ;;; that it is provably secure against a chosen-ciphertext attack, ;;; i.e. one of the very strong attacks by expanding the number of ;;; bits-to-transmit 'only' by a factor of 4. ;;; For details, see the paper of Ronald Cramer and Victor Shoup, ;;; "A practical public key crypto system provably secure against adaptive ;;; chosen ciphertext attack", in Crypto 1998, LNCS 1462, p.13ff. ;;; b. For the Hash-function, the SAME p=2*q+1 was used; this might ;;; appear as a sloppiness, but to the best of my knowledge it is ;;; not; Note that the group Z_p^* has phi(phi(p)) = phi(q) = q-1 ;;; generators, thus g3,g4 are really to be considered 'random' in ;;; this field and do not provide any information about g1,g2. ;;; (**) Prove me wrong here, if you can! ;;; (As a benefit, the generation phase is abbreviated to half the ;;; time and the keys are a bit smaller.) ;;; ;;; 5) Implementation details: ;;; a. Due to the excessive size of the key, it was necessary to use ;;; a different random number generation; this produces not exactly ;;; uniformly chosen keys (but on the other hand NO random number ;;; generator does); but since it uses twice as much random bits as ;;; the modulus has, it can be considered FAIRLY uniform. ;;; And - a slight biasing here really does not hurt(!) ;;; The random number generator your lisp implementation is to be ;;; trusted insofar it is required to produce (RANDOM 2) in {0,1} ;;; with a high reliability. Hardware solutions for creating random ;;; seeds are preferred(!) ;;; b. The original version was written in Allegro Common ;;; Lisp. The translation into the (very restricted) emacs-lisp code ;;; was done for reasons of compatibility. Make sure you compile ;;; your ".el" file, else it will be TERRIBLY SLOW(!) ;;; c. The gory ASCII things... ;;; You don't have to know this, but if you want: ;;; Most email systems are able to process a special simple encoding ;;; called base64 - ;;; here only standard ASCII characters are used in order to represent 6 bits ;;; of information. This can be considered a waste, but at least it ;;; works (almost) universally since all characters in between are ;;; considered pure text and not altered by any means. A typical ;;; base64 encoded block starts with a line ;;; begin-base64 600 Filename ;;; and ends with some "="-characters, i.e. one = at the end of the last line ;;; containing code and ==== in the subsequent line. Every line in between ;;; contains 60 characters (the real information). ;;; Now the encryption is a one-one mapping on a field Z_p with p a k-bit ;;; prime. In order to match the required number of bits the following scheme ;;; was used: ;;; ;;; Original List of E List of Bitlist base64 ;;; ASCII Text -> Numbers -> Code -> padded (0) -> encoding ;;; (K bits) k-1 bits each 4*k bits to modulo 6 ;;; | ;;; | ;;; Original List of D List of Bitlist | ;;; ASCII Text <- Numbers <- Code <- reduced to <-----+ ;;; (K bits) k-1 bits each 4*k bits modulo 4*k ;;; ;;; ;;; E: Encrypt D: Decrypt ;;; ;;; Possibly it is a long and tedious process to cut off every last bit that ;;; is -- strictly speaking -- surplus while decrypting. Therefore this is ;;; only done if the global variable *pedantic-surplus-remove* is set to T. ;;; (The default is nil -- thus, the decrpyted text might contain some ;;; strange characters in the end). ;;; ;;; 6) A word on Randomness... ;;; a. The security of this cryptographic protocol relies (as often) heavily ;;; on the 'complete' randomness of the bits used for the key generation, and ;;; in this particular case also in the encryption. ;;; Of course, we know pseudo random generators, that produce bitstrings that ;;; look fairly random to us --- but _they are not_ for they are ;;; reproducible. This is a principal problem you cannot solve with more ;;; clever software. For this reason, some machines provide a special ;;; physical device, sometimes called /dev/random ;;; The bits obtained here can be trusted in general. If you are working on a ;;; machine providing this device, your emacs random generator usually ;;; depends on this, too. ;;; Thus the variable *use-system-random-function* should be set to t. ;;; (per default it is NOT). ;;; b. In the unlucky case where your emacs does not provide a 'random' ;;; function, you'll have to use a substitute. This file contains a simple ;;; BBS-pseudo-random generator. If you'd like to use it, just modify the ;;; line containing *use-system-random-function* to ;;; (defconst *use-system-random-function* nil) ;;; In this case you will be asked to enter a (long) ''random'' string ;;; whenever you load this file, in order to 'guarantee' at least a fairly ;;; good random seed. Please take this serious. ;;; c. Alternatively, you can provide your own favourite (pseudo) random ;;; function. It should be able to produce (pseudo) random numbers up to ;;; *bbs-random-mod*, in order to make the function random-verybig work ;;; properly. ;;; ;;; 7) Bignumbers (or here: bitnumbers) ;;; Though many lisp dialects support operations on 'arbitrary' (i.e. as long ;;; as they fit into the memory), large integers, so called bignums, ;;; emacs-lisp does not(!) ;;; Thus it was re-written to a datatype called bitnums, which is basically a ;;; string with the least significant bit first (0 is "0", 1 is "1", 2 is ;;; "01" and so on. Since strings are the only kind of 'arrays' emacs-lisp ;;; supports, this was still better than using lists. ;;; Maybe the implementation of the primitives ;;; bitnum+ bitnum- bitnum* bitnum-mod bitnum-div bitnum-divmod ;;; bitnum= bitnum< and bitnum-times-2** ;;; can be improved (considerably?). Also they might be still buggy, though I ;;; ran a number of (randomized) tests on them. If you are willing to spend ;;; some time in improving this, please write me an email . ;;; ;;; 8) Why is it so terribly slow? ;;; The main reason - sorry to say - is emacs lisp and the arithmetic on ;;; bitnums, that is slower by a factor of maybe 1000 to compiled Allegro ;;; Common Lisp. I don't know how to help this. Especially getting a pseudo ;;; random number is terrible very slow (for I assumed a minimum of 500 ;;; random bits would be used every call). Certainly, here is much room for ;;; improvement. If you wan't something 'useful' you definitely should ;;; use another lisp dialect or compile it to c (e.g. via a scheme ;;; compiler). I started of with thinking "You should just be able to ;;; transform one of your emacs buffers". Well, you are. Overnight. ;;; ;;; 9) Customization: ;;; a. Creating of your own secret-key/public-key pair ;;; You can do simply this by calling ;;; (create-cramer-shoup) ;;; Depending on your machine and whether you use compiled emacs lisp code ;;; (which is recommended!) this can take from few seconds up to about 1 hour. ;;; You should include your private keys in the "My public & private key ..." ;;; section and take great care not to compromise your private key anyhow (!) ;;; ;;; b. Including other public keys ;;; Use the constant *list-of-public-keys* to do so. It is a assoc-list, the ;;; first entry of each element is an identifier for the owner of the public ;;; key. By default, my own public key is in there. ;;; ;;; c. Creating a new prime modulus p ;;; This is not necessary, but it's no problem in principle. The prime p ;;; is a part of the public key and thus de- and encryption of 'foreign' ps ;;; should still work without causing trouble. A motivation could be to chose ;;; p smaller in order to achieve a speedup or bigger in order to gain ;;; security. A very nice feature with this crypto-system that this security ;;; parameter does not have to be fixed in advance. ;;; It is up to you which way you chose p, as long as you know the ;;; factorization of p-1. The suggested method is to do this by calling ;;; (create-prime-pair ) ;;; The recommended start-n is (about-expt-2 ). The function ;;; returns a pair (q p) where p = r*q +1 for a small r. You can subsequently ;;; factor r by using standard tools, e.g. Maple. You can then replace ;;; *p* and *p-1-factorization*; Don't forget to replace also *k*, for ;;; else the functions will not work reliable! ;;; ;;; IMPORTANT NOTE: It is necessary that p-1 contains at least one big prime ;;; factor, since we know that the discrete logarithm problem is far easier ;;; for the case that it does not (cf.Henk C. A. van Tilborg: An introduction ;;; to cryptology, Kluwer, Dordrecht, 1988, p. 69). ;;; ;;; d. The initial configuration... ;;; In order to test the file, I setteled for the (ridiculously small) prime ;;; modulus 2063 (13 bits). The system works here, of course and you can ;;; generate your pair of secret/public keys and encrypt and decrypt. It is ;;; just not safe, for computing the discrete log to this prime is not a ;;; challange at all. In order to switch to some 'macho' primes just ;;; de-comment the contained prime moduli with 2000 or 5000 bit respectively. ;;; ;;; ---------------------------------------------------------------------- ;;; If you have any comments (or should find any flaws in this ;;; implementation), please contact me: ;;; omoeller@brics.dk ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; $Id: cs-crypt.el,v 1.2 2006/10/21 12:31:16 oli Exp $ ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Emacs Lisp Version ;;; ;;; **************************************** ;;; Necessary Emacs Lisp Parameters ;;; **************************************** (setq max-lisp-eval-depth 20000) (setq max-specpdl-size 15000) ;;; ************************************************************ ;;; Personal Secret Key & ;;; Archive of Public keys ;;; ************************************************************ ;;; ---------------------------------------- ;;; This variable contains a string denoting the recipient of your current ;;; encryption. The string should match with some entry in the 'archive' ;;; *cs-list-of-public-keys*, otherwise encryption will not work. (defvar *cs-recipient* "dummy" "*Recipient of the encrypted message.") ;;; ---------------------------------------- ;;; Here is your 'archive' of known public keys. They are stored as a ;;; assoc-list, i.e a list of entries ;;; ("[RECIPIENT]" . [RECIPIENTs public-key] ) ;;; You should chose [RECIPIENT] in a way that is easy to remember (for you). (defconst *cs-list-of-public-keys* `( ("dummy" . (12 "111100000001" "00111101" "011111101" "01100101011" "10110010111" "1100001111" ("0001001001" "0000100011"))) ("M. Oliver Moeller " . (2014 "1000111010001000100000001111111101111010100001010100010010101000010100100110000110101100101011000000101100000011110011100110100001001001001100010111010011000100001111011100011101001000011101101000110100111100000000101110000100100110110101100100111000011000001011011001110111100111000010011111001010000100001011010001110000101110011001000011111000001001100111000100001110011100010100111111100001101110100100001011110011010110000001110010111010000010110110111100101001101101011110000101000011100000100101001110000000100101010000101100001111110010100011101010110000011000011010010101110010000000001100100111011111000100000001001011101111101111111111011101010001110111101100101101001011110101111011101110110100111110100001100110110110001001110110010110000101110111000001100110011011100100111111010101101010101111001010011111100101111001011001011100100001010101111100010100001101111011011101100001011001110100010010110010100011001011111001000110101001111011111010111101111010000101101000000001101110110111111100110011111001101011100110011100111101101011100001110010101100100010100010110001110111101110011100100001000010010001111010000111000100011010100010000000110001100101001001100010100111110011110101110001010101111011101101100110101111010001011000010110010111011001010000010111001110001101011011010100101001000010110001001100100001011011000110111100011011011000001110100101111001001000011001101101000001101010111100011010001111101011000001001001000001101110000100001011110111011100010001000100100100101001000110100110010000101110101100010010000010101001100010100001000101101000010001101110011010111000000011001111001110011110110001110001000110000000110100110110110111111010001010100001110111001100101101101000000101111000110101010100011000101000101110100001010011010001111011011011110100001000111001011100001110001100101010011110011001100000010110110001100011101010010001011110001111000110011111111110010111111011010101000101010110100011110101010111001111011110100100010010110001010010110100001000000011101110011001" "0000011000011000110000101100100001101011001110100111000011011000100100001000010000001000110111011000001011001111000000001000000000100101111110111101011001011110011101101001111111111011010000100110001010000100001010001011000111010011000101010101100101110101101100101011110000100001010100001110010010011001110011101110111101101001110011001100101101111000101111010110100010010101000001011111000000101101011001001110010010011000110111010000000011011110101100101101001011000000111110100011100110101100101000100101011010110100111001000110101010100110110010011111011010010111111000111110011011101000011000100111101110001011100100010011000001010000101010011100101000111010110011000010011010100110100111100101100010000010000011010101110110100011101001100110101000010011011000101111010011110011100101000101000110011001111000111000101100000000011100110001011101110100101011000101101000111001010000000011111010010101000001001010101011001111000110101000100101001011010000000110100100010010110111001111010100011010001001010111000011000110110111110100111000100101000101010000101011110010110110001010101011011011101111101011111000000101010110101011001010101011011000101111010101100100111111001110010001100001011110011111111111010100000101001000111110001011111110000010000111010100100011011010000010101100100000000000001110010101001101000010001000010111011010000000111001100101101111111111100111100010000111000100111100110100001000110101101110001001000111101001101001101011100011001011100100111001100101111011100010101000000100000011100000110001000111010011100000010100101010011001100111100100010000100111010100100101011000011110011100000100011101001101111111001110101000010000000111010100101111001101100000101011100000100100111011111010111001000011110101101010000000101000001001110110101101001001000010000010010001010101111000010001111100001100101000000011000001010011011000110100101110000110010010100001111011010011000010000010000100010111100101111110000111100000101110111111110011010001011000001000010100110000101000100000000001" "00001011110111101100010100110110111000010101010000111100011001011101000111101110001001010001100000001111010100001010101000011111001011001101000111001000011000100000101000010111001000010110001001000111011100100000001111011101110110001110001101110010110001100101101000001001111011010001010010110000011000111110011100011010010011100101001001111100011010111000001001110010101101101011101111110111010001111010101000010010101111000001101001110101111101011100011110111011111000000111011011111110100010100101111110111110001110100010100111000010011000101000111011000111110001111101110010111001010001111101111011111110011110010100000011000111110110101110000110011001011001111101111000010111111111100010100100000010010010100101010001111101001111101010111111111101100000111100111100010011111001010110001101011100110011010001100100101010000001101111000100010000010011000100010111101111100111010111011110011011000101000010100111011100001110111111011001001001110101111100111100101001000111011010100111111011011001101101110111100001100111000110111111011111100010110110000101001110011000010011111000110100001100000110011011010011010011000011011110100111000101001010010010111111110110110100101111011111110001000010100001011000100010100100000100000000001101111110100001111000110111100110100101110011001101100111101010011111101011111001001100000101001101101101011111110110110010001111000000100001011111100101100111000011001111110000100110100110111001100101011000110000011111001110100000011011110110100011100100110110000100111101110010110010110100101110000111100110101001111001011010011110100111111101011110011000101100100100001111101101111001011100001001000111001101100001011010000001111011101100010101101011101111000110010110101101100110001011110100000010010000010011111000111011110010111100001101110101010001100110011101110101001101111001111000110001110101000011101010100111001111000011101011011100011011000011110010001000011110110011010110011101000100010100000011010111011110000010100011110110011100100000110101100000110100010011" "1001110111110101101001010001001100101000000001011110011101001001011100110000001000001011001100011010010000001111100111001010111101010000110000010010000000100100010101000111101000111001000011011110001001011011110100110000110001011110001101110010000100001011011111001111101011011101111100000001011000010000101000100011000100011100100100101000001001110000000110101100001101010100011011111010101001111110011111010001010111010001111000101010000111101000011000001100101000011110011011101101111101111000000000110101000110110100110011010101001101111100010010010010011100111010011010011111010101111000000111000101110010000110101100101101001101101101111101000101001010010011010111010010000001110100100100110111111000010011001100100011100010001111111001110110011011010011111111110101001000110001101100000001100111000010011101001000000101000111010000100010111000100100011010010000010011010011111111111001011011000110101011010100011111010110100011100110010110001010001101100010010010101001001101111001000110010010101010100010001111100010000110100000010010111000111001110110100011000110110100111100111001110000010001100101101001011100100011111101101110011011101011101111000101010000011100001011111011001100000101000000101110011110010101111011110000000001111111011110010010011101010110100001110101100011111001101010011011111011101110000110000110101100010101101011110111000000101110110011000111001100000001110010110111101010001010100101101101111101011110101111011110011111011000000010111100001100100000001100000111001111100100111000101111001011111101000110110110101100001001001011100111011000000100110100001101110011100000100010101101001101000110111010100001000111011001111101011111001100000000011111010100111001111011101011001110001110101100101110100110111100110000101000101101111000100101011100101010001110101011001101110100001111100100001101111111110001011000001001010101110101011000001001111111010110100101001000110100101001110101011010001000001101001010110000011111101000110010110100001000111100001000011010011010000011100001" "0100101100011010101000110011010100011100011100101000110111110001111000100100000010101011000100001001000001111111101000101010100110110110011010110010011000000110100010001111001110010000101100010101000010011111000000110110101011011100111010110010110110001001100100011001011100011100001011001111101111010010110101101001111001110011110010000110101100101001110100011101100001010000010001001101010110010111110000110000110110000111001000000110001001010010000101011001000111100011000000100100000000010110111101110010000100001101000111100111010000011111110111001111101011111101010010000000011011110011010111111011000100101100010010011011101001101001101000011101111111100001011000111110111011101011100001110001101110110110000011001000111011111010000010000000010011110101100101001001001000110011000111011111011000001110001011100000001100110001001100011000111101011101010101110101001001001101110110000010111110011100011110011001011000101111011100110000100000110001011101010011110011110100111100100000110011001000111100100011101000011001000100011001000100111010110111110100010110101001111101010010110001001100100001100111111110101010110110011111001001011000100100110100010111000010001110011001000000000001001011011001010101101100001111100001000011111000111110100111100010011010101011100000111111000011111110000000011100111101100010101001110011000111000110010011101001110000110010011111101110101001001111101111011011011101100010101110110110001110100101011010101101011101001010100100101001110000001011011111110100101001000010110110001101000111001101000100000101100101110110010110100111011101111111101001101110101001011011010011101101011010110111010110110011110000011111110011010111100000101001101111001110010100001001011110000000100000100100011111100101000101100011110100001111010001010000010100110011011000010011010101111000111110011000000111110000111110010111110110011110010100100000111100011011101000101101111110100001010001010101110010000011010111001010011111110011001000100101000000011111101001001111100100010110011001101001" "1010000000110011111001010001111000010111001000100110100100000101110010001011101010011100001011010111100111111010001100101100011000010100011111011101111001101110100000000000010010110111100010000000110100010101100101101011101100101000110110100011101110001111100101111110010000011001111010111010000101001010011111001000111111010100101111001101001010000011010111010111111001101101110010111111111010001101110001110110010101001100011111110111110101100000010000010101111111101101010011001001000101100111000100010100101100110011011100011100100111111001011011011101111000001011010001010001111110101111110100011110011010010010100010010001010000001010100100000001000111000111111001010011110111101001000011100010010101010111010001111000001101101100011111111100001001111000110111110110001001110001000011011101011100111100111101000100100000000111001000100111111101101101010000100001011011010101100001001001101100011101001010111000110000001011001100111010111010011101010011010110111001110110101100101100000110101101111101100001010011001101001101101101010000000101010100011101000010000010110010000101000000011101111001000010011000110100011010000111010001100000010100011001000110111100000101001001000101101111110011000100110111001100100000011000111000110111010000010010001001011100011101010010100010101000101110111100111100000011101101001001000111101001001011001011000101011111110101100110010000101011101111000001011111111000000011001111011110110011111011101011000010110010001000111110011110101001011101000010010101011001100001010101011101110011011000110010001101100101010000010110111000111101010100011000101010111011011001101100100111001000110100110100000100101000101111001001010001101010100011010001101110000110101100001010010000001010111001101010111101111101001001010011011011010110101110011101000010100100010100011100011010011001111001000111001011000100000100100100100010101111000011011010110001111000101100000111100110000111010011101110001111100100100001011000100011100101110100111000000110010010101000110100000110110010011" ("00001111011001111010101111001011001100111011101101001010101101000011000010110001100100011000101100111101011001011100110100000100111010100001111011011111110101110101001011001101110010110111110010000100011100111001010000001010001101001000010101000111001010100000101010011100100001111111000011001010011001001010110100011100010101001110100111010110101101110101110001010111010101100010011011001100100001011000101111001010111111001100010001000001001111010101101101101010010010010001101110001001011001110000100100000101001001001011111010000111011010011110000110010010001110100010101100001010111011001110000100100000100010000001101101010010101011111110000100101011011010011000010001011101011111001011011111100001100111100010001011100000001101101111111001000101101100010111101000001001010011001010100001101001000010010101010100001100010010010010001011000010111111100010101010000100010000001001011011001010101000111001110011101001111100010010001010101101011011100110110100010000110101000001100111101001110101110111011101110011100101101010011100010000110110001001100001110100101110000000111101001010111101110111111011101001111100100111000010000111001100111111001100100101100100011111101011111100110001010111010011001001000011000000000011110010110111101111000111011001010011000000010001001100010001011000100101000010000110010100001100110110110011111110110110111001010000110101110010111110000001110000111000011001100011010000010100101111011011111001100001010111001001101111111100101001101000101001001110010100001001011010101100000010000101111110111001001101001110110100110000111001010001011101000011111111010000010111111100001010011001010111011110010011011101111011110111010111011011110111110000010101011001001101101101001101110010100011001111001111001110011011000000011100010100000000000000101000001100010110001111111011001010100001100000010110001100011110010110011000000000101110000101100110101000011000011111100110011110101111001101101001110001001110100001101010001101011111011000101001000101001010011101100101101100111011" "00000001000011100011000110111011110111001111010110001010111101010111100010111011010111110001110100011001001111001010010001111000000000010111011100110111011100000010101100100000100111001001000010110111000011001010110101100001001111001000100001110011101100010110010000010010001101111100100100101011000101001001100010010100100110100100011101011101110110011000011100100100001100111000110000111101011011001111101001000111010110001010101011100000111111100100001001110110101011100011001011000111001110110101000110101110001100101110001001110100100110000011000011111100001100000010100100011001010000100011001101100111110101010001010001011010010111011011111000000000010000000000110111101010000001011010000001001011001111101001001101000100001010101110110111110100000000110000001110110001010100011111111110111110110111011010011110111101001000001110010111010001000100100010101100000100011000100110010010100101111110000011010011110100011010010101110001111110111111101110100011010001100010111001110011111100101000110000000001010101111000100010001111111001000110001011001000011000010110000001000111100110001000010101111101001111110011111100110011110000010010111100000001000101100101000101100101100000100001101011110110001110111101011101001100111011110001110110001010101101011100110011010110110110000001011111000001100111011111111011100001001011101001100000010001101101100010011000110100100111001100010010100110001001001000100000100101101010000000110000110110000111001101100110010111101110001101001110111100100100110101011101000101001000111010101100001001110110011101111011100110001001101001100000110000001100000111100001111101100110110100011000011101100000101101100010000101000111101011100001111110100110011110010101100010110000111010111111100011010111111000010110101111111010011101011110111110110010011001011101000010111010110000110110100000001100011010001100101001010110011110111000111001111110101100010101101101100101011010100011111001000100100000010010000100110110100100011000011110010011111100011101001011010100000100111001"))) )) ;;; ---------------------------------------- ;;; Once you commited to a personal secret key, you should not change it; ;;; Take care not to compromize it in any way. ;;; The initial entry you'll find here is the personal secret key of "dummy". (defconst *cs-personal-secret-key* ;;; The dummy key '(12 "111100000001" "100000011" "00010000101" "100001001" "10001111101" "10011001101" ("0001001001" "0000100011"))) ;;; ---------------------------------------- ;;; If this variable is set to nil, the decrypted text might contain some ;;; strange symbols at the (very) end not belonging to the original message. ;;; You can safely set it to 't', but this will slow down decryption a bit. (defvar *pedantic-surplus-remove* nil) ;;; ---------------------------------------- ;;; There are two ways in this file to find generators - either just by ;;; guessing & checking or by using a more advanced method (PRIMEL). You might ;;; want to experiment which one is faster in practice. (defconst *use-PRIMEL-to-find-generators* t) ;;; ---------------------------------------- ;;; If your system has got a nice random function, you should use it(!), not ;;; only on behalf of the speed. The default is nil, i.e. a pseudo-prim ;;; generator is used instead. ;;; Check also the definition of used-random-bitnum (defconst *use-system-random-function* nil) ;;; ------------------------------------------------------------ ;;; ************************************************** ;;; The prime moduli ;;; You need two constants: ;;; *p* : A large prime ;;; *p-1-factorization* : the factorization of phi(*p*) = *p* - 1 ;;; ;;; In principle you can set them arbitrary, but the number of bits *p* has ;;; reflects the degree of computational security. Also, *p*-1 should have at ;;; least one large prime factor (see section 9.c above). ;;; When loading the file in emace, it will be checked that you actually ;;; provided a correct factorization of *p*-1. ;;; ************************************************** ;;; ---------------------------------------- ;;; First a >5000 bit prime with factorization of p-1 (defconst *p5000* "1101110010100111011011010111001000100000110000000111100001001001101100110110110101110101011010111000010001000100011001111110110010011111000101110101010100010001110011001000100101100111011000110101000000101101011001010000010000000100011000101100001111010101010100011010100110011110010001111000000111100100011010101011011010111011101100100001000111010010011010001001101000101100100001001011110101010111101100100101110110110101011000101000111011110101110000100110000011111110101011101011010000110101011111011101011000001110011000001101100000100010010101100100110000100000100100100010011101000010011110001001100001101010011100001010010111110010011111111101000100111011111011010001100101110011000110110011001000000110011101001010000101111011010101111111000110001000010010010001110011000001011000001110001010010001110111101001110010011111111110111011001010110010111010100110110010100100101110111110001000110001001110010110011100110010111101000110101100010110000110111001101111000110001111010101111001110001100101000000001100110110011101110100101010110111011000010011110100111010001010011001110111101000001000001111011111010011000000000110100110100100111000100010010110000000110001110111110111001110000010110111101010101001000100100000000100111110001001001000000001011101111000010111001110111100111101100100010000111100001100110110010110101111001010010110010111111101010010111011011101000110001101100100000111011010010101101111110100001111001110010000000111110010110011110111001000000110111010100110011010001000000010111001011100010011000010000101101100100101110011100111100010001001001000101010000011110000001011000001111001010110101001000101000001101111110001001110110000100010100101010110001111110000011111011011100110110001110011111101101010100000001000110001100011000001111101001100011010010100101100111100000010001111010101001111010111001110010100011010001011101000001001010100101011111111011010110010101011011001001111000010100100101000000100001100010010001011000001101111000100101011101111011001000111001001010000101010111101000110000100001100000000011110000011110011000110110110001001100110000010100011111000011010101011111001000101010000011010110110011110011011011111110010100010111110011000100111000000111001111110000101011100000000010111101101010000010000011100111000011011100101110001100100100100111000010000011001001010101111101010010010100011100000111110111110011001111000001101110010100010101100000011101101001100100001111010011101100101110011111100011101100000000100101110100111111000100101100110000010001000101100011000101101010100110010010011101001001001100000000110010010101000010100111111001110111110010101011010110011001011001000000101011100011001111011001101010010110001101100111000001011000001110100001011111011010100100101010111000111011110010100011111100101000000101000110110011111001110000101001001111110101000011110100001010010100010100101101010100001000101111110010010101000100111101011100101010011100101000100111111100110110011000000110000101100001101010110011001111011010000110001010010101101111101001110000010111100111101101010000000110000111110010101010001011101001000010111111101101111100111010001111000010101100011010000101101011010111110111111100001011101011111000100101011011001101011101110110011000000110111010110001100111100001100001010011000011100010000011010110011001100110001110110000000110101001010001100001110101100100111110101001001110111001001000110101001011111101011010111000001101011100011111101111111001101111100011001001101000111000011111000010110010011101110110110010110111110000001010001000111110001111110001110010011100011001110000010110001001000010010011001110010000101110001100111001011011011101010101011001001100110000011011111001110000011001000000011000010100011100110001100101110000111001011001111101100001000101011111010011011011100000100011100000001001100011011000110011110010010110111000010101110101111010100010111000011100101011110110000000010011001111101011110010011110011100100101111001000011000100101110111011011111001110111111001000011000101110111011110100000011100100110111000001110001000001111111011001011000110001101010110100111011010001101111011010001010101101000100001011011010110110011001000111100001010011110000110011101000011101101001011000111000110001110010010000110111100001011000101110001111101110100101100101000111100100001001110001001111100011001010011111100111001001001000011011111110001000000001001000110111110110100001010010111010001010010000000100110001000111101001010100010001100000100011101010001001101110101111100111100010111001110101111110101011100111011011100110000011101111111110101111111101010100110001110000011001010100001100001110000111100101111100011100010000001111011001111101100101100001011011110111100011100010011001010111010001100011101001111111100001100111011001111101010101100001000100010101011001101101100001000100010100001011100101100110010000001110100100110110010000001000001010100001111000001011001110101110000111011110111100011011100101011000010111010110110110001010000010001011100111101110110110101110110111010111100001001") (defconst *p5000-1-factorization* '( ("110111111011011110101111000010101110000001100001011110110010101000100111010011111101111111101011000011000110100111101011100110001000011101101100000000010010100111011101000011110011001101011101011000100001110000110101000000001101101001011110110100001100010110001100110101111010000000111111101001000000111011001011011001101110011101011101111010011000010111010011001011010001111011000101000111011000100100110110001011000110000100101111111001100110001111010000001100111001010000000101111111111010101111101111101010111001100001111111110101001010100001100111001000001111111001100000001100011110100010101100000011100010001000101101100110000111111110010101000000110010110010111011011100010011011010100110010111001110010000110100001110100101101110100101001001001100110101111111001000100011110100101101101101000000110111100000101001010010110001100001100110100010001001000011000000100111111000011100010001010011000010111000101111101000111010011101010010011111011101111100010010111110111011110011110000100000010000110011000111110001001111010101100000011011101000101111110011010011110101010011111101001001100100001110111110000111001101001000101110100001100111010100100011001000010011010101001110000110110100111010000000110110100111010011110111100111011000001001110100111011101000111111101101000001101110011000011011001100111101000011010011111011000110101001101101100100011011111101110101011111001111101110101010001100011101101010001001101111101001101001000010010001110001111010000001100101111111001100001001100001111010000111011011000100000010000010100101101001010010111100000010111111010110101000011111010011101011000010001010001110110110011110110101001010101110101110101110011111100010001100011000001101101010100110010001011011001001000100010101000100101011010001110001000010001111110001001010110010000011010010010000011101111000000110010001101101010111111101101010000000111000010111111101111101110110110111110101001011111110100111010000000100011011000100001000010010100111110010110001101100001011011110011011011100111111010110010110010101011000011010000100000110100100110011100110001001001001111110010100110001000111110110100110111001011100000111000100011001000100001101111000110001010000001100000101011110010100001010000000111110110111100010000011000010110000010001110100000001111110000011111001111011100001100111001001000110111101001111110010011000011110101110010100011101101111010001110000110011000010111000111111110010010111010110110100100111100000101010110111000101101010111011111110000001110001000101001000100100100010001101111111011011010010101001100100011011111111111000010010001101100000010110101000111011001011001111110111011101011011010101101100101111110011001000001101001101111001010100001110110000110001000101001110000001111110100100001000100000011000100111110000100011010000110011000001111100000001100100001010011000101111101000101011100101110010010111000110010000111110101110111111110110111010100110011100111100110011000010000100010001100101000100110010001100010110101011000011011011001110111001110111111000101011101100001001011010010001110010101010111111010001011101001111010001110010100000010111110010110111010001111110101100010001100010111000110100101111010011011001100011001100011111011000110000101011110001100110000000101001110011110111011111011000000001000001001000101111111000111001011011001011111011111100111100001001110010000001100010110011100001000100111110101111011101001001100010101110001110011110000110101110000000101001101011110010000000000111011011110110101110000000010111011000000010010111000011100110010111010110001011101010011111001010100000100100000110000100001110010101100111001100100111010111011000110000100100010100100001011111111110000001100001111100110111101101001010100000010001100100110110010101101110010011000100111110011010111111111011111001010101111010010110011111100011100111100010110110110011011011001110111010010100101000011110010110000110010011111001101000010110001001011101110011111111001000001101010010001101110100100000101000010000111001011110010110111101001110100110111111011111010110111011111100010100110001001100001110100001100101110011111011111001011010101010011111111010101100011111101100110010000001111011011010111001100100010110110010011011000101110010110110110100010001010000110010000010010111101010010001000010011011000011011101010001100000000110010100100110001001111101100010100100111011110100111101111011000001011001000100101111101111111101010110111100101010010111010010001001001001100010110101000010011010110001111010110011100101101001101001100111111000111111101100001001101010001110101011000010110111001001011000100011100101101110100011111001110000101001010011111101101101001010100011111000000010001110110001111000000010110111100010001001000000000000011100101001111000100001011011111111010000011100010000100011101011010100011110100101101110011101100100000111000011000010100100111101010001010110101111100000011101001001001010000101101110100110001111110010110010111001110111100010111011101110001111111100001000000100101011111100001111011001110101011" . 1) ("100101" . 1) ("10001" . 2) ("101" . 1) ("11" . 1) ("01" . 1) )) (defconst *k5000* 5020) ;;bit-length of *p5000* ;;;;;;;;;;;;;;;;;;;;;;;;; = (lenght *p*) = (ceiling (log *p* 2)) ;;; ---------------------------------------- ;;; Now a >2000 bit prime with factorization of p-1 (defconst *p2000* "1000111010001000100000001111111101111010100001010100010010101000010100100110000110101100101011000000101100000011110011100110100001001001001100010111010011000100001111011100011101001000011101101000110100111100000000101110000100100110110101100100111000011000001011011001110111100111000010011111001010000100001011010001110000101110011001000011111000001001100111000100001110011100010100111111100001101110100100001011110011010110000001110010111010000010110110111100101001101101011110000101000011100000100101001110000000100101010000101100001111110010100011101010110000011000011010010101110010000000001100100111011111000100000001001011101111101111111111011101010001110111101100101101001011110101111011101110110100111110100001100110110110001001110110010110000101110111000001100110011011100100111111010101101010101111001010011111100101111001011001011100100001010101111100010100001101111011011101100001011001110100010010110010100011001011111001000110101001111011111010111101111010000101101000000001101110110111111100110011111001101011100110011100111101101011100001110010101100100010100010110001110111101110011100100001000010010001111010000111000100011010100010000000110001100101001001100010100111110011110101110001010101111011101101100110101111010001011000010110010111011001010000010111001110001101011011010100101001000010110001001100100001011011000110111100011011011000001110100101111001001000011001101101000001101010111100011010001111101011000001001001000001101110000100001011110111011100010001000100100100101001000110100110010000101110101100010010000010101001100010100001000101101000010001101110011010111000000011001111001110011110110001110001000110000000110100110110110111111010001010100001110111001100101101101000000101111000110101010100011000101000101110100001010011010001111011011011110100001000111001011100001110001100101010011110011001100000010110110001100011101010010001011110001111000110011111111110010111111011010101000101010110100011110101010111001111011110100100010010110001010010110100001000000011101110011001") (defconst *p2000-1-factorization* '(("100011010100100101110010110110100101000110011000000101000101000101100001010101011001110000000001111100101000001110011010110000010100111000111111001101100110011110011011010010111110111001010011010010001111101100010011100100000000011000101010100000011011000111111010011100100010001101101111101000011110011100100101001010111010011110001000100101010001010010000001010110110111110101100110000100111001110011010011110011101001000111000011011010111011101000011010001000010100101001010111101100101001010111100000100110110010011110111111011011100101001101100100101111111110101011101001101101111010001101110011000110100001000010010011001101010101101101100111110000000101111010010111111010011110101000001011111000000101001101101001001110000001001101110010110001011011000010000000001101111111101101000111111001011110010010010111100011111010010000111111101000001101010010000001010100000101111011100001011111011110000100010100110000000101101101111111111010110111101101110100110101100101011001000000000101100111101001011010011010011000000001011000001101001111111111110100000001001011101011111111010110000110000010001010000101101011100110110100111010101001110110110010011111011111100001001000000011010010111011001011111101001110000110101101000001111111001110011110110011011110011000100100011001111001010000101011011101010101010011100100000111100010010110000001100111101101011011100010110010110000000111100110110001101010101110101110000010000001101101010100100100011001110101100001111101010011001100001100011010101100100101011100110110110011111111110100101000010110001111101101010100001111010010111000001100111110001100101110101010101100011000101111001011010011001001001010000000110000111111101000110010100101110001111011010001011001001010100111001001110001111110011101101110001100010100011010011101010011111110110101000011111001101111110101010111101111010101001000100000001010001011011101011110111011110010101111001010111111011000111100111001001010000010010101001001111001111010101101010100111000011001111100011100001" . 1) ("101011" . 1) ("1101" . 1) ("01" . 4))) (defconst *k2000* 2014) ;;bit-length of *p2000* ;;;;;;;;;;;;;;;;;;;;;;;;; = (lenght *p*) = (ceiling (log *p* 2)) ;;; ---------------------------------------- ;;; Here you find the really 'toy' primes: ;;; (defconst *p* "111100000001") ;; 2063 (defconst *p-1-factorization* '( ("01" . 1) ("11100000001" . 1))) (defconst *k* 12) ;; (length *p*) ;;; ------------------------------------------------------------ (defconst *p-1-factorset* (mapcar #'car *p-1-factorization*)) ;;; **************************************** ;;; Prime Numbers ;;; **************************************** (defun create-prime-pair (k n) ;; computes a bigger (strong pseudoprim)-number than n ;; uses Miller-Rabin-Test ;; k reflects the number of bits in n ;; (neccessary, for the log of n is not evaluable any more) ;; ;; This function not only computes a prime p but also finds ;; a prime p = r*q + 1 for a small r. ;; (let ((q (bitnum+ n (bitnum-mod n "01"))) (p "") (i 0) (niter 100) ;;; Parameter - how often to call mr-pseudoprim (j "1") (l 1) (a nil) ;;; (make-list 2311) (a-len 0) (notfound t)) (while (or (bitnum-null (bitnum-mod q "11")) (bitnum-null (bitnum-mod q "101")) (bitnum-null (bitnum-mod q "111")) (bitnum-null (bitnum-mod q "1101")) (bitnum-null (bitnum-mod q "1011")) (bitnum-null (bitnum-mod q "10001")) (bitnum-null (bitnum-mod q "11001")) (bitnum-null (bitnum-mod q "11101")) ) (setq q (bitnum+ q "01"))) (message (format "Started with %s")) (while (not (miller-rabin k q niter)) (message ".") (setq q (bitnum+ q "0110000100000100001100101011"))) (setq i 1 l "1" p (bitnum-mod q "011000001001" )) ;; 2310 (setq a (list (bitnum+ "1" (bitnum-times-2** q 1)))) (while (bitnum< l "011000001001") (setq l (bitnum+ l "1")) (while (or (bitnum= "1" (bitnum-mod (bitnum* l p) "11")) (bitnum= "01" (bitnum-mod (bitnum* l p) "101")) (bitnum= "11" (bitnum-mod (bitnum* l p) "111")) (bitnum= "101" (bitnum-mod (bitnum* l p) "1101")) ) (setq l (bitnum+ l "1")) ) (setq a (append a (list (bitnum- (bitnum-times-2** (bitnum* q l) 1) (nth (- i 1) a))))) (my-incf i) (setq a-len (length a)) (message "Found prime; Actual size of 2310-grid: %d" i)) (while notfound (progn (setq p (bitnum+ "1" (bitnum-times-2** (bitnum* j q) 1)) j (bitnum+ j "011000001001") i 0) (while (< i a-len) (if (miller-rabin k p niter) (setq notfound nil i (+ 1 a-len)) (setq p (bitnum+ p (nth (my-incf i) a)))) (message "+") ))) `(,q ,p) )) (defun miller-rabin (k n iterations) (my-assert (> n 2) "miller-rabin") (let ((ok t) (i 0)) (while (and ok (< i iterations)) (my-incf i) (if (not (mr-pseudoprimp k n)) (setq ok nil))) ;; (message (format "%d iteration(s)" i)) ok)) (defun mr-pseudoprimp (k n) ;; RANDOMIZED (let* ((a (bitnum+ "01" (random-verybig k (bitnum- n "11")))) (last "") (exp (bitnum- n "1")) (goodlist (list "1" exp)) (s 0) (ok (bitnum= "1" (bitnum-gcd a n)))) (while (bitnum-null (bitnum-mod exp "01")) (setq exp (bitnum-div exp "01")) (my-incf s)) (setq a (mod-exp a exp n)) (while (and ok (bitnum< "0" s)) (setq last a a (mod (bitnum* a a) n)) (if (and (bitnum= "1" a) (not (member last goodlist))) (setq ok nil)) (my-decf s)) (and ok (bitnum= "1" a)))) ;;; **************************************** ;;; Finding generators & a modulus ;;; **************************************** (defun create-4-generator-old () ;; generates a 4-tuple (g1 g2 g3 g4) where ;; g1, g2, g3, g4 are generators of Z_p^* ;; It does so just by guessing. ;; (let* ((p-1 (bitnum- *p* "1")) (g1 (random-verybig *k* p-1)) (g2 (random-verybig *k* p-1)) (g3 (random-verybig *k* p-1)) (g4 (random-verybig *k* p-1)) ) (message "Guessing g1") (while (my-some #'(lambda (x) (bitnum= "1" (mod-exp g1 (bitnum-div p-1 x) *p*))) *p-1-factorset*) (setq g1 (random-verybig *k* p-1))) (message "Guessing g2") (while (my-some #'(lambda (x) (bitnum= "1" (mod-exp g2 (bitnum-div p-1 x) *p*))) *p-1-factorset*) (message ".") (setq g2 (random-verybig *k* p-1))) (message "Guessing g3") (while (my-some #'(lambda (x) (bitnum= "1" (mod-exp g3 (bitnum-div p-1 x) *p*))) *p-1-factorset*) (message ".") (setq g3 (random-verybig *k* p-1))) (message "Guessing g4") (while (my-some #'(lambda (x) (bitnum= "1" (mod-exp g4 (bitnum-div p-1 x) *p*))) *p-1-factorset*) (message ".") (setq g4 (random-verybig *k* p-1))) (message "- done.") `(,g1 ,g2 ,g3 ,g4) )) (defun create-4-generator () ;; generates a 4-tuple (g1 g2 g3 g4) where ;; g1, g2, g3, g4 are generators of Z_p^* ;; This implementation relying on ORDinG and PRIMEL is due to ;; L"uneburg, Heinz: On the rational normal form of endomorphisms. A primer ;; to constructive algebra. Mannheim/Wien/Zuerich: B.I.-Wissenschaftsverlag. ;; 1987, chapter XIII. ;; ;; All numbers (except *k*) are bitnums! ;; ;; In addition, it projects generators down to (2... p/2) - ;; If g is a generator, then also -g is (!) ;; (let ((g1 "1") (g2 "1") (g3 "1") (g4 "1") ) (message "Guessing g1") (setq g1 (project-down (PRIMEL *p* *p-1-factorization*) *p*)) (message " Guessing g2") (setq g2 (project-down (PRIMEL *p* *p-1-factorization*) *p*)) (message " Guessing g3") (setq g3 (project-down (PRIMEL *p* *p-1-factorization*) *p*)) (message " Guessing g4") (setq g4 (project-down (PRIMEL *p* *p-1-factorization*) *p*)) (message " - done.") `(,g1 ,g2 ,g3 ,g4) )) (defun ORDinG (x p p-1-factorization) (let* ((ord (bitnum- p "1")) (j 0)) (my-loop-for-e-in-do p-1-factorization (setq j 0) (while (and (< j (- (cdr e) 1)) (bitnum= "1" (mod-exp x (bitnum-div ord (car e)) p))) (setq ord (bitnum-div ord (car e))) (my-incf j)) (if (bitnum= "1" (mod-exp x (bitnum-div ord (car e)) p)) (setq ord (bitnum-div ord (car e))))) ord)) (defun PRIMEL (p p-1-factorization) (let* ((prim (bitnum+ "01" (random-verybig *k* (bitnum- p "11")))) (ord (ORDinG prim p p-1-factorization)) (p-1 (bitnum- p "1")) (p-3 (bitnum- p "11")) (y "0") (ord-y "0") (c "0") (s "0") (ss "0")) (while (bitnum< ord p-1) (setq y (bitnum+ "01" (random-verybig *k* p-3))) (setq ord-y (ORDinG y p p-1-factorization)) (setq c (bitnum-gcd ord-y ord)) (setq s (bitnum-mod ord (bitnum-div ord-y c))) (if (bitnum= ord-y p-1) (progn (setq prim y) (setq ord ord-y)) (if (and (bitnum< c ord-y) (bitnum< 0 s)) (progn (setq ss (bitnum-mod ord-y (bitnum-div ord c))) (setq ss (bitnum-div ss (bitnum-gcd ss s))) (setq prim (mod-exp prim (bitnum-div ord s) p)) (setq prim (bitnum-mod (bitnum* prim (mod-exp y (div ord-y ss) p)) p)) (setq ord (* s ss)))))) prim)) (defun project-down (g p) (if (bitnum< (bitnum-div p "01") g) (bitnum- p g) g)) (defun used-create-4-generator () (if *use-PRIMEL-to-find-generators* (create-4-generator) (create-4-generator-old))) ;;; **************************************** ;;; Hashing... ;;; **************************************** (defun apply-hash-on-two-numbers-mod-q (p g3 g4 a1 a2) ;; (my-assert (< a1 (/ (- p 1) 2)) "apply-hash-on-two-numbers-mod-q") ;; (my-assert (< a2 (/ (- p 1) 2))"apply-hash-on-two-numbers-mod-q") (bitnum-mod (bitnum* (mod-exp g3 a1 p) (mod-exp g4 a2 p)) p)) (defun apply-hash-on-one-number-mod-q*q (p g3 g4 nn) (let* ((q (bitnum-div (bitnum- p "1") "01")) (dm (bitnum-divmod nn q))) (apply-hash-on-two-numbers-mod-q p g3 g4 (my-second dm) (my-first dm)))) (defun apply-hash-on-bitlist (k p g3 g4 l) "i.e. extended" (my-assert (> (length l) (* 2 k)) "apply-hash-on-bitlist") ;;; k : integer ;;; p,g3,g4 : bitnum ;;; l : list of bits ;;; extension of a strong collision-free hash function f ;;; to arbitrary bit length ;;; (confer Johannes K"obler, Ulm; ;;; lecture notes Cryptography II, 1996) ;;; NOTE: ;;; since our strong collision-frre hash function f is ;;; f: {0..q-1}x{0..q-1} -> Z_p^* ;;; and not (as desired) ;;; {0,1}^((k-1)(k-1)) -> {0,1}^k ;;; we lose 'some security' here... i.e. every k-th bit. ;;; This does not hurt. ;;; (**) Prove me wrong here! ;;; (let* ((tt k) (m (+ k k -1 -1)) (len (- m tt 1)) (l-deficit (- len (mod (length l) len))) (leading-zeroes (my-loop-for-i-from-to-append 1 l-deficit '(0))) (l-patched (append leading-zeroes l)) (l-grouped (mapcar #'bits2bitnum (group-list l-patched len))) (arg "0") (res "0")) (my-loop-for-e-in-do l-grouped ;; get next argument (setq arg (bitnum+ e (bitnum-times-2** (bitnum+ "1" (bitnum-times-2** res 1)) len)) res (apply-hash-on-one-number-mod-q*q p g3 g4 arg))) res)) ;;; ************************************************** ;;; The gory ASCII-to-BIT-and-back translation... ;;; ************************************************** ;;; We assume that in the last consequence we want to encode 8-bit ;;; ASCII code (like proposed in the unicode emacs). ;;; In order to encrypt these text blocks, we translate them into a ;;; sequence of (k-1)-bit-numbers (and fill the rest with zeroes) ;;; We do not apply any clever cipher-block chaining here, but just assemble ;;; the bits. (defconst *nl* "\n") (defconst *base64-array* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") (defconst *6bit2base64* '( (65 . 0) (66 . 1) (67 . 2) (68 . 3) (69 . 4) (70 . 5) (71 . 6) (72 . 7) (73 . 8) (74 . 9) (75 . 10) (76 . 11) (77 . 12) (78 . 13) (79 . 14) (80 . 15) (81 . 16) (82 . 17) (83 . 18) (84 . 19) (85 . 20) (86 . 21) (87 . 22) (88 . 23) (89 . 24) (90 . 25) (97 . 26) (98 . 27) (99 . 28) (100 . 29) (101 . 30) (102 . 31) (103 . 32) (104 . 33) (105 . 34) (106 . 35) (107 . 36) (108 . 37) (109 . 38) (110 . 39) (111 . 40) (112 . 41) (113 . 42) (114 . 43) (115 . 44) (116 . 45) (117 . 46) (118 . 47) (119 . 48) (120 . 49) (121 . 50) (122 . 51) (48 . 52) (49 . 53) (50 . 54) (51 . 55) (52 . 56) (53 . 57) (54 . 58) (55 . 59) (56 . 60) (57 . 61) (43 . 62) (47 . 63) )) (defun string-to-bits (string) (apply #'append (mapcar #'char-to-bits (string-to-chars string)))) (defun string-to-chars (string) (my-loop-for-i-from-to-append 0 (- (length string) 1) (list (aref string i)))) (defun char-to-bits (c) (nat2bits c 8)) ;; --- (defun bits-to-string (l) (my-assert (= 0 (mod (length l) 8)) "bits-to-string") (let* ((str (make-string (/ (length l) 8) 0)) (i 0) (j 0) (n 0)) (my-loop-for-e-in-do l (setq n (+ e n n)) (my-incf i) (if (= i 8) (setq (aref str j) n j (+ 1 j) i 0 n 0))) str)) ;;; ==================== (defun group-string-to-bitnum-list (str k) (let* ((len (* 8 (length str))) (deficit (mod (- k (mod len k)) k)) (l (append (string-to-bits str) (my-loop-for-i-from-to-append 1 deficit '(0)))) (res nil) (n nil) (i 0)) (my-loop-for-e-in-do l (my-push e n) (my-incf i) (if (= i k) (setq res (append res (list (bits2bitnum n))) n nil i 0))) res)) ;;; ===================== (defun bitnum-list-to-base64 (l k) ;; numbers are 0 -- 2^k-1 (let* ((bl (apply #'append (mapcar #'(lambda (n) (bitnum2bits n k)) l))) (deficit (mod (- 0 (length bl)) 6)) (bg (group-list (append bl (make-0-list deficit)) 6))) (sconc "begin-base64 600 cs-Encrypted" *nl* (linebreak-string (sconc-list (mapcar #'char-to-string (mapcar #'b64-num-to-char (mapcar #'bits2nat bg)))) 60) "=" *nl* "===="))) (defun bitnum-list-to-ascii (l k) ;; numbers are 0-2^k-1 (let* ((bl (apply #'append (mapcar #'(lambda (n) (reverse (bitnum2bits n k))) l))) (len (length bl)) (surplus (mod len 8))) (sconc-list (if (and *pedantic-surplus-remove* (> surplus 0)) (mapcar #'char-to-string (mapcar #'bits2int (group-list (my-loop-for-i-from-to-append 0 (- len surplus) (list (nth i bl))) 8))) (mapcar #'char-to-string (mapcar #'bits2nat (group-list bl 8))))))) (defun base64-to-bitnum-list (s k) ;; numbers are 0-2^k (let* ((bl (apply #'append (mapcar #'(lambda (x) (nat2bits x 6)) (mapcar #'b64-char-to-number (my-loop-for-i-from-to-append 0 (1- (length s)) (list (aref s i))))))) (len (length bl)) (surplus (mod len (* 4 k)))) (mapcar #'bits2bitnum (group-list (if *pedantic-surplus-remove* (my-loop-for-i-from-to-append 0 (- len surplus 1) (list (nth i bl))) bl) k)))) (defun base64-content (s) (let ((from 0) (to )) (while (not (= 10 (aref s from))) (my-incf from)) (setq to (my-incf from)) (while (not (= (aref "=" 0) (aref s to))) (my-incf to)) (flatten-string (my-substring s from (- to 1))))) (defun b64-char-to-number (c) (cdr (assoc c *6bit2base64*))) (defun b64-num-to-char (m) (aref *base64-array* m)) ;;; ============================== (defun char-to-string (c) (format "%c" c)) ;;; ============================== (defun encrypt-ascii-to-base64 (s pk) (let ((k (car pk))) (bitnum-list-to-base64 (apply #'append (mapcar #'(lambda (m) (cramer-shoup-encrypt m pk)) ;;; (mapcar #'(lambda (m) m) (group-string-to-bitnum-list s (- k 1)) )) k))) (defun decrypt-base64-to-ascii (s) (let ((k (car *cs-personal-secret-key*))) (bitnum-list-to-ascii (mapcar #'(lambda (c) (cramer-shoup-decrypt c *cs-personal-secret-key*)) ;;; (mapcar #'(lambda (c) c) (group-list (base64-to-bitnum-list (base64-content s) k) 4) ) (- k 1)))) ;;; **************************************** ;;; String Manipulation ;;; **************************************** (defun sconc-list (r) (eval `(sconc ,@r))) (defun linebreak-string (s n) ;; insert a newline after every nth symbol (let ((i 0) (len (length s)) (res nil)) (while (< (+ i n) len) (my-push (my-substring s i (+ i n -1)) res) (my-push *nl* res) (my-incf i n)) (if (< i len) (my-push (my-substring s i (- (length s) 1)) res)) (sconc-list (reverse res)))) (defun flatten-string (s) ;; remove all newlines (characters 10 and 13) (sconc-list (mapcar #'char-to-string (my-remove-if #'(lambda (x) (or (equal x 10) (equal x 13))) (my-loop-for-i-from-to-append 0 (- (length s) 1) (list (aref s i))))))) ;;; **************************************** ;;; Auxillary functions ;;; **************************************** (defun make-0-list (n) (if (<= n 0) nil (cons 0 (make-0-list (- n 1))))) (defun div (a b) (/ (- a (mod a b)) b)) (defun about-expt-2 (k) "a number beween 2^k and 2^(k+1)" (let ((l (cons 1 (my-loop-for-i-from-to-append 1 k (list (random 2)))))) (bits2nat l))) (defun even (a) (= (mod a 2) 0)) (defun odd (a) (= (mod a 2) 1)) (defun bitnum-gcd (a b) (if (bitnum-null a) b (bitnum-gcd (bitnum-mod b a) a))) (defun my-abs (n) (if (< n 0) (- 0 n) n)) (defun minus1-exp (a) ;; computes (-1)^ a (my-assert (integerp a) "minus1-exp") (if (odd a) -1 1)) (defun group-list (l m) (let ((res nil) (tmp nil) (i 0)) (my-loop-for-e-in-do l (my-push e tmp) (if (= 0 (mod (my-incf i) m)) (progn (my-push (reverse tmp) res) (setq tmp nil)))) (if (not (null tmp)) (my-push (reverse tmp) res)) (reverse res))) (defun extended-euklid (a b) ;; a,b : int ;; returns a list '( x y d ) (if (= 0 a) `(0 1 ,b) (let* ((res (extended-euklid (mod b a) a)) (x (my-first res)) (y (my-second res)) (d (my-third res))) `( ,(- y (* x (div b a))) ,x ,d)))) (defun mod-exp (a b m) ;; Svens Version ;; works on bitnums (let ((res "1") (ex a)) (while (bitnum< "0" b) (if (bitnum= "1" (bitnum-mod b "01")) (setq res (bitnum-mod (bitnum* res ex) m))) (setq ex (bitnum-mod (bitnum* ex ex) m) b (bitnum-div b "01"))) res)) (defun mult-invert (a m) ;; (my-assert (bitnum= "1" (bitnum-gcd a m)) "mult-invert") ;; ;; a,m : bitnum (and therefore positive) (let ((res (mult-invert-sub a m))) (my-assert (bitnum= "1" (my-third res)) "mult-invert") (if (listp (car res)) (bitnum- m (car (car res))) (car res)))) (defun mult-invert-sub (a b) ;; basically extended-euklid; ;; Convention: a bitnum in a list is 'negative' (!) (if (bitnum-null a) `("0" "1" ,b) (let* ((res (mult-invert-sub (bitnum-mod b a) a)) (x (my-first res)) (y (my-second res)) (d (my-third res)) (c (cond ((and (listp a) (listp b)) (bitnum-div (car b) (car a))) ((and (listp a) (not (listp b))) (list (bitnum-div b (car a)))) ((and (not (listp a)) (listp b)) (list (bitnum-div (car b) a))) (t (bitnum-div b a)))) (z (cond ((and (listp c) (listp x)) (bitnum* (car c) (car x))) ((and (listp c) (not (listp x))) (list (bitnum* (car c) x))) ((and (not (listp c)) (listp x)) (list (bitnum* c (car x)))) (t (bitnum* c x))))) `( ,(cond ((and (listp y) (listp z)) (if (bitnum< (car y) (car z)) (bitnum- (car z) (car y)) (list (bitnum- (car y) (car z))))) ((and (listp y) (not (listp z))) (list (bitnum+ z (car y)))) ((and (not (listp y)) (listp z)) (bitnum+ (car z) y)) (t (if (bitnum< z y) (bitnum- y z) (list (bitnum- z y))))) ,x ,d)))) ;; -------------------- (defun bits2nat (list) (let ((res 0)) (my-loop-for-e-in-do list (setq res (* 2 res)) (if (= e 1) (my-incf res))) res)) (defun nat2bits (n nbits) (let ((res nil)) (if nbits (my-loop-for-i-from-to-do 0 (1- nbits) (if (= 1 (mod n 2)) (my-push 1 res) (my-push 0 res)) (setq n (div n 2))) (while (> n 0) (if (= 1 (mod n 2)) (my-push 1 res) (my-push 0 res)) (setq n (div n 2)))) res)) ;;; ****************************** ;;; Bitnums ;;; ****************************** ;;; ------------------------------ ;;; Convertions ;;; ------------------------------ (defmacro b2i (b) `(cond ((equal ,b 48) 0) ((equal ,b 49) 1) (t (error "illegal bit")))) (defun int2bitnum (i) (my-assert (>= i 0) "int2bitnum") (if (= 0 i) "0" (let ((res "")) (while (> i 0) (if (= 1 (mod i 2)) (setq res (sconc res "1")) (setq res (sconc res "0"))) (setq i (div i 2))) res))) (defmacro my-loop-for-i-from-downto-do (start end &rest exec) `(let ((i ,start) (ex nil)) (while (>= i ,end) (setq ex (quote ,exec)) (while (not (null ex)) (eval (car ex)) (setq ex (cdr ex))) (setq i (- i 1)) ))) (defun bitnum2int (b) ;; Usually not possible! (let ((n 0) (leng (length b))) (my-loop-for-i-from-downto-do (- leng 1) 0 (setq n (+ (b2i (aref b i)) n n))) n)) (defun bitnum-null (b) (equal b "0")) (defun bitnum2string (b) ;; works but is terribly slow... avoid this! (let* ((x nil) (d b) (m nil) (res nil)) (while (not (bitnum< d "0101")) (setq x (bitnum-divmod d "0101") d (my-first x) m (bitnum2int (my-second x)) res (my-push (char2string (+ 48 m)) res))) (my-push (char2string (+ 48 (bitnum2int d))) res) (sconc-list res))) (defmacro bitnum-nth-bit (i a alen) `(if (>= ,i ,alen) 0 (b2i (aref ,a ,i)))) (defun bits2bitnum (l) (sconc-list (mapcar #'(lambda (x) (cond ((= x 0) "0") ((= x 1) "1") (t (error "illegal bit")))) (reverse (truncate-leading-0s l))))) (defun bitnum2bits (n k) (let ((top (length n)) (i 0) (res)) (while (< i top) (my-push (- (aref n i) 48) res) (my-incf i)) (while (< i k) (my-push 0 res) (my-incf i)) res)) (defun ttest-trans (n) (insert (bits2bitnum (bitnum2bits n 0)))) ;;; ------------------------------ ;;; Arithmetic ;;; ------------------------------ (defun bitnum+ (a b) (let* ((alen (length a)) (blen (length b)) (mx (max alen blen)) (i 0) (sum 0) (l nil) (carry 0)) (while (or (< i mx) (> carry 0)) (setq sum (+ carry (bitnum-nth-bit i a alen) (bitnum-nth-bit i b blen)) carry (div sum 2)) (my-push (mod sum 2) l) (my-incf i)) (bits2bitnum l))) (defun bitnum- (a b) ;; unary - (i.e 2-3=0) (let* ((alen (length a)) (blen (length b)) (mx (max alen blen)) (i 0) (sum 0) (l nil) (carry 0)) (while (<= i mx) (setq sum (- (bitnum-nth-bit i a alen) (bitnum-nth-bit i b blen) carry) carry (if (< sum 0) 1 0)) (my-push (mod sum 2) l) (my-incf i)) (if (> carry 0) "0" (bits2bitnum (truncate-leading-0s l))))) (defun bitnum* (a b) (let* ((alen (length a)) (blen (length b)) (rlen (+ alen blen -1)) (res nil) (k 0) (sum 0) (carry 0) (start 0) (end 0) (l nil)) (my-loop-for-i-from-downto-do rlen 0 (setq sum 0) (setq start (max 0 (- i (- blen 1))) end (min i (- alen 1))) (my-loop-for-j-from-to-do start end (if (and (eq 49 (aref a j)) (eq 49 (aref b (- i j)))) (my-incf sum))) (my-push sum res)) (while (or (< k rlen) (> carry 0)) (setq sum (+ carry (car res)) res (cdr res) carry (div sum 2)) (my-push (mod sum 2) l) (my-incf k)) (bits2bitnum (truncate-leading-0s l)))) (defun bitnum-expt (b i) ;;; b : bitnum ;;; i : integer (let ((res "1") (scale b)) (while (> i 0) (if (= 1 (mod i 2)) (setq res (bitnum* res scale))) (setq i (div i 2)) (if (> i 0) (setq scale (bitnum* scale scale)))) res)) (defun bitnum-times-2** (b i) (sconc (make-0-string i) b)) (defun bitnum-divmod (a b) ;; returns a list '( ) (let ((alen (length a)) (blen (length b))) (if (or (< alen blen) (and (= alen blen) (let ((i (- alen 1))) (while (and (> i 0) (equal (aref a i) (aref b i))) (my-decf i)) (and (>= i 0) (< (bitnum-nth-bit i a alen) (bitnum-nth-bit i b blen)))))) `("0" ,a) ;;; case: a => b (let ((diff (- alen blen)) (div nil) (b-shift nil)) (while (>= diff 0) (setq b-shift (bitnum-times-2** b diff)) (if (bitnum< a b-shift) (my-push 0 div) (progn (my-push 1 div) (setq a (bitnum- a b-shift)))) (my-decf diff)) `(,(bits2bitnum (truncate-leading-0s (reverse div))) ,a))))) (defun bitnum-div (a b) (my-first (bitnum-divmod a b))) (defun bitnum-mod-old (a b) (let ((alen (length a)) (blen (length b))) (if (or (< alen blen) (and (= alen blen) (let ((i (- alen 1))) (while (and (> i 0) (equal (aref a i) (aref b i))) (my-decf i)) (and (>= i 0) (< (bitnum-nth-bit i a alen) (bitnum-nth-bit i b blen)))))) a) ;;; case: a => b (let ((diff (- alen blen)) (b-shift nil)) (while (>= diff 0) (setq b-shift (bitnum-times-2** b diff)) (if (bitnum< a b-shift) nil (setq a (bitnum- a b-shift))) ;; (message (format "%d" diff)) (my-decf diff)) a))) (defun bitnum-mod (a b) (let ((alen (length a)) (blen (length b))) (cond ((or (< alen blen) (and (= alen blen) (let ((i (- alen 1))) (while (and (> i 0) (equal (aref a i) (aref b i))) (my-decf i)) (and (>= i 0) (< (bitnum-nth-bit i a alen) (bitnum-nth-bit i b blen)))))) a) ((equal b "1") "0") ((equal b "01") (format "%c" (aref a 0))) ;;; general case: a => b (t (let ((diff (- alen blen)) (i 0) (ab 0) (bb 0) (j 0) (sum 0) (l nil) (carry 0) (notdone t)) (while (> diff 0) ;; (message (format "->%d" diff)) (setq i (- alen 1) notdone t) (while (and notdone (>= i diff)) (setq ab (aref a i) bb (aref b (- i diff))) ;; (message "----->%d:%d" ab bb) (cond ((< ab bb) (setq i -1)) ;; decrement one earlier ((> ab bb) (setq notdone nil)) ;; decrement here (t (my-decf i) ))) ;; continue (cond ((>= i diff) ;; decrement a (and alen) (progn ;; (message (format "decrement here! (i=%d)" i)) (setq j diff carry 0 l nil) ;; (message "j=%d / alen=%d / blen=%d /diff=%d || a=%s b=%s" j alen blen diff a b) (while (< j alen) (setq sum (- (aref a j) (aref b (- j diff)) carry) carry (if (< sum 0) 1 0)) (my-push (mod sum 2) l) (my-incf j)) (if (> carry 0) (progn ;; (message (format "error[bitnum-mod:] a=%s b=%s diff=%d" a b diff)) (beep) (setq a "0") (setq alen 1))) (setq a (bits2bitnum (truncate-leading-0s (append l (my-loop-for-i-from-downto-append (- diff 1) 0 (list (- (aref a i) 48)))))))) (setq alen (length a) diff (- alen blen))) ;;; -------------------------------------- ((= i (- diff 1)) ;; (message "Just remove.") ;; (message "j=%d / alen=%d / blen=%d /diff=%d || a=%s b=%s" j alen blen diff a b) (setq a (bits2bitnum (truncate-leading-0s (my-loop-for-i-from-downto-append (- diff 1) 0 (list (- (aref a i) 48)))))) (setq alen (length a) diff (- alen blen))) ;;; -------------------------------------- ((> diff 0) (progn ;; (message "decrement one earlier!") (setq j diff carry 0 l nil) ;; (message "j=%d / alen=%d / blen=%d /diff=%d || a=%s b=%s" j alen blen diff a b) (while (< j alen) (setq sum (- (aref a (- j 1)) (aref b (- j diff)) carry) carry (if (< sum 0) 1 0)) (my-push (mod sum 2) l) (my-incf j)) (setq a (bits2bitnum (truncate-leading-0s (append l (my-loop-for-i-from-downto-append (- diff 2) 0 (list (- (aref a i) 48))))))) (setq alen (length a) diff (- alen blen)))) ;; ---------------------------------- (t (progn (message "error: uncaught case !") (beep)))) ;; (message (format "a became %s" a)) ) ;; ============ diff = 0 ==================== (if (bitnum< a b) a (bitnum- a b))))))) ;;(defun bitnum-mod (a b) ;; (my-second (bitnum-divmod a b))) ;;; comparison (defun bitnum< (a b) (let ((alen (length a)) (blen (length b))) (or (< alen blen) (and (= alen blen) (let ((i (- alen 1))) (while (and (> i 0) (equal (aref a i) (aref b i))) (my-decf i)) (and (>= i 0) (< (bitnum-nth-bit i a alen) (bitnum-nth-bit i b blen)))))))) (defun bitnum= (a b) (equal a b)) ;;; ------------------------------ ;;; AUX ;;; ------------------------------ (defun char2string (c) (format "%c" c)) (defun truncate-leading-0s (l) (cond ((null l) '(0)) ((= (car l) 0) (truncate-leading-0s (cdr l))) (t l))) (defun make-0-string (n) (sconc-list (my-loop-for-i-from-to-append 1 n '("0")))) ;;; ------------------------------ ;;; Arithmetic-Test ;;; ------------------------------ (defun random-test-bitnum+ () (interactive) (let ((a (used-random 1000000)) (b (used-random 1000000))) (if (= (+ a b) (bitnum2int (bitnum+ (int2bitnum a) (int2bitnum b)))) (message "ok") (message (format "error: %d %d" a b))))) (defun random-test-bitnum- () (interactive) (let* ((b (used-random 1000000)) (a (+ b (used-random 1000000)))) (if (= (- a b) (bitnum2int (bitnum- (int2bitnum a) (int2bitnum b)))) (message "ok") (message (format "error: %d %d" a b))))) (defun random-test-bitnum* () (interactive) (let ((a (used-random 1000)) (b (used-random 1000))) (if (= (* a b) (bitnum2int (bitnum* (int2bitnum a) (int2bitnum b)))) (message "ok") (message (format "error: %d %d" a b))))) (defun random-test-bitnum-div () (interactive) (let ((a (used-random 10000000)) (b (used-random 10000000))) (if (= (div a b) (bitnum2int (bitnum-div (int2bitnum a) (int2bitnum b)))) (message "ok") (message (format "error: %d %d" a b))))) (defun random-test-bitnum-mod () (interactive) (let ((a (used-random 10000000)) (b (used-random 10000000))) (if (= (mod a b) (bitnum2int (bitnum-mod (int2bitnum a) (int2bitnum b)))) (message "ok") (message (format "error: %d %d" a b))))) (defun test-mult-invert () (interactive) (let ((a (my-string-to-number (read-input "a: "))) (b (my-string-to-number (read-input "b: ")))) (if (equal (extended-euklid a b) (mapcar #'(lambda (x) (if (listp x) (- 0 (bitnum2int (car x))) (bitnum2int x))) (mult-invert-sub (int2bitnum a) (int2bitnum b)))) (message "ok") (message (format "error: (mult-invert %d %d) [wrong result]" a b))))) (defun small-test-bitnum-mod () (interactive) (let ((a (my-string-to-number (read-input "a: "))) (b (my-string-to-number (read-input "b: ")))) (if (= (mod a b) (bitnum2int (bitnum-mod (int2bitnum a) (int2bitnum b)))) (message (format "(bitnum-mod %d %d) -> ok" a b)) (message (format "error: %d %d" a b))))) (defun test-bitnum-mod () (interactive) (let* ((b (my-string-to-number (read-input "Modulus: "))) (bb (int2bitnum b))) (my-loop-for-i-from-to-do 0 1000 (if (= (mod i b) (bitnum2int (bitnum-mod (int2bitnum i) bb))) nil (progn (beep) (message (format "error: %d %d" i b))))) (message (format "Test on %d done." b)))) ;;; **************************************** ;;; Emacs Lisp Extensions ;;; **************************************** (defmacro my-case (var &rest arglist) `(let ((args (quote ,arglist))) (while (not (null args)) (if (equal ,var (car (car args))) (progn (let ((ex (cdr (car args)))) (while (not (null ex)) (eval (car ex)) (setq ex (cdr ex)))) (setq args nil)) (setq args (cdr args)))))) (defun my-assoc (a alist) (let ((notfound t)) (while (and notfound (not (null alist))) (if (equal (car (car alist)) a) (setq notfound nil) (setq alist (cdr alist)))) (if (null alist) nil (car alist)))) (defmacro my-unless (test &rest exec) `(if ,test nil (let ((e (quote ,exec))) (while (not (null e)) (eval (car e)) (setq e (cdr e)))))) (defmacro my-loop-for-e-in-do (list &rest exec) `(let ((e nil) (l ,list) (ex nil)) (while (not (listp l)) (setq l (eval l))) (while (not (null l)) (setq e (car l)) (setq l (cdr l)) (setq ex (quote ,exec)) (while (not (null ex)) (eval (car ex)) (setq ex (cdr ex))) ))) (defmacro my-loop-for-e-in-append (list &rest exec) `(let ((e nil) (l ,list) (ex nil) (res nil)) (while (not (null l)) (setq e (car l)) (setq l (cdr l)) (setq ex (quote ,exec)) (while (not (null ex)) (setq res (append res (eval (car ex)))) (setq ex (cdr ex)))) res)) (defmacro my-loop-for-i-from-to-do (start end &rest exec) `(let ((i ,start) (ex nil)) (while (<= i ,end) (setq ex (quote ,exec)) (while (not (null ex)) (eval (car ex)) (setq ex (cdr ex))) (setq i (+ i 1)) ))) (defmacro my-loop-for-j-from-to-do (start end &rest exec) `(let ((j ,start) (ex nil)) (while (<= j ,end) (setq ex (quote ,exec)) (while (not (null ex)) (eval (car ex)) (setq ex (cdr ex))) (setq j (+ j 1))))) (defmacro my-loop-for-i-from-to-append (start end &rest exec) `(let ((i ,start) (ex nil) (res nil)) (while (<= i ,end) (setq ex (quote ,exec)) (while (not (null ex)) (setq res (append res (eval (car ex)))) (setq ex (cdr ex))) (setq i (+ i 1))) res)) (defmacro my-loop-for-i-from-downto-append (start end &rest exec) `(let ((i ,start) (ex nil) (res nil)) (while (>= i ,end) (setq ex (quote ,exec)) (while (not (null ex)) (setq res (append res (eval (car ex)))) (setq ex (cdr ex))) (setq i (- i 1))) res)) (defun my-first (x) (car x)) (defun my-second (x) (car (cdr x))) (defun my-third (x) (car (cdr (cdr x)))) (defun my-fourth (x) (car (cdr (cdr (cdr x))))) (defun my-fifth (x) (car (cdr (cdr (cdr (cdr x)))))) (defun my-sixth (x) (car (cdr (cdr (cdr (cdr (cdr x))))))) (defun my-seventh (x) (car (cdr (cdr (cdr (cdr (cdr (cdr x)))))))) (defun my-eighth (x) (car (cdr (cdr (cdr (cdr (cdr (cdr (cdr x))))))))) (defmacro my-push (e var) `(setq ,var (cons ,e ,var))) (defmacro my-incf (var &rest r) `(setq ,var (+ (if (null (quote ,r)) 1 (eval (car (quote ,r)))) ,var))) (defmacro my-decf (var &rest r) `(setq ,var (- ,var (if (null (quote ,r)) 1 (eval (car (quote ,r))))))) (defmacro my-count (element list &rest funs) `(let ((c 0) (cmp (if (and (> (length (quote ,funs)) 0) (equal (car (quote ,funs)) (quote :TEST))) (eval (car (cdr (quote ,funs)))) #'eq))) (my-loop-for-e-in-do ,list (if (funcall cmp e ,element) (setq c (+ 1 c)))) c)) (defmacro my-some (pred list) `(let ((hit nil) (l ,list)) (while (and (not hit) l) (if (funcall ,pred (car l)) (setq hit t)) (setq l (cdr l))) hit)) (defmacro my-every (pred list) `(let ((hit t) (l ,list)) (while (and hit l) (if (not (funcall ,pred (car l))) (setq hit nil)) (setq l (cdr l))) hit)) (defun my-symbol-to-string (s) (format "%s" s)) (defun my-c-to-string (s) (format "%c" s)) (defun my-string-to-charlist (s) (let ((res nil)) (my-loop-for-i-from-downto-do (- (length s) 1) 0 (setq res (cons (my-string-pos-char s i) res))) res)) (defun my-string-pos-char (s pos) (aref s pos)) (defun my-substring (s from to) (let ((res nil)) (my-loop-for-i-from-downto-do (min (- (length s) 1) to) from (setq res (cons (my-string-pos-char s i) res))) (eval `(sconc ,@(mapcar #'my-c-to-string res))))) (defmacro sconc (&rest args) `(let ((s "") (a (quote ,args))) (while (not (null a)) (setq s (format "%s%s" s (eval (car a)))) (setq a (cdr a))) s)) (defun my-reverse (l) (if (null l) l (append (my-reverse (cdr l)) (list (car l))))) (defmacro my-remove-if (pred list) `(my-loop-for-e-in-append ,list (if (funcall ,pred e) nil (list e)))) (defun my-string-to-number (s) (let ((l (my-string-to-charlist s)) (res 0) (fault nil)) (my-loop-for-e-in-do l (if (and (<= 48 e) (<= e 57)) (setq res (+ (* 10 res) -48 e)) (setq fault t))) (if fault -1 res))) (defun my-last (l) (car (my-reverse l))) (defun my-last-char (s) (my-c-to-string (car (cons (my-last (my-string-to-charlist s)) (list 0))))) (defun mark-current-buffer-base64 () (let ((mark (point-marker)) (start nil)) (beginning-of-buffer) (search-forward "begin-base64") (setq start (point-marker)) (end-of-buffer) (kill-ring-save start (point-marker)) (goto-char mark) (message "<>"))) (defun mark-current-buffer () (let ((mark (point-marker)) (start nil)) (beginning-of-buffer) (setq start (point-marker)) (end-of-buffer) (kill-ring-save start (point-marker)) (goto-char mark) (message "<>"))) (defmacro my-assert (a &rest rr) `(if ,a nil (progn (beep) (message (format "Error: Assertion failed [%s] " (if (null (quote ,rr)) "?" (car (quote ,rr))))) (what-line)))) ;;; **************************************** ;;; Random and Pseudo-Random stuff.... ;;; **************************************** (defun used-random-bitnum (n) ;;; You might have to adjust the use of "random" a bit, for it is required ;;; to accept large integers as arguments ! (if *use-system-random-function* (int2bitnum (random (bitnum2int n))) (bbs-pseudo-random n))) (defconst *bbs-random-mod* "100100110100010000111010101001000001000110110011110000000111101010011000001110000011010011110101101110101111011100111001000001110011101101111110001000011111100000110110000000011001101001010011000001111101000100110101000101111010101011010001111101101101101101001010111110001001100011010010000001011010010101100101100011110001100000111111000000100110011000001110001011110000111101000010100011000110011001011101111110100011100111011111110111001110010100100110010110001110101111110111111111010011101001001") (defun used-random-bit () (if *use-system-random-function* (if (equal 0 (random 2)) "0" "1") (setq *bbs-random-seed* (bitnum-mod (bitnum* *bbs-random-seed* *bbs-random-seed*) *bbs-random-mod*)) (if (equal 48 (aref *bbs-random-seed* 0)) "0" "1"))) (defun used-random (n) (bitnum2int (used-random-bitnum (int2bitnum n)))) (defun get-random-seed () (let ((pos nil) (name (buffer-name)) (res nil) (input (read-input "Please enter long random string (> 80 chars): "))) (switch-to-buffer "*scratch*") (end-of-buffer) (setq pos (point-marker)) (shell-command (format "date +%s" "S") t) (end-of-line) (kill-ring-save pos (point-marker)) (setq res (sconc (car kill-ring) input (car kill-ring))) (goto-char pos) (kill-line 2) (switch-to-buffer name) (bits2bitnum (string-to-bits res)))) (defun bbs-pseudo-random (&rest n) (let ((m (if (null n) "0000000001" (car n)))) (setq *bbs-random-seed* (bitnum-mod (bitnum+ "01010110001111000010011011010001011010110101011000101110001001101011001001011000011010110101011000110101001110010111000111111000100111001011111100001100000010011000001011110001011111111110101010010000111100100010000001111111101000100010010101111101111000011011110101011101001110101011101000111001010100011011010011100110101101110000011111100001100000111110001011110011011010101110110010101" (bitnum* *bbs-random-seed* *bbs-random-seed*)) *bbs-random-mod*)) (bitnum-mod *bbs-random-seed* m))) (defun random-verybig-slow (k n) ;; random-slow ;; very big and not exactly uniformly distributed random numbers ;; k must reflect the log2 (n) (it's not evaluatable any more) ;; (is quite slow!) ;; --- uses '13 more' bits than required ;; The distribution is not exactly uniform any more (if it ever was), but ;; should still be good enough [(**) or do you have a good argument against ;; this? ] (let ((res "0")) (my-loop-for-i-from-to-do 1 (+ k 13) (setq res (bitnum+ (used-random-bit) (bitnum-times-2** res 1)))) (bitnum-mod res n))) (defun random-verybig (k n) ;; very big and not exactly uniformly distributed random numbers ;; k must reflect the log2 (n) (it's not evaluatable any more) ;; (is quite slow!) ;; n is a bitnum ;; --- uses '13 more' bits than required ;; The distribution is not exactly uniform any more (if it ever was), but ;; should still be good enough [(**) or do you have a good argument against ;; this? ] ;; trust used-random function to be 'fairly random' up to 500 bits (!) (let ((res (used-random-bitnum "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001"))) (my-loop-for-i-from-to-do 1 (div (+ k 13) 500) (setq res (bitnum+ (used-random-bitnum "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001") (bitnum-times-2** res 500)))) (bitnum-mod res n))) (defvar *bbs-random-seed* (if *use-system-random-function* 1999 (bitnum-mod (get-random-seed) *bbs-random-mod*))) ;;; *************************************************************** ;;; Sanity Check: To be sure: check that we got the factoization of p-1: (my-assert (bitnum= *p* (bitnum+ "1" (apply #'bitnum* (mapcar #'(lambda (x) (bitnum-expt (car x) (cdr x))) *p-1-factorization*)))) "Sanity Check") ;;; A primality test on p is usually omitted, for it will take some time (!) ; (my-assert (miller-rabin *k* *p* (expt 10 -60)) "Sanitiy Check II") ;;; *************************************************************** ;;; ============================== ;;; ============================== ;;; = Emacs Commands = ;;; ============================== ;;; ============================== (defun cs-encrypt-buffer () (interactive) (let* ((name (buffer-name)) (cname (sconc name ".cse")) (pk (cdr (my-assoc *cs-recipient* *cs-list-of-public-keys*)))) (if (null pk) (progn (beep) (message (format "error - Unknown recipient: %s" *cs-recipient*))) (progn (message (format "Encrypting with public key of %s" *cs-recipient*)) (mark-current-buffer) (switch-to-buffer-other-window cname) (end-of-buffer) (insert (encrypt-ascii-to-base64 (car kill-ring) pk)))))) (defun cs-decrypt-buffer () (interactive) (let* ((name (buffer-name)) (dname (sconc name ".csd"))) (mark-current-buffer-base64) (switch-to-buffer-other-window dname) (end-of-buffer) (insert (decrypt-base64-to-ascii (car kill-ring) )))) (defun create-cramer-shoup () ;;; Allow some time for this to finish (best call it in a emacs window you do ;;; _not_ work with at the moment/) ;;; This command will insert the generated key-pair in the buffer from ;;; which it was called, so e.g. call it in *scratch*. ;;; Note that *p* has to be fixed in advance. (interactive) (let* ((gen (used-create-4-generator)) (g1 (my-first gen)) (g2 (my-second gen)) (g3 (my-third gen)) (g4 (my-fourth gen)) (p *p*) (p-1 (bitnum- p "1")) (x1 (bitnum+ "1" (random-verybig *k* p-1))) (x2 (bitnum+ "1" (random-verybig *k* p-1))) (y1 (bitnum+ "1" (random-verybig *k* p-1))) (y2 (bitnum+ "1" (random-verybig *k* p-1))) (z (bitnum+ "1" (random-verybig *k* p-1))) (c (bitnum-mod (bitnum* (mod-exp g1 x1 p) (mod-exp g2 x2 p)) p)) (d (bitnum-mod (bitnum* (mod-exp g1 y1 p) (mod-exp g2 y2 p)) p)) (h (mod-exp g1 z p)) (Hash `(,g3 ,g4)) ) ;;;; The pair ( (pk) , (sk) ): (insert (format "(defconst *cs-personal-public-key* '(%d \n \"%s\" \n \"%s\" \n \"%s\" \n \"%s\" \n \"%s\" \n \"%s\" \n (\"%s\" \n \"%s\")))\n\n (defconst *cs-personal-secret-key* '(%d \n \"%s\" \n \"%s\" \n \"%s\" \n \"%s\" \n \"%s\" \n \"%s\" \n (\"%s\" \n \"%s\")))\n" *k* p g1 g2 c d h (my-first Hash) (my-second Hash) *k* p x1 x2 y1 y2 z (my-first Hash) (my-second Hash) )))) ;;; ************************************************** ;;; The Cramer-Shoup System - here is comes! ;;; ************************************************** (defun cramer-shoup-encrypt (m pk) (let* ((p (my-second pk)) (k (my-first pk)) (g1 (my-third pk)) (g2 (my-fourth pk)) (c (my-fifth pk)) (d (my-sixth pk)) (h (my-seventh pk)) (Hash (my-eighth pk)) (r (bitnum+ "1" (random-verybig k (bitnum- p "01")))) (u1 (mod-exp g1 r p)) (u2 (mod-exp g2 r p)) (e (bitnum-mod (bitnum* (mod-exp h r p) m) p)) (alpha (apply-hash-on-bitlist k p (car Hash) (car (cdr Hash)) (append (bitnum2bits u1 k) (bitnum2bits u2 k) (bitnum2bits e k)))) (v (bitnum-mod (bitnum* (mod-exp c r p) (mod-exp d (bitnum* r alpha) p)) p)) ) `(,u1 ,u2 ,e ,v) )) (defun cramer-shoup-decrypt (ct sk) (let* ((p (my-second sk)) (k (my-first sk)) (x1 (my-third sk)) (x2 (my-fourth sk)) (y1 (my-fifth sk)) (y2 (my-sixth sk)) (z (my-seventh sk)) (Hash (my-eighth sk)) (u1 (my-first ct)) (u2 (my-second ct)) (e (my-third ct)) (v (my-fourth ct)) (alpha (apply-hash-on-bitlist k p (car Hash) (car (cdr Hash)) (append (bitnum2bits u1 k) (bitnum2bits u2 k) (bitnum2bits e k)))) ) (if (bitnum= v (bitnum-mod (bitnum* (mod-exp u1 (bitnum+ x1 (bitnum* alpha y1)) p) (mod-exp u2 (bitnum+ x2 (bitnum* alpha y2)) p)) p)) (bitnum-mod (bitnum* e (mult-invert (mod-exp u1 z p) p)) p) (progn (message "Cryptotext rejected [faulty key].") (beep))))) ;;; ========================================================================= (provide 'cs-crypt)