cryptokit-1.9/0000755000175000017500000000000012204467510012736 5ustar gildorgildorcryptokit-1.9/INSTALL.txt0000644000175000017500000000157611600677160014621 0ustar gildorgildor(* OASIS_START *) (* DO NOT EDIT (digest: 5875d34710956262bf8450dd73a4ab67) *) This is the INSTALL file for the cryptokit distribution. This package uses OASIS to generate its build system. See section OASIS for full information. Dependencies ============ In order to compile this package, you will need: * ocaml for all, test bench, test main, doc api-cryptokit * findlib Installing ========== 1. Uncompress the source archive and go to the root of the package 2. Run 'ocaml setup.ml -configure' 3. Run 'ocaml setup.ml -build' 4. Run 'ocaml setup.ml -install' Uninstalling ============ 1. Go to the root of the package 2. Run 'ocaml setup.ml -uninstall' OASIS ===== OASIS is a program that generates a setup.ml file using a simple '_oasis' configuration file. The generated setup only depends on the standard OCaml installation: no additional library is required. (* OASIS_STOP *) cryptokit-1.9/src/0000755000175000017500000000000012204467510013525 5ustar gildorgildorcryptokit-1.9/src/cryptokit.mllib0000644000175000017500000000013611437417344016605 0ustar gildorgildor# OASIS_START # DO NOT EDIT (digest: d586d2d8e875c6d12e9f4739a5513496) Cryptokit # OASIS_STOP cryptokit-1.9/src/META0000644000175000017500000000052612203256516014202 0ustar gildorgildor# OASIS_START # DO NOT EDIT (digest: 3421e30da5d29021717d89ad5ddd6a1a) version = "1.9" description = "Cryptographic primitives" requires = "unix num" archive(byte) = "cryptokit.cma" archive(byte, plugin) = "cryptokit.cma" archive(native) = "cryptokit.cmxa" archive(native, plugin) = "cryptokit.cmxs" exists_if = "cryptokit.cma" # OASIS_STOP cryptokit-1.9/src/stubs-sha256.c0000644000175000017500000000314711436706614016053 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2004 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-sha256.c 53 2010-08-30 10:53:00Z gildor-admin $ */ #include "sha256.h" #include #include #include #define Context_val(v) ((struct SHA256Context *) String_val(v)) CAMLprim value caml_sha256_init(value unit) { value ctx = alloc_string(sizeof(struct SHA256Context)); SHA256_init(Context_val(ctx)); return ctx; } CAMLprim value caml_sha256_update(value ctx, value src, value ofs, value len) { SHA256_add_data(Context_val(ctx), &Byte_u(src, Long_val(ofs)), Long_val(len)); return Val_unit; } CAMLprim value caml_sha256_final(value ctx) { CAMLparam1(ctx); CAMLlocal1(res); res = alloc_string(32); SHA256_finish(Context_val(ctx), &Byte_u(res, 0)); CAMLreturn(res); } cryptokit-1.9/src/sha256.c0000644000175000017500000001405311436706614014713 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2004 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: sha256.c 53 2010-08-30 10:53:00Z gildor-admin $ */ /* SHA-256 hashing */ #include #include #include "sha256.h" /* Ref: FIPS publication 180-2 */ #define ROTR(x,n) ((x) >> (n) | (x) << (32 - (n))) #define CH(x,y,z) (z ^ (x & (y ^ z))) #define MAJ(x,y,z) ((x & y) | (z & (x | y))) #define SIGMA0(x) (ROTR(x,2) ^ ROTR(x,13) ^ ROTR(x,22)) #define SIGMA1(x) (ROTR(x,6) ^ ROTR(x,11) ^ ROTR(x,25)) #define sigma0(x) (ROTR(x,7) ^ ROTR(x,18) ^ (x >> 3)) #define sigma1(x) (ROTR(x,17) ^ ROTR(x,19) ^ (x >> 10)) static void SHA256_copy_and_swap(void * src, void * dst, int numwords) { #ifdef ARCH_BIG_ENDIAN memcpy(dst, src, numwords * sizeof(u32)); #else unsigned char * s, * d; unsigned char a, b; for (s = src, d = dst; numwords > 0; s += 4, d += 4, numwords--) { a = s[0]; b = s[1]; d[0] = s[3]; d[1] = s[2]; d[2] = b; d[3] = a; } #endif } static u32 SHA256_constants[64] = { 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5, 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967, 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070, 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3, 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2 }; static void SHA256_transform(struct SHA256Context * ctx) { int i; register u32 a, b, c, d, e, f, g, h, t1, t2; u32 data[80]; /* Convert buffer data to 16 big-endian integers */ SHA256_copy_and_swap(ctx->buffer, data, 16); /* Expand into 80 integers */ for (i = 16; i < 80; i++) { data[i] = sigma1(data[i-2]) + data[i-7] + sigma0(data[i-15]) + data[i-16]; } /* Initialize working variables */ a = ctx->state[0]; b = ctx->state[1]; c = ctx->state[2]; d = ctx->state[3]; e = ctx->state[4]; f = ctx->state[5]; g = ctx->state[6]; h = ctx->state[7]; /* Perform rounds */ #if 0 for (i = 0; i < 64; i++) { t1 = h + SIGMA1(e) + CH(e, f, g) + SHA256_constants[i] + data[i]; t2 = SIGMA0(a) + MAJ(a, b, c); h = g; g = f; f = e; e = d + t1; d = c; c = b; b = a; a = t1 + t2; } #else #define STEP(a,b,c,d,e,f,g,h,i) \ t1 = h + SIGMA1(e) + CH(e, f, g) + SHA256_constants[i] + data[i]; \ t2 = SIGMA0(a) + MAJ(a, b, c); \ d = d + t1; \ h = t1 + t2 for (i = 0; i < 64; i += 8) { STEP(a,b,c,d,e,f,g,h,i); STEP(h,a,b,c,d,e,f,g,i+1); STEP(g,h,a,b,c,d,e,f,i+2); STEP(f,g,h,a,b,c,d,e,i+3); STEP(e,f,g,h,a,b,c,d,i+4); STEP(d,e,f,g,h,a,b,c,i+5); STEP(c,d,e,f,g,h,a,b,i+6); STEP(b,c,d,e,f,g,h,a,i+7); } #endif /* Update chaining values */ ctx->state[0] += a; ctx->state[1] += b; ctx->state[2] += c; ctx->state[3] += d; ctx->state[4] += e; ctx->state[5] += f; ctx->state[6] += g; ctx->state[7] += h; } void SHA256_init(struct SHA256Context * ctx) { ctx->state[0] = 0x6A09E667; ctx->state[1] = 0xBB67AE85; ctx->state[2] = 0x3C6EF372; ctx->state[3] = 0xA54FF53A; ctx->state[4] = 0x510E527F; ctx->state[5] = 0x9B05688C; ctx->state[6] = 0x1F83D9AB; ctx->state[7] = 0x5BE0CD19; ctx->numbytes = 0; ctx->length[0] = 0; ctx->length[1] = 0; } void SHA256_add_data(struct SHA256Context * ctx, unsigned char * data, unsigned long len) { u32 t; /* Update length */ t = ctx->length[1]; if ((ctx->length[1] = t + (u32) (len << 3)) < t) ctx->length[0]++; /* carry from low 32 bits to high 32 bits */ ctx->length[0] += (u32) (len >> 29); /* If data was left in buffer, pad it with fresh data and munge block */ if (ctx->numbytes != 0) { t = 64 - ctx->numbytes; if (len < t) { memcpy(ctx->buffer + ctx->numbytes, data, len); ctx->numbytes += len; return; } memcpy(ctx->buffer + ctx->numbytes, data, t); SHA256_transform(ctx); data += t; len -= t; } /* Munge data in 64-byte chunks */ while (len >= 64) { memcpy(ctx->buffer, data, 64); SHA256_transform(ctx); data += 64; len -= 64; } /* Save remaining data */ memcpy(ctx->buffer, data, len); ctx->numbytes = len; } void SHA256_finish(struct SHA256Context * ctx, unsigned char output[32]) { int i = ctx->numbytes; /* Set first char of padding to 0x80. There is always room. */ ctx->buffer[i++] = 0x80; /* If we do not have room for the length (8 bytes), pad to 64 bytes with zeroes and munge the data block */ if (i > 56) { memset(ctx->buffer + i, 0, 64 - i); SHA256_transform(ctx); i = 0; } /* Pad to byte 56 with zeroes */ memset(ctx->buffer + i, 0, 56 - i); /* Add length in big-endian */ SHA256_copy_and_swap(ctx->length, ctx->buffer + 56, 2); /* Munge the final block */ SHA256_transform(ctx); /* Final hash value is in ctx->state modulo big-endian conversion */ SHA256_copy_and_swap(ctx->state, output, 8); } cryptokit-1.9/src/sha256.h0000644000175000017500000000255611436706614014725 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: sha256.h 53 2010-08-30 10:53:00Z gildor-admin $ */ /* SHA-256 hashing */ typedef unsigned int u32; struct SHA256Context { u32 state[8]; u32 length[2]; int numbytes; unsigned char buffer[64]; }; extern void SHA256_init(struct SHA256Context * ctx); extern void SHA256_add_data(struct SHA256Context * ctx, unsigned char * data, unsigned long len); extern void SHA256_finish(struct SHA256Context * ctx, unsigned char output[32]); cryptokit-1.9/src/api-cryptokit.odocl0000644000175000017500000000013611437417344017355 0ustar gildorgildor# OASIS_START # DO NOT EDIT (digest: d586d2d8e875c6d12e9f4739a5513496) Cryptokit # OASIS_STOP cryptokit-1.9/src/keccak.c0000644000175000017500000001216512135543724015124 0ustar gildorgildor/* SHA-3 (Keccak) cryptographic hash function */ /* Code adapted from the "readable" implementation written by Markku-Juhani O. Saarinen */ #include #include #include #include "keccak.h" #define KECCAK_ROUNDS 24 #define ROTL64(x, y) (((x) << (y)) | ((x) >> (64 - (y)))) static const u64 keccakf_rndc[24] = { 0x0000000000000001, 0x0000000000008082, 0x800000000000808a, 0x8000000080008000, 0x000000000000808b, 0x0000000080000001, 0x8000000080008081, 0x8000000000008009, 0x000000000000008a, 0x0000000000000088, 0x0000000080008009, 0x000000008000000a, 0x000000008000808b, 0x800000000000008b, 0x8000000000008089, 0x8000000000008003, 0x8000000000008002, 0x8000000000000080, 0x000000000000800a, 0x800000008000000a, 0x8000000080008081, 0x8000000000008080, 0x0000000080000001, 0x8000000080008008 }; #if 0 /* Inlined */ static const int keccakf_rotc[24] = { 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 2, 14, 27, 41, 56, 8, 25, 43, 62, 18, 39, 61, 20, 44 }; static const int keccakf_piln[24] = { 10, 7, 11, 17, 18, 3, 5, 16, 8, 21, 24, 4, 15, 23, 19, 13, 12, 2, 20, 14, 22, 9, 6, 1 }; #endif /* Update the state with KECCAK_ROUND rounds */ static void KeccakPermutation(u64 st[25]) { int round, j; u64 t, bc[5]; for (round = 0; round < KECCAK_ROUNDS; round++) { // Theta #define THETA1(i) \ bc[i] = st[i] ^ st[i + 5] ^ st[i + 10] ^ st[i + 15] ^ st[i + 20] THETA1(0); THETA1(1); THETA1(2); THETA1(3); THETA1(4); #define THETA2(i) \ t = bc[(i + 4) % 5] ^ ROTL64(bc[(i + 1) % 5], 1); \ st[0 + i] ^= t; \ st[5 + i] ^= t; \ st[10 + i] ^= t; \ st[15 + i] ^= t; \ st[20 + i] ^= t THETA2(0); THETA2(1); THETA2(2); THETA2(3); THETA2(4); // Rho Pi #define RHOPI(i, rotc, piln) \ bc[0] = st[piln]; \ st[piln] = ROTL64(t, rotc); \ t = bc[0] t = st[1]; RHOPI(0, 1, 10); RHOPI(1, 3, 7); RHOPI(2, 6, 11); RHOPI(3, 10, 17); RHOPI(4, 15, 18); RHOPI(5, 21, 3); RHOPI(6, 28, 5); RHOPI(7, 36, 16); RHOPI(8, 45, 8); RHOPI(9, 55, 21); RHOPI(10, 2, 24); RHOPI(11, 14, 4); RHOPI(12, 27, 15); RHOPI(13, 41, 23); RHOPI(14, 56, 19); RHOPI(15, 8, 13); RHOPI(16, 25, 12); RHOPI(17, 43, 2); RHOPI(18, 62, 20); RHOPI(19, 18, 14); RHOPI(20, 39, 22); RHOPI(21, 61, 9); RHOPI(22, 20, 6); RHOPI(23, 44, 1); // Chi #define CHI1(i,j) \ bc[i] = st[j + i] #define CHI2(i,j) \ st[j + i] ^= (~bc[(i + 1) % 5]) & bc[(i + 2) % 5] for (j = 0; j < 25; j += 5) { CHI1(0,j); CHI1(1,j); CHI1(2,j); CHI1(3,j); CHI1(4,j); CHI2(0,j); CHI2(1,j); CHI2(2,j); CHI2(3,j); CHI2(4,j); } // Iota st[0] ^= keccakf_rndc[round]; } } /* Absorb the given data and permute */ static void KeccakAbsorb(u64 st[25], unsigned char * p, int rsiz) { int i; rsiz = rsiz / 8; for (i = 0; i < rsiz; i += 1, p += 8) { // fixme: use direct access for little-endian platforms without // alignment constraints? unsigned int l = p[0] | (p[1] << 8) | (p[2] << 16) | (p[3] << 24); unsigned int h = p[4] | (p[5] << 8) | (p[6] << 16) | (p[7] << 24); st[i] ^= l | ((unsigned long long) h << 32); } KeccakPermutation(st); } /* Exported interface */ void SHA3_init(struct SHA3Context * ctx, int hsiz) { assert (hsiz == 224 || hsiz == 256 || hsiz == 384 || hsiz == 512); ctx->hsiz = hsiz / 8; ctx->rsiz = 200 - 2 * ctx->hsiz; ctx->numbytes = 0; memset(ctx->state, 0, sizeof(ctx->state)); } void SHA3_absorb(struct SHA3Context * ctx, unsigned char * data, unsigned long len) { int n; /* If data was left in buffer, fill with fresh data and absorb */ if (ctx->numbytes != 0) { n = ctx->rsiz - ctx->numbytes; if (len < n) { memcpy(ctx->buffer + ctx->numbytes, data, len); ctx->numbytes += len; return; } memcpy(ctx->buffer + ctx->numbytes, data, n); KeccakAbsorb(ctx->state, ctx->buffer, ctx->rsiz); data += n; len -= n; } /* Absorb data in blocks of [rsiz] bytes */ while (len >= ctx->rsiz) { KeccakAbsorb(ctx->state, data, ctx->rsiz); data += ctx->rsiz; len -= ctx->rsiz; } /* Save remaining data */ if (len > 0) memcpy(ctx->buffer, data, len); ctx->numbytes = len; } void SHA3_extract(struct SHA3Context * ctx, unsigned char * output) { int i, j, n; /* Apply final padding */ n = ctx->numbytes; ctx->buffer[n] = 1; n++; memset(ctx->buffer + n, 0, ctx->rsiz - n); ctx->buffer[ctx->rsiz - 1] |= 0x80; /* Absorb remaining data + padding */ KeccakAbsorb(ctx->state, ctx->buffer, ctx->rsiz); /* Extract hash as low bits of state */ for (i = 0, j = 0; j < ctx->hsiz; i += 1, j += 8) { u64 st = ctx->state[i]; output[j] = st; output[j + 1] = st >> 8; output[j + 2] = st >> 16; output[j + 3] = st >> 24; if (j + 4 >= ctx->hsiz) break; output[j + 4] = st >> 32; output[j + 5] = st >> 40; output[j + 6] = st >> 48; output[j + 7] = st >> 56; } } cryptokit-1.9/src/stubs-md5.c0000644000175000017500000000365311436706614015532 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-md5.c 53 2010-08-30 10:53:00Z gildor-admin $ */ #include #include #include struct MD5Context { uint32 buf[4]; uint32 bits[2]; unsigned char in[64]; }; CAMLextern void caml_MD5Init (struct MD5Context *context); CAMLextern void caml_MD5Update (struct MD5Context *context, unsigned char *buf, unsigned len); CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx); #define Context_val(v) ((struct MD5Context *) String_val(v)) CAMLprim value caml_md5_init(value unit) { value ctx = alloc_string(sizeof(struct MD5Context)); caml_MD5Init(Context_val(ctx)); return ctx; } CAMLprim value caml_md5_update(value ctx, value src, value ofs, value len) { caml_MD5Update(Context_val(ctx), &Byte_u(src, Long_val(ofs)), Long_val(len)); return Val_unit; } CAMLprim value caml_md5_final(value ctx) { CAMLparam1(ctx); CAMLlocal1(res); res = alloc_string(16); caml_MD5Final(&Byte_u(res, 0), Context_val(ctx)); CAMLreturn(res); } cryptokit-1.9/src/stubs-rng.c0000644000175000017500000000475511436706614015637 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2003 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-rng.c 53 2010-08-30 10:53:00Z gildor-admin $ */ /* Stub code for the system-provided RNG */ #include #include #include #include #ifdef _WIN32 /* Inspired by Mike Lin's port of Cryptokit 1.0 */ #define _WIN32_WINNT 0x0400 #define WIN32_LEAN_AND_MEAN #include #include #ifndef CRYPT_SILENT #define CRYPT_SILENT 0 #endif #define HCRYPTPROV_val(v) (*((HCRYPTPROV *) &Field(v, 0))) CAMLprim value caml_get_system_rng(value unit) { HCRYPTPROV prov; value res; if (! CryptAcquireContext(&prov, NULL, NULL, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT | CRYPT_SILENT)) raise_not_found(); res = alloc((sizeof(HCRYPTPROV) + sizeof(value) - 1) / sizeof(value), Abstract_tag); HCRYPTPROV_val(res) = prov; return res; } CAMLprim value caml_close_system_rng(value vhc) { CryptReleaseContext(HCRYPTPROV_val(vhc), 0); return Val_unit; } CAMLprim value caml_system_rng_random_bytes(value vhc, value str, value ofs, value len) { return Val_bool(CryptGenRandom(HCRYPTPROV_val(vhc), Long_val(len), &Byte(str, Long_val(ofs)))); } #else CAMLprim value caml_get_system_rng(value unit) { raise_not_found(); return Val_unit; /* not reached */ } CAMLprim value caml_close_system_rng(value vhc) { return Val_unit; } CAMLprim value caml_system_rng_random_bytes(value vhc, value str, value ofs, value len) { return Val_false; } #endif cryptokit-1.9/src/keccak.h0000644000175000017500000000117612135543724015131 0ustar gildorgildor/* SHA-3 (Keccak) cryptographic hash function */ typedef unsigned long long u64; struct SHA3Context { u64 state[25]; unsigned char buffer[144]; int numbytes; /* number of bytes in buffer */ int rsiz; /* number of message bytes processed by permutation */ int hsiz; /* size of hash in bytes */ }; extern void SHA3_init(struct SHA3Context * ctx, int hsiz); extern void SHA3_absorb(struct SHA3Context * ctx, unsigned char * data, unsigned long len); extern void SHA3_extract(struct SHA3Context * ctx, unsigned char * output); cryptokit-1.9/src/libcryptokit_stubs.clib0000644000175000017500000000051712135543724020327 0ustar gildorgildor# OASIS_START # DO NOT EDIT (digest: 5e9eced2deea37efe462dfd9e5f6e78f) arcfour.o stubs-arcfour.o blowfish.o stubs-blowfish.o d3des.o stubs-des.o rijndael-alg-fst.o ripemd160.o stubs-ripemd160.o sha1.o stubs-sha1.o sha256.o stubs-sha256.o stubs-aes.o stubs-md5.o stubs-misc.o stubs-rng.o stubs-zlib.o keccak.o stubs-sha3.o # OASIS_STOP cryptokit-1.9/src/cryptokit.mli0000644000175000017500000014770012135543724016276 0ustar gildorgildor(***********************************************************************) (* *) (* The Cryptokit library *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2002 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License, with *) (* the special exception on linking described in file LICENSE. *) (* *) (***********************************************************************) (* $Id: cryptokit.mli 71 2013-04-23 17:41:40Z xleroy $ *) (** The Cryptokit library provides a variety of cryptographic primitives that can be used to implement cryptographic protocols in security-sensitive applications. The primitives provided include: - Symmetric-key ciphers: AES, DES, Triple-DES, ARCfour, in ECB, CBC, CFB and OFB modes. - Public-key cryptography: RSA encryption, Diffie-Hellman key agreement. - Hash functions and MACs: SHA-1, SHA-256, SHA-3, RIPEMD-160, MD5, and MACs based on AES and DES. - Random number generation. - Encodings and compression: base 64, hexadecimal, Zlib compression. To use this library, link with [ocamlc unix.cma nums.cma cryptokit.cma] or [ocamlopt unix.cmxa nums.cmxa cryptokit.cmxa]. *) (** {6 General-purpose abstract interfaces} *) (** A transform is an arbitrary mapping from sequences of characters to sequences of characters. Examples of transforms include ciphering, deciphering, compression, decompression, and encoding of binary data as text. Input data to a transform is provided by successive calls to the methods [put_substring], [put_string], [put_char] or [put_byte]. The result of transforming the input data is buffered internally, and can be obtained via the [get_string], [get_substring], [get_char] and [get_byte] methods. *) class type transform = object method put_substring: string -> int -> int -> unit (** [put_substring str pos len] processes [len] characters of string [str], starting at character number [pos], through the transform. *) method put_string: string -> unit (** [put_string str] processes all characters of string [str] through the transform. *) method put_char: char -> unit (** [put_char c] processes character [c] through the transform. *) method put_byte: int -> unit (** [put_byte b] processes the character having code [b] through the transform. [b] must be between [0] and [255] inclusive. *) method finish: unit (** Call method [finish] to indicate that no further data will be processed through the transform. This causes the transform to flush its internal buffers and perform all appropriate finalization actions, e.g. add final padding. Raise [Error Wrong_data_length] if the total length of input data provided via the [put_*] methods is not an integral number of the input block size (see {!Cryptokit.transform.input_block_size}). After calling [finish], the transform can no longer accept additional data. Hence, do not call any of the [put_*] methods nor [flush] after calling [finish]. *) method flush: unit (** [flush] causes the transform to flush its internal buffers and make all output processed up to this point available through the [get_*] methods. Raise [Error Wrong_data_length] if the total length of input data provided via the [put_*] methods is not an integral number of the input block size (see {!Cryptokit.transform.input_block_size}). (For padded block ciphers, the input block size used here is that of the underlying block cipher, without the padding.) Unlike method [finish], method [flush] does not add final padding and leaves the transform in a state where it can still accept more input. *) method available_output: int (** Return the number of characters of output currently available. The output can be recovered with the [get_*] methods. *) method get_string: string (** Return a character string containing all output characters available at this point. The internal output buffer is emptied; in other terms, all currently available output is consumed (and returned to the caller) by a call to [get_string]. *) method get_substring: string * int * int (** Return a triple [(buf,pos,len)], where [buf] is the internal output buffer for the transform, [pos] the position of the first character of available output, and [len] the number of characters of available output. The string [buf] will be modified later, so the caller must immediately copy characters [pos] to [pos+len-1] of [buf] to some other location. The internal output buffer is emptied; in other terms, all currently available output is consumed (and returned to the caller) by a call to [get_substring]. *) method get_char: char (** Return the first character of output, and remove it from the internal output buffer. Raise [End_of_file] if no output is currently available. *) method get_byte: int (** Return the code of the first character of output, and remove it from the internal output buffer. Raise [End_of_file] if no output is currently available. *) method input_block_size: int (** Some transforms (e.g. unpadded block ciphers) process input data by blocks of several characters. This method returns the size of input blocks for the current transform. If [input_block_size > 1], the user of the transform must ensure that the total length of input data provided between calls to [flush] and [finish] is an integral multiple of [input_block_size]. If [input_block_size = 1], the transform can accept input data of arbitrary length. *) method output_block_size: int (** Some transforms (e.g. block ciphers) always produce output data by blocks of several characters. This method returns the size of output blocks for the current transform. If [output_block_size > 1], the total length of output data produced by the transform is always an integral multiple of [output_block_size]. If [output_block_size = 1], the transform produces output data of arbitrary length. *) method wipe: unit (** Erase all internal buffers and data structures of this transform, overwriting them with zeroes. A transform may contain sensitive data such as secret key-derived material, or parts of the input or output data. Calling [wipe] ensures that this sensitive data will not remain in memory longer than strictly necessary, thus making invasive attacks more difficult. It is thus prudent practice to call [wipe] on every transform that the program no longer needs. After calling [wipe], the transform is no longer in a working state: do not call any other methods after calling [wipe]. *) end val transform_string: transform -> string -> string (** [transform_string t s] runs the string [s] through the transform [t] and returns the transformed string. The transform [t] is wiped before returning, hence can no longer be used for further transformations. *) val transform_channel: transform -> ?len:int -> in_channel -> out_channel -> unit (** [transform_channel t ic oc] reads characters from input channel [ic], runs them through the transform [t], and writes the transformed data to the output channel [oc]. If the optional [len] argument is provided, exactly [len] characters are read from [ic] and transformed; [End_of_file] is raised if [ic] does not contain at least [len] characters. If [len] is not provided, [ic] is read all the way to end of file. The transform [t] is wiped before returning, hence can no longer be used for further transformations. *) val compose: transform -> transform -> transform (** Compose two transforms, feeding the output of the first transform to the input of the second transform. *) (** A hash is a function that maps arbitrarily-long character sequences to small, fixed-size strings. *) class type hash = object method add_substring: string -> int -> int -> unit (** [add_substring str pos len] adds [len] characters from string [str], starting at character number [pos], to the running hash computation. *) method add_string: string -> unit (** [add_string str] adds all characters of string [str] to the running hash computation. *) method add_char: char -> unit (** [add_char c] adds character [c] to the running hash computation. *) method add_byte: int -> unit (** [add_byte b] adds the character having code [b] to the running hash computation. [b] must be between [0] and [255] inclusive. *) method result: string (** Terminate the hash computation and return the hash value for the input data provided via the [add_*] methods. The hash value is a string of length [hash_size] characters. After calling [result], the hash can no longer accept additional data. Hence, do not call any of the [add_*] methods after [result]. *) method hash_size: int (** Return the size of hash values produced by this hash function, in bytes. *) method wipe: unit (** Erase all internal buffers and data structures of this hash, overwriting them with zeroes. See {!Cryptokit.transform.wipe}. *) end val hash_string: hash -> string -> string (** [hash_string h s] runs the string [s] through the hash function [h] and returns the hash value of [s]. The hash [h] is wiped before returning, hence can no longer be used for further hash computations. *) val hash_channel: hash -> ?len:int -> in_channel -> string (** [hash_channel h ic] reads characters from the input channel [ic], computes their hash value and returns it. If the optional [len] argument is provided, exactly [len] characters are read from [ic] and hashed; [End_of_file] is raised if [ic] does not contain at least [len] characters. If [len] is not provided, [ic] is read all the way to end of file. The hash [h] is wiped before returning, hence can no longer be used for further hash computations. *) (** {6 Utilities: random numbers and padding schemes} *) (** The [Random] module provides random and pseudo-random number generators suitable for generating cryptographic keys, nonces, or challenges. *) module Random : sig class type rng = object method random_bytes: string -> int -> int -> unit (** [random_bytes buf pos len] stores [len] random bytes in string [buf], starting at position [pos]. *) method wipe: unit (** Erases the internal state of the generator. Do not call [random_bytes] after calling [wipe]. *) end (** Generic interface for a random number generator. *) val string: rng -> int -> string (** [random_string rng len] returns a string of [len] random bytes read from the generator [rng]. *) val secure_rng: rng (** A high-quality random number generator, using hard-to-predict system data to generate entropy. This generator either uses the OS-provided RNG, if any, or reads from [/dev/random] on systems that supports it, or interrogates the EGD daemon otherwise (see [http://egd.sourceforge.net/]). For EGD, the following paths are tried to locate the Unix socket used to communicate with EGD: - the value of the environment variable [EGD_SOCKET]; - [$HOME/.gnupg/entropy]; - [/var/run/egd-pool]; [/dev/egd-pool]; [/etc/egd-pool]. The method [secure_rng#random_bytes] fails if no suitable RNG is available. [secure_rng#random_bytes] may block until enough entropy has been gathered. Do not use for generating large quantities of random data, otherwise you could exhaust the entropy sources of the system. *) val system_rng: unit -> rng (** [system_rng ()] returns a random number generator derived from the OS-provided RNG. It raises [Error No_entropy_source] if the OS does not provide a secure RNG. Currently, this function is supported under Win32, and always fails under Unix. *) val device_rng: string -> rng (** [device_rng devicename] returns a random number generator that reads from the special file [devicename], e.g. [/dev/random] or [/dev/urandom]. *) val egd_rng: string -> rng (** [device_rng egd_socket] returns a random number generator that uses the Entropy Gathering Daemon ([http://egd.sourceforge.net/]). [egd_socket] is the path to the Unix socket that EGD uses for communication. *) val pseudo_rng: string -> rng (** [pseudo_rng seed] returns a pseudo-random number generator seeded by the string [seed]. [seed] must contain at least 16 characters, and can be arbitrarily longer than this, except that only the first 55 characters are used. Technically, the first 16 characters of [seed] are used as a key for the AES cipher in CBC mode, which encrypts the output of a lagged Fibonacci generator [X(i) = (X(i-24) + X(i-55)) mod 256] seeded with the first 55 characters of [seed]. While this generator is believed to have good statistical properties, it still does not generate ``true'' randomness: the entropy of the strings it creates cannot exceed the entropy contained in the seed. As a typical use, [Random.pseudo_rng (Random.string Random.secure_rng 20)] returns a generator that can generate arbitrarily long strings of pseudo-random data without delays, and with a total entropy of approximately 160 bits. *) end (** The [Padding] module defines a generic interface for padding input data to an integral number of blocks, as well as two popular padding schemes. *) module Padding : sig class type scheme = object method pad: string -> int -> unit (** [pad str used] is called with a buffer string [str] containing valid input data at positions [0, ..., used-1]. The [pad] method must write padding characters in positions [used] to [String.length str - 1]. It is guaranteed that [used < String.length str], so that at least one character of padding must be added. The padding scheme must be unambiguous in the following sense: from [buf] after padding, it must be possible to determine [used] unambiguously. (This is what method {!Cryptokit.Padding.scheme.strip} does.) *) method strip: string -> int (** This is the converse of the [pad] operation: from a padded string [buf] as built by method [pad], [strip buf] determines and returns the starting position of the padding data, or equivalently the length of valid, non-padded input data in [buf]. This method must raise [Error Bad_padding] if [buf] does not have the format of a padded block as produced by [pad]. *) end (** Generic interface of a padding scheme. *) val length: scheme (** This padding scheme pads data with [n] copies of the character having code [n]. The integer [n] lies between 1 and the block size (included). This constraint ensures non-ambiguity. This scheme is defined in RFC 2040 and in PKCS 5 and 7. *) val _8000: scheme (** This padding scheme pads data with one [0x80] byte, followed by as many [0] bytes as needed to fill the block. *) end (** {6 Cryptographic primitives (simplified interface)} *) (** The [Cipher] module implements the AES, DES, Triple-DES, ARCfour and Blowfish symmetric ciphers. Symmetric ciphers are presented as transforms parameterized by a secret key and a ``direction'' indicating whether encryption or decryption is to be performed. The same secret key is used for encryption and for decryption. *) module Cipher : sig type direction = Encrypt | Decrypt (** Indicate whether the cipher should perform encryption (transforming plaintext to ciphertext) or decryption (transforming ciphertext to plaintext). *) type chaining_mode = ECB | CBC | CFB of int | OFB of int (** Block ciphers such as AES or DES map a fixed-sized block of input data to a block of output data of the same size. A chaining mode indicates how to extend them to multiple blocks of data. The four chaining modes supported in this library are: - [ECB]: Electronic Code Book mode. - [CBC]: Cipher Block Chaining mode. - [CFB n]: Cipher Feedback Block with [n] bytes. - [OFB n]: Output Feedback Block with [n] bytes. A detailed description of these modes is beyond the scope of this documentation; refer to a good cryptography book. [CBC] is a recommended default. For [CFB n] and [OFB n], note that the blocksize is reduced to [n], but encryption speed drops by a factor of [blocksize / n], where [blocksize] is the block size of the underlying cipher; moreover, [n] must be between [1] and [blocksize] included. *) val aes: ?mode:chaining_mode -> ?pad:Padding.scheme -> ?iv:string -> string -> direction -> transform (** AES is the Advanced Encryption Standard, also known as Rijndael. This is a modern block cipher, recently standardized. It processes data by blocks of 128 bits (16 bytes), and supports keys of 128, 192 or 256 bits. The string argument is the key; it must have length 16, 24 or 32. The direction argument specifies whether encryption or decryption is to be performed. The optional [mode] argument specifies a chaining mode, as described above; [CBC] is used by default. The optional [pad] argument specifies a padding scheme to pad cleartext to an integral number of blocks. If no [pad] argument is given, no padding is performed and the length of the cleartext must be an integral number of blocks. The optional [iv] argument is the initialization vector used in modes CBC, CFB and OFB. It is ignored in ECB mode. If provided, it must be a string of the same size as the block size (16 bytes). If omitted, the null initialization vector (16 zero bytes) is used. The [aes] function returns a transform that performs encryption or decryption, depending on the direction argument. *) val des: ?mode:chaining_mode -> ?pad:Padding.scheme -> ?iv:string -> string -> direction -> transform (** DES is the Data Encryption Standard. Probably still the most widely used cipher today, although it can be broken relatively easily by brute force, due to its small key size (56 bits). It should therefore be considered as weak encryption. Its block size is 64 bits (8 bytes). The arguments to the [des] function have the same meaning as for the {!Cryptokit.Cipher.aes} function. The key argument is a string of length 8 (64 bits); the least significant bit of each key byte is ignored. *) val triple_des: ?mode:chaining_mode -> ?pad:Padding.scheme -> ?iv:string -> string -> direction -> transform (** Triple DES with two or three DES keys. This is a popular variant of DES where each block is encrypted with a 56-bit key [k1], decrypted with another 56-bit key [k2], then re-encrypted with either [k1] or a third 56-bit key [k3]. This results in a 112-bit or 168-bit key length that resists brute-force attacks. However, the three encryptions required on each block make this cipher quite slow (4 times slower than AES). The arguments to the [triple_des] function have the same meaning as for the {!Cryptokit.Cipher.aes} function. The key argument is a string of length 16 or 24, representing the concatenation of the key parts [k1], [k2], and optionally [k3]. The least significant bit of each key byte is ignored. *) val arcfour: string -> direction -> transform (** ARCfour (``alleged RC4'') is a fast stream cipher that appears to produce equivalent results with the commercial RC4 cipher from RSA Data Security Inc. This company holds the RC4 trademark, and sells the real RC4 cipher. So, it is prudent not to use ARCfour in a commercial product. ARCfour is popular for its speed: approximately 2 times faster than AES. It accepts any key length up to 2048 bits. The ARCfour cipher is a stream cipher, not a block cipher. Hence, its natural block size is 1, and no padding is required. Chaining modes do not apply. A feature of stream ciphers is that the xor of two ciphertexts obtained with the same key is the xor of the corresponding plaintexts, which allows various attacks. Hence, the same key must never be reused. The string argument is the key; its length must be between 1 and 256 inclusive. The direction argument is present for consistency with the other ciphers only, and is actually ignored: for all stream ciphers, decryption is the same function as encryption. *) val blowfish: ?mode:chaining_mode -> ?pad:Padding.scheme -> ?iv:string -> string -> direction -> transform (** Blowfish is a fast block cipher proposed by B.Schneier in 1994. It processes data by blocks of 64 bits (8 bytes), and supports keys of 32 to 448 bits. The string argument is the key; its length must be between 4 and 56. The direction argument specifies whether encryption or decryption is to be performed. The optional [mode] argument specifies a chaining mode, as described above; [CBC] is used by default. The optional [pad] argument specifies a padding scheme to pad cleartext to an integral number of blocks. If no [pad] argument is given, no padding is performed and the length of the cleartext must be an integral number of blocks. The optional [iv] argument is the initialization vector used in modes CBC, CFB and OFB. It is ignored in ECB mode. If provided, it must be a string of the same size as the block size (16 bytes). If omitted, the null initialization vector (16 zero bytes) is used. The [blowfish] function returns a transform that performs encryption or decryption, depending on the direction argument. *) end (** The [Hash] module implements unkeyed cryptographic hashes (SHA-1, SHA-256, RIPEMD-160 and MD5), also known as message digest functions. Hash functions used in cryptography are characterized as being one-way (given a hash value, it is computationally infeasible to find a text that hashes to this value) and collision-resistant (it is computationally infeasible to find two different texts that hash to the same value). Thus, the hash of a text can be used as a compact replacement for this text for the purposes of ensuring integrity of the text. *) module Hash : sig val sha1: unit -> hash (** SHA-1 is the Secure Hash Algorithm revision 1. It is a NIST standard, is widely used, and produces 160-bit hashes (20 bytes). Recent results suggest that it may not be collision-resistant. *) val sha256: unit -> hash (** SHA-256, another NIST standard, is a variant of SHA-1 that produces 256-bit hashes (32 bytes). *) val sha3: int -> hash (** SHA-3, the latest NIST standard for cryptographic hashing, produces hashes of 224, 256, 384 or 512 bits (24, 32, 48 or 64 bytes). The parameter is the desired size of the hash, in bits. It must be one of 224, 256, 384 or 512. *) val ripemd160: unit -> hash (** RIPEMD-160 produces 160-bit hashes (20 bytes). *) val md5: unit -> hash (** MD5 is an older hash function, producing 128-bit hashes (16 bytes). While popular in many legacy applications, it is now considered as unsecure. In particular, it is not collision-resistant. *) end (** The [MAC] module implements message authentication codes, also known as keyed hash functions. These are hash functions parameterized by a secret key. In addition to being one-way and collision-resistant, a MAC has the property that without knowing the secret key, it is computationally infeasible to find the hash for a known text, even if many pairs of (text, MAC) are known to the attacker. Thus, MAC can be used to authenticate the sender of a text: the receiver of a (text, MAC) pair can recompute the MAC from the text, and if it matches the transmitted MAC, be reasonably certain that the text was authentified by someone who possesses the secret key. The module [MAC] provides four MAC functions based on the hashes SHA-1, SHA256, RIPEMD160 and MD5, and four MAC functions based on the block ciphers AES, DES, and Triple-DES. *) module MAC: sig val hmac_sha1: string -> hash (** [hmac_sha1 key] returns a MAC based on the HMAC construction (RFC2104) applied to SHA-1. The returned hash values are 160 bits (20 bytes) long. The [key] argument is the MAC key; it can have any length, but a minimal length of 20 bytes is recommended. *) val hmac_sha256: string -> hash (** [hmac_sha256 key] returns a MAC based on the HMAC construction (RFC2104) applied to SHA-256. The returned hash values are 256 bits (32 bytes) long. The [key] argument is the MAC key; it can have any length, but a minimal length of 32 bytes is recommended. *) val hmac_ripemd160: string -> hash (** [hmac_ripemd160 key] returns a MAC based on the HMAC construction (RFC2104) applied to RIPEMD-160. The returned hash values are 160 bits (20 bytes) long. The [key] argument is the MAC key; it can have any length, but a minimal length of 20 bytes is recommended. *) val hmac_md5: string -> hash (** [hmac_md5 key] returns a MAC based on the HMAC construction (RFC2104) applied to MD5. The returned hash values are 128 bits (16 bytes) long. The [key] argument is the MAC key; it can have any length, but a minimal length of 16 bytes is recommended. *) val aes: ?iv:string -> ?pad:Padding.scheme -> string -> hash (** [aes key] returns a MAC based on AES encryption in CBC mode. The ciphertext is discarded, and the final value of the initialization vector is the MAC value. Thus, the returned hash values are 128 bit (16 bytes) long. The [key] argument is the MAC key; it must have length 16, 24, or 32. The optional [iv] argument is the first value of the initialization vector, and defaults to 0. The optional [pad] argument specifies a padding scheme to pad input to an integral number of 16-byte blocks. *) val des: ?iv:string -> ?pad:Padding.scheme -> string -> hash (** [des key] returns a MAC based on DES encryption in CBC mode. The construction is identical to that used for the [aes] MAC. The key size is 64 bits (8 bytes), of which only 56 are used. The returned hash value has length 8 bytes. Due to the small hash size and key size, this MAC is rather weak. *) val triple_des: ?iv:string -> ?pad:Padding.scheme -> string -> hash (** [des key] returns a MAC based on triple DES encryption in CBC mode. The construction is identical to that used for the [aes] MAC. The key size is 16 or 24 bytes. The returned hash value has length 8 bytes. The key size is sufficient to protect against brute-force attacks, but the small hash size means that this MAC is not collision-resistant. *) val des_final_triple_des: ?iv:string -> ?pad:Padding.scheme -> string -> hash (** [des_final_triple_des key] returns a MAC that uses DES CBC with the first 8 bytes of [key] as key. The final initialization vector is then DES-decrypted with bytes 8 to 15 of [key], and DES-encrypted again with either the last 8 bytes of [key] (if a triple-length key is provided) or the first 8 bytes of [key] (if a double-length key is provided). Thus, the key is 16 or 24 bytes long, of which 112 or 168 bits are used. The overall construction has the same key size as a triple DES MAC, but runs faster because triple encryption is not performed on all data blocks, but only on the final MAC. *) end (** The [RSA] module implements RSA public-key cryptography. Public-key cryptography is asymmetric: two distinct keys are used for encrypting a message, then decrypting it. Moreover, while one of the keys must remain secret, the other can be made public, since it is computationally very hard to reconstruct the private key from the public key. This feature supports both public-key encryption (anyone can encode with the public key, but only the owner of the private key can decrypt) and digital signature (only the owner of the private key can sign, but anyone can check the signature with the public key). *) module RSA: sig type key = { size: int; (** Size of the modulus [n], in bits *) n: string; (** Modulus [n = p.q] *) e: string; (** Public exponent [e] *) d: string; (** Private exponent [d] *) p: string; (** Prime factor [p] of [n] *) q: string; (** The other prime factor [q] of [n] *) dp: string; (** [dp] is [d mod (p-1)] *) dq: string; (** [dq] is [d mod (q-1)] *) qinv: string (** [qinv] is a multiplicative inverse of [q] modulo [p] *) } (** The type of RSA keys. Components [size], [n] and [e] define the public part of the key. Components [size], [n] and [d] define the private part of the key. To speed up private key operations through the use of the Chinese remainder theorem (CRT), additional components [p], [q], [dp], [dq] and [qinv] are provided. These are part of the private key. *) val wipe_key: key -> unit (** Erase all components of a RSA key. *) val new_key: ?rng: Random.rng -> ?e: int -> int -> key (** Generate a new, random RSA key. The non-optional [int] argument is the desired size for the modulus, in bits (e.g. 1024). The optional [rng] argument specifies a random number generator to use for generating the key; it defaults to {!Cryptokit.Random.secure_rng}. The optional [e] argument specifies the public exponent desired. If not specified, [e] is chosen randomly. Small values of [e] such as [e = 3] or [e = 65537] significantly speeds up encryption and signature checking compared with a random [e]. The result of [new_key] is a complete RSA key with all components defined: public, private, and private for use with the CRT. *) val encrypt: key -> string -> string (** [encrypt k msg] encrypts the string [msg] with the public part of key [k] (components [n] and [e]). [msg] must be smaller than [key.n] when both strings are viewed as natural numbers in big-endian notation. In practice, [msg] should be of length [key.size / 8 - 1], using padding if necessary. If you need to encrypt longer plaintexts using RSA, encrypt them with a symmetric cipher, using a randomly-generated key, and encrypt only that key with RSA. *) val decrypt: key -> string -> string (** [decrypt k msg] decrypts the ciphertext string [msg] with the private part of key [k] (components [n] and [d]). The size of [msg] is limited as described for {!Cryptokit.RSA.encrypt}. *) val decrypt_CRT: key -> string -> string (** [decrypt_CRT k msg] decrypts the ciphertext string [msg] with the CRT private part of key [k] (components [n], [p], [q], [dp], [dq] and [qinv]). The use of the Chinese remainder theorem (CRT) allows significantly faster decryption than {!Cryptokit.RSA.decrypt}, at no loss in security. The size of [msg] is limited as described for {!Cryptokit.RSA.encrypt}. *) val sign: key -> string -> string (** [sign k msg] encrypts the plaintext string [msg] with the private part of key [k] (components [n] and [d]), thus performing a digital signature on [msg]. The size of [msg] is limited as described for {!Cryptokit.RSA.encrypt}. If you need to sign longer messages, compute a cryptographic hash of the message and sign only the hash with RSA. *) val sign_CRT: key -> string -> string (** [sign_CRT k msg] encrypts the plaintext string [msg] with the CRT private part of key [k] (components [n], [p], [q], [dp], [dq] and [qinv]), thus performing a digital signature on [msg]. The use of the Chinese remainder theorem (CRT) allows significantly faster signature than {!Cryptokit.RSA.sign}, at no loss in security. The size of [msg] is limited as described for {!Cryptokit.RSA.encrypt}. *) val unwrap_signature: key -> string -> string (** [unwrap_signature k msg] decrypts the ciphertext string [msg] with the public part of key [k] (components [n] and [d]), thus extracting the plaintext that was signed by the sender. The size of [msg] is limited as described for {!Cryptokit.RSA.encrypt}. *) end (** The [DH] module implements Diffie-Hellman key agreement. Key agreement is a protocol by which two parties can establish a shared secret (typically a key for a symmetric cipher or MAC) by exchanging messages, with the guarantee that even if an attacker eavesdrop on the messages, he cannot recover the shared secret. Diffie-Hellman is one such key agreement protocol, relying on the difficulty of computing discrete logarithms. Notice that the Diffie-Hellman protocol is vulnerable to active attacks (man-in-the-middle attacks). The protocol executes as follows: - Both parties must agree beforehand on a set of public parameters (type {!Cryptokit.DH.parameters}). Suitable parameters can be generated by calling {!Cryptokit.DH.new_parameters}, or fixed parameters taken from the literature can be used. - Each party computes a random private secret using the function {!Cryptokit.DH.private_secret}. - From its private secrets and the public parameters, each party computes a message (a string) with the function {!Cryptokit.DH.message}, and sends it to the other party. - Each party recovers the shared secret by applying the function {!Cryptokit.DH.shared_secret} to its private secret and to the message received from the other party. - Fixed-size keys can then be derived from the shared secret using the function {!Cryptokit.DH.derive_key}. *) module DH: sig type parameters = { p: string; (** Large prime number *) g: string; (** Generator of [Z/pZ] *) privlen: int (** Length of private secrets in bits *) } (** The type of Diffie-Hellman parameters. These parameters need to be agreed upon by the two parties before the key agreement protocol is run. The parameters are public and can be reused for several runs of the protocol. *) val new_parameters: ?rng: Random.rng -> ?privlen: int -> int -> parameters (** Generate a new set of Diffie-Hellman parameters. The non-optional argument is the size in bits of the [p] parameter. It must be large enough that the discrete logarithm problem modulo [p] is computationally unsolvable. 1024 is a reasonable value. The optional [rng] argument specifies a random number generator to use for generating the parameters; it defaults to {!Cryptokit.Random.secure_rng}. The optional [privlen] argument is the size in bits of the private secrets that are generated during the key agreement protocol; the default is 160. *) type private_secret (** The abstract type of private secrets generated during key agreement. *) val private_secret: ?rng: Random.rng -> parameters -> private_secret (** Generate a random private secret. The optional [rng] argument specifies a random number generator to use; it defaults to {!Cryptokit.Random.secure_rng}. *) val message: parameters -> private_secret -> string (** Compute the message to be sent to the other party. *) val shared_secret: parameters -> private_secret -> string -> string (** Recover the shared secret from the private secret of the present party and the message received from the other party. The shared secret returned is a string of the same length as the [p] parameter. The private secret is destroyed and can no longer be used afterwards. *) val derive_key: ?diversification: string -> string -> int -> string (** [derive_key shared_secret numbytes] derives a secret string (typically, a key for symmetric encryption) from the given shared secret. [numbytes] is the desired length for the returned string. The optional [diversification] argument is an arbitrary string that defaults to the empty string. Different secret strings can be obtained from the same shared secret by supplying different [diversification] argument. The computation of the secret string is performed by SHA-1 hashing of the diversification string, followed by the shared secret, followed by an integer counter. The hashing is repeated with increasing values of the counter until [numbytes] bytes have been obtained. *) end (** {6 Advanced, compositional interface to block ciphers and stream ciphers} *) (** The [Block] module provides classes that implements popular block ciphers, chaining modes, and wrapping of a block cipher as a general transform or as a hash function. The classes can be composed in a Lego-like fashion, facilitating the integration of new block ciphers, modes, etc. *) module Block : sig class type block_cipher = object method blocksize: int (** The size in bytes of the blocks manipulated by the cipher. *) method transform: string -> int -> string -> int -> unit (** [transform src spos dst dpos] encrypts or decrypts one block of data. The input data is read from string [src] at positions [spos, ..., spos + blocksize - 1], and the output data is stored in string [dst] at positions [dpos, ..., dpos + blocksize - 1]. *) method wipe: unit (** Erase the internal state of the block cipher, such as all key-dependent material. *) end (** Abstract interface for a block cipher. *) (** {6 Deriving transforms and hashes from block ciphers} *) class cipher: block_cipher -> transform (** Wraps a block cipher as a general transform. The transform has input block size and output block size equal to the block size of the block cipher. No padding is performed. Example: [new cipher (new cbc_encrypt (new aes_encrypt key))] returns a transform that performs AES encryption in CBC mode. *) class cipher_padded_encrypt: Padding.scheme -> block_cipher -> transform (** Like {!Cryptokit.Block.cipher}, but performs padding on the input data as specified by the first argument. The input block size of the returned transform is 1; the output block size is the block size of the block cipher. *) class cipher_padded_decrypt: Padding.scheme -> block_cipher -> transform (** Like {!Cryptokit.Block.cipher}, but removes padding on the output data as specified by the first argument. The output block size of the returned transform is 1; the input block size is the block size of the block cipher. *) class mac: ?iv: string -> ?pad: Padding.scheme -> block_cipher -> hash (** Build a MAC (keyed hash function) from the given block cipher. The block cipher is run in CBC mode, and the MAC value is the final value of the initialization vector. Thus, the hash size of the resulting hash is the block size of the block cipher. The optional argument [iv] specifies the first initialization vector, with a default of all zeroes. The optional argument [pad] specifies a padding scheme to be applied to the input data; if not provided, no padding is performed. *) class mac_final_triple: ?iv: string -> ?pad: Padding.scheme -> block_cipher -> block_cipher -> block_cipher -> hash (** Build a MAC (keyed hash function) from the given block ciphers [c1], [c2] and [c3]. The input is run through [c1] in CBC mode, as described for {!Cryptokit.Block.mac}. The final initialization vector is then super-enciphered by [c2], then by [c3], to provide the final MAC. This construction results in a MAC that is as nearly as fast as {!Cryptokit.Block.mac} [c1], but more resistant against brute-force key search because of the additional final encryption through [c2] and [c3]. *) (** {6 Some block ciphers: AES, DES, triple DES, Blowfish} *) class aes_encrypt: string -> block_cipher (** The AES block cipher, in encryption mode. The string argument is the key; its length must be 16, 24 or 32 bytes. *) class aes_decrypt: string -> block_cipher (** The AES block cipher, in decryption mode. *) class des_encrypt: string -> block_cipher (** The DES block cipher, in encryption mode. The string argument is the key; its length must be 8 bytes. *) class des_decrypt: string -> block_cipher (** The DES block cipher, in decryption mode. *) class triple_des_encrypt: string -> block_cipher (** The Triple-DES block cipher, in encryption mode. The key argument must have length 16 (two keys) or 24 (three keys). *) class triple_des_decrypt: string -> block_cipher (** The Triple-DES block cipher, in decryption mode. *) class blowfish_encrypt: string -> block_cipher (** The Blowfish block cipher, in encryption mode. The string argument is the key; its length must be between 4 and 56. *) class blowfish_decrypt: string -> block_cipher (** The Blowfish block cipher, in decryption mode. *) (** {6 Chaining modes} *) class cbc_encrypt: ?iv: string -> block_cipher -> block_cipher (** Add Cipher Block Chaining (CBC) to the given block cipher in encryption mode. Each block of input is xor-ed with the previous output block before being encrypted through the given block cipher. The optional [iv] argument specifies the string to be xor-ed with the first input block, and defaults to all zeroes. The returned block cipher has the same block size as the underlying block cipher. *) class cbc_decrypt: ?iv: string -> block_cipher -> block_cipher (** Add Cipher Block Chaining (CBC) to the given block cipher in decryption mode. This works like {!Cryptokit.Block.cbc_encrypt}, except that input blocks are first decrypted by the block cipher before being xor-ed with the previous input block. *) class cfb_encrypt: ?iv: string -> int -> block_cipher -> block_cipher (** Add Cipher Feedback Block (CFB) to the given block cipher in encryption mode. The integer argument [n] is the number of bytes processed at a time; it must lie between [1] and the block size of the underlying cipher, included. The returned block cipher has block size [n]. *) class cfb_decrypt: ?iv: string -> int -> block_cipher -> block_cipher (** Add Cipher Feedback Block (CFB) to the given block cipher in decryption mode. See {!Cryptokit.Block.cfb_encrypt}. *) class ofb: ?iv: string -> int -> block_cipher -> block_cipher (** Add Output Feedback Block (OFB) to the given block cipher. The integer argument [n] is the number of bytes processed at a time; it must lie between [1] and the block size of the underlying cipher, included. The returned block cipher has block size [n]. It is usable both for encryption and decryption. *) end (** The [Stream] module provides classes that implement the ARCfour stream cipher, and the wrapping of a stream cipher as a general transform. The classes can be composed in a Lego-like fashion, facilitating the integration of new stream ciphers. *) module Stream : sig class type stream_cipher = object method transform: string -> int -> string -> int -> int -> unit (** [transform src spos dst dpos len] encrypts or decrypts [len] characters, read from string [src] starting at position [spos]. The resulting [len] characters are stored in string [dst] starting at position [dpos]. *) method wipe: unit (** Erase the internal state of the stream cipher, such as all key-dependent material. *) end (** Abstract interface for a stream cipher. *) class cipher: stream_cipher -> transform (** Wraps an arbitrary stream cipher as a transform. The transform has input and output block size of 1. *) class arcfour: string -> stream_cipher (** The ARCfour (``alleged RC4'') stream cipher. The argument is the key, and must be of length 1 to 256. This stream cipher works by xor-ing the input with the output of a key-dependent pseudo random number generator. Thus, decryption is the same function as encryption. *) end (** {6 Encoding and compression of data} *) (** The [Base64] module supports the encoding and decoding of binary data in base 64 format, using only alphanumeric characters that can safely be transmitted over e-mail or in URLs. *) module Base64: sig val encode_multiline : unit -> transform (** Return a transform that performs base 64 encoding. The output is divided in lines of length 76 characters, and final [=] characters are used to pad the output, as specified in the MIME standard. The output is approximately [4/3] longer than the input. *) val encode_compact : unit -> transform (** Same as {!Cryptokit.Base64.encode_multiline}, but the output is not split into lines, and no final padding is added. This is adequate for encoding short strings for transmission as part of URLs, for instance. *) val encode_compact_pad : unit -> transform (** Same as {!Cryptokit.Base64.encode_compact}, but the output is padded with [=] characters at the end (if necessary). *) val decode : unit -> transform (** Return a transform that performs base 64 decoding. The input must consist of valid base 64 characters; blanks are ignored. Raise [Error Bad_encoding] if invalid base 64 characters are encountered in the input. *) end (** The [Hexa] module supports the encoding and decoding of binary data as hexadecimal strings. This is a popular format for transmitting keys in textual form. *) module Hexa: sig val encode : unit -> transform (** Return a transform that encodes its input in hexadecimal. The output is twice as long as the input, and contains no spaces or newlines. *) val decode : unit -> transform (** Return a transform that decodes its input from hexadecimal. The output is twice as short as the input. Blanks (spaces, tabs, newlines) in the input are ignored. Raise [Error Bad_encoding] if the input contains characters other than hexadecimal digits and blanks. *) end (** The [Zlib] module supports the compression and decompression of data, using the [zlib] library. The algorithm used is Lempel-Ziv compression as in the [gzip] and [zip] compressors. While compression itself is not encryption, it is often used prior to encryption to hide regularities in the plaintext, and reduce the size of the ciphertext. *) module Zlib: sig val compress : ?level:int -> unit -> transform (** Return a transform that compresses its input. The optional [level] argument is an integer between 1 and 9 specifying how hard the transform should try to compress data: 1 is lowest but fastest compression, while 9 is highest but slowest compression. The default level is 6. *) val uncompress : unit -> transform (** Return a transform that decompresses its input. *) end (** {6 Error reporting} *) (** Error codes for this library. *) type error = | Wrong_key_size (** The key is too long or too short for the given cipher. *) | Wrong_IV_size (** The initialization vector does not have the same size as the block size. *) | Wrong_data_length (** The total length of the input data for a transform is not an integral multiple of the input block size. *) | Bad_padding (** Incorrect padding bytes were found after decryption. *) | Output_buffer_overflow (** The output buffer for a transform exceeds the maximal length of a Caml string. *) | Incompatible_block_size (** A combination of two block ciphers was attempted whereby the ciphers have different block sizes, while they must have the same. *) | Number_too_long (** Denotes an internal error in RSA key generation or encryption. *) | Seed_too_short (** The seed given to a pseudo random number generator is too short. *) | Message_too_long (** The message passed to RSA encryption or decryption is greater than the modulus of the RSA key *) | Bad_encoding (** Illegal characters were found in an encoding of binary data such as base 64 or hexadecimal. *) | Compression_error of string * string (** Error during compression or decompression. *) | No_entropy_source (** No entropy source (OS, [/dev/random] or EGD) was found for {!Cryptokit.Random.secure_rng}. *) | Entropy_source_closed (** End of file on a device or EGD entropy source. *) | Compression_not_supported (** The data compression functions are not available. *) exception Error of error (** Exception raised by functions in this library to report error conditions. *) (** {6 Miscellaneous utilities} *) val wipe_string : string -> unit (** [wipe_string s] overwrites [s] with zeroes. Can be used to reduce the memory lifetime of sensitive data. *) val xor_string: string -> int -> string -> int -> int -> unit (** [xor_string src spos dst dpos len] performs the xor (exclusive or) of characters [spos, ..., spos + len - 1] of [src] with characters [dpos, ..., dpos + len - 1] of [dst], storing the result in [dst] starting at position [dpos]. *) val mod_power: string -> string -> string -> string (** [mod_power a b c] computes [a^b mod c], where the strings [a], [b], [c] and the result string are viewed as arbitrary-precision integers in big-endian format. Requires [a < c]. *) val mod_mult: string -> string -> string -> string (** [mod_mult a b c] computes [a*b mod c], where the strings [a], [b], [c] and the result string are viewed as arbitrary-precision integers in big-endian format. *) cryptokit-1.9/src/.depend0000644000175000017500000000130011436706614014766 0ustar gildorgildorarcfour.o: arcfour.c arcfour.h blowfish.o: blowfish.c blowfish.h d3des.o: d3des.c d3des.h rijndael-alg-fst.o: rijndael-alg-fst.c rijndael-alg-fst.h ripemd160.o: ripemd160.c ripemd160.h sha1.o: sha1.c sha1.h sha256.o: sha256.c sha256.h stubs-aes.o: stubs-aes.c rijndael-alg-fst.h stubs-arcfour.o: stubs-arcfour.c arcfour.h stubs-blowfish.o: stubs-blowfish.c blowfish.h stubs-des.o: stubs-des.c d3des.h stubs-md5.o: stubs-md5.c stubs-misc.o: stubs-misc.c stubs-ripemd160.o: stubs-ripemd160.c ripemd160.h stubs-rng.o: stubs-rng.c stubs-sha1.o: stubs-sha1.c sha1.h stubs-sha256.o: stubs-sha256.c sha256.h stubs-zlib.o: stubs-zlib.c cryptokit.cmi: cryptokit.cmo: cryptokit.cmi cryptokit.cmx: cryptokit.cmi cryptokit-1.9/src/stubs-zlib.c0000644000175000017500000001575011436706614016006 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-zlib.c 53 2010-08-30 10:53:00Z gildor-admin $ */ /* Stub code to interface with Zlib */ #ifdef HAVE_ZLIB #include #endif #include #include #include #include #include static value * caml_zlib_error_exn = NULL; #ifdef HAVE_ZLIB #define ZStream_val(v) ((z_stream *) (v)) static void caml_zlib_error(char * fn, value vzs) { char * msg; value s1 = Val_unit, s2 = Val_unit, tuple = Val_unit, bucket = Val_unit; msg = ZStream_val(vzs)->msg; if (msg == NULL) msg = ""; if (caml_zlib_error_exn == NULL) { caml_zlib_error_exn = caml_named_value("Cryptokit.Error"); if (caml_zlib_error_exn == NULL) invalid_argument("Exception Cryptokit.Error not initialized"); } Begin_roots4(s1, s2, tuple, bucket); s1 = copy_string(fn); s2 = copy_string(msg); tuple = alloc_small(2, 0); Field(tuple, 0) = s1; Field(tuple, 1) = s2; bucket = alloc_small(2, 0); Field(bucket, 0) = *caml_zlib_error_exn; Field(bucket, 1) = tuple; End_roots(); mlraise(bucket); } static value caml_zlib_new_stream(void) { value res = alloc((sizeof(z_stream) + sizeof(value) - 1) / sizeof(value), Abstract_tag); ZStream_val(res)->zalloc = NULL; ZStream_val(res)->zfree = NULL; ZStream_val(res)->opaque = NULL; ZStream_val(res)->next_in = NULL; ZStream_val(res)->next_out = NULL; return res; } CAMLprim value caml_zlib_deflateInit(value vlevel, value expect_header) { value vzs = caml_zlib_new_stream(); if (deflateInit2(ZStream_val(vzs), Int_val(vlevel), Z_DEFLATED, Bool_val(expect_header) ? MAX_WBITS : -MAX_WBITS, 8, Z_DEFAULT_STRATEGY) != Z_OK) caml_zlib_error("Zlib.deflateInit", vzs); return vzs; } static int caml_zlib_flush_table[] = { Z_NO_FLUSH, Z_SYNC_FLUSH, Z_FULL_FLUSH, Z_FINISH }; CAMLprim value caml_zlib_deflate(value vzs, value srcbuf, value srcpos, value srclen, value dstbuf, value dstpos, value dstlen, value vflush) { z_stream * zs = ZStream_val(vzs); int retcode; long used_in, used_out; value res; zs->next_in = &Byte(srcbuf, Long_val(srcpos)); zs->avail_in = Long_val(srclen); zs->next_out = &Byte(dstbuf, Long_val(dstpos)); zs->avail_out = Long_val(dstlen); retcode = deflate(zs, caml_zlib_flush_table[Int_val(vflush)]); if (retcode < 0) caml_zlib_error("Zlib.deflate", vzs); used_in = Long_val(srclen) - zs->avail_in; used_out = Long_val(dstlen) - zs->avail_out; zs->next_in = NULL; /* not required, but cleaner */ zs->next_out = NULL; /* (avoid dangling pointers into Caml heap) */ res = alloc_small(3, 0); Field(res, 0) = Val_bool(retcode == Z_STREAM_END); Field(res, 1) = Val_int(used_in); Field(res, 2) = Val_int(used_out); return res; } CAMLprim value caml_zlib_deflateEnd(value vzs) { if (deflateEnd(ZStream_val(vzs)) != Z_OK) caml_zlib_error("Zlib.deflateEnd", vzs); return Val_unit; } CAMLprim value caml_zlib_inflateInit(value expect_header) { value vzs = caml_zlib_new_stream(); if (inflateInit2(ZStream_val(vzs), Bool_val(expect_header) ? MAX_WBITS : -MAX_WBITS) != Z_OK) caml_zlib_error("Zlib.inflateInit", vzs); return vzs; } CAMLprim value caml_zlib_inflate(value vzs, value srcbuf, value srcpos, value srclen, value dstbuf, value dstpos, value dstlen, value vflush) { z_stream * zs = ZStream_val(vzs); int retcode; long used_in, used_out; value res; zs->next_in = &Byte(srcbuf, Long_val(srcpos)); zs->avail_in = Long_val(srclen); zs->next_out = &Byte(dstbuf, Long_val(dstpos)); zs->avail_out = Long_val(dstlen); retcode = inflate(zs, caml_zlib_flush_table[Int_val(vflush)]); if (retcode < 0 || retcode == Z_NEED_DICT) caml_zlib_error("Zlib.inflate", vzs); used_in = Long_val(srclen) - zs->avail_in; used_out = Long_val(dstlen) - zs->avail_out; zs->next_in = NULL; /* not required, but cleaner */ zs->next_out = NULL; /* (avoid dangling pointers into Caml heap) */ res = alloc_small(3, 0); Field(res, 0) = Val_bool(retcode == Z_STREAM_END); Field(res, 1) = Val_int(used_in); Field(res, 2) = Val_int(used_out); return res; } CAMLprim value caml_zlib_inflateEnd(value vzs) { if (inflateEnd(ZStream_val(vzs)) != Z_OK) caml_zlib_error("Zlib.inflateEnd", vzs); return Val_unit; } #else static void caml_zlib_not_supported(void) { value bucket; if (caml_zlib_error_exn == NULL) { caml_zlib_error_exn = caml_named_value("Cryptokit.Error"); if (caml_zlib_error_exn == NULL) invalid_argument("Exception Cryptokit.Error not initialized"); } bucket = alloc_small(2, 0); Field(bucket, 0) = *caml_zlib_error_exn; Field(bucket, 1) = Val_int(12); /* Compression_not_supported */ mlraise(bucket); } CAMLprim value caml_zlib_deflateInit(value vlevel, value expect_header) { caml_zlib_not_supported(); return Val_unit; } CAMLprim value caml_zlib_deflate(value vzs, value srcbuf, value srcpos, value srclen, value dstbuf, value dstpos, value dstlen, value vflush) { caml_zlib_not_supported(); return Val_unit; } CAMLprim value caml_zlib_deflateEnd(value vzs) { caml_zlib_not_supported(); return Val_unit; } CAMLprim value caml_zlib_inflateInit(value expect_header) { caml_zlib_not_supported(); return Val_unit; } CAMLprim value caml_zlib_inflate(value vzs, value srcbuf, value srcpos, value srclen, value dstbuf, value dstpos, value dstlen, value vflush) { caml_zlib_not_supported(); return Val_unit; } CAMLprim value caml_zlib_inflateEnd(value vzs) { caml_zlib_not_supported(); return Val_unit; } #endif CAMLprim value caml_zlib_deflate_bytecode(value * arg, int nargs) { return caml_zlib_deflate(arg[0], arg[1], arg[2], arg[3], arg[4], arg[5], arg[6], arg[7]); } CAMLprim value caml_zlib_inflate_bytecode(value * arg, int nargs) { return caml_zlib_inflate(arg[0], arg[1], arg[2], arg[3], arg[4], arg[5], arg[6], arg[7]); } cryptokit-1.9/src/stubs-arcfour.c0000644000175000017500000000371011436706614016500 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-arcfour.c 53 2010-08-30 10:53:00Z gildor-admin $ */ /* Stub code for ARC4 */ #include "arcfour.h" #include #include #include #define Cooked_key_size (sizeof(struct arcfour_key)) #define Key_val(v) ((struct arcfour_key *) String_val(v)) CAMLprim value caml_arcfour_cook_key(value key) { CAMLparam1(key); value ckey = alloc_string(Cooked_key_size); arcfour_cook_key(Key_val(ckey), (unsigned char *) String_val(key), string_length(key)); CAMLreturn(ckey); } CAMLprim value caml_arcfour_transform(value ckey, value src, value src_ofs, value dst, value dst_ofs, value len) { arcfour_encrypt(Key_val(ckey), &Byte(src, Long_val(src_ofs)), &Byte(dst, Long_val(dst_ofs)), Long_val(len)); return Val_unit; } CAMLprim value caml_arcfour_transform_bytecode(value * argv, int argc) { return caml_arcfour_transform(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); } cryptokit-1.9/src/arcfour.c0000644000175000017500000000355711436706614015353 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: arcfour.c 53 2010-08-30 10:53:00Z gildor-admin $ */ #include "arcfour.h" void arcfour_cook_key(struct arcfour_key * key, unsigned char * key_data, int key_data_len) { unsigned char * s; int i; unsigned char t, index1, index2; s = &key->state[0]; for (i = 0; i < 256; i++) s[i] = i; key->x = 0; key->y = 0; index1 = 0; index2 = 0; for (i = 0; i < 256; i++) { index2 = key_data[index1] + s[i] + index2; t = s[i]; s[i] = s[index2]; s[index2] = t; index1++; if (index1 >= key_data_len) index1 = 0; } } void arcfour_encrypt(struct arcfour_key * key, char * src, char * dst, long len) { int x, y, kx, ky; x = key->x; y = key->y; for (/*nothing*/; len > 0; len--) { x = (x + 1) & 0xFF; kx = key->state[x]; y = (kx + y) & 0xFF; ky = key->state[y]; key->state[x] = ky; key->state[y] = kx; *dst++ = *src++ ^ key->state[(kx + ky) & 0xFF]; } key->x = x; key->y = y; } cryptokit-1.9/src/d3des.c0000644000175000017500000003307311436706614014710 0ustar gildorgildor/* D3DES (V5.09) - * * A portable, public domain, version of the Data Encryption Standard. * * Written with Symantec's THINK (Lightspeed) C by Richard Outerbridge. * Thanks to: Dan Hoey for his excellent Initial and Inverse permutation * code; Jim Gillogly & Phil Karn for the DES key schedule code; Dennis * Ferguson, Eric Young and Dana How for comparing notes; and Ray Lau, * for humouring me on. * * Copyright (c) 1988,1989,1990,1991,1992 by Richard Outerbridge. * (GEnie : OUTER; CIS : [71755,204]) Graven Imagery, 1992. * * Modified and adapted by Xavier Leroy, 2002. */ #include "d3des.h" static void scrunch(u8 *, u32 *); static void unscrun(u32 *, u8 *); static void desfunc(u32 *, u32 *); static void cookey(u32 *, u32 *); static unsigned short bytebit[8] = { 0200, 0100, 040, 020, 010, 04, 02, 01 }; static u32 bigbyte[24] = { 0x800000L, 0x400000L, 0x200000L, 0x100000L, 0x80000L, 0x40000L, 0x20000L, 0x10000L, 0x8000L, 0x4000L, 0x2000L, 0x1000L, 0x800L, 0x400L, 0x200L, 0x100L, 0x80L, 0x40L, 0x20L, 0x10L, 0x8L, 0x4L, 0x2L, 0x1L }; /* Use the key schedule specified in the Standard (ANSI X3.92-1981). */ static u8 pc1[56] = { 56, 48, 40, 32, 24, 16, 8, 0, 57, 49, 41, 33, 25, 17, 9, 1, 58, 50, 42, 34, 26, 18, 10, 2, 59, 51, 43, 35, 62, 54, 46, 38, 30, 22, 14, 6, 61, 53, 45, 37, 29, 21, 13, 5, 60, 52, 44, 36, 28, 20, 12, 4, 27, 19, 11, 3 }; static u8 totrot[16] = { 1,2,4,6,8,10,12,14,15,17,19,21,23,25,27,28 }; static u8 pc2[48] = { 13, 16, 10, 23, 0, 4, 2, 27, 14, 5, 20, 9, 22, 18, 11, 3, 25, 7, 15, 6, 26, 19, 12, 1, 40, 51, 30, 36, 46, 54, 29, 39, 50, 44, 32, 47, 43, 48, 38, 55, 33, 52, 45, 41, 49, 35, 28, 31 }; void d3des_cook_key(u8 key[8], int edf, u32 res[32]) /* Thanks to James Gillogly & Phil Karn! */ { register int i, j, l, m, n; u8 pc1m[56], pcr[56]; u32 kn[32]; for ( j = 0; j < 56; j++ ) { l = pc1[j]; m = l & 07; pc1m[j] = (key[l >> 3] & bytebit[m]) ? 1 : 0; } for( i = 0; i < 16; i++ ) { if( edf == DE1 ) m = (15 - i) << 1; else m = i << 1; n = m + 1; kn[m] = kn[n] = 0L; for( j = 0; j < 28; j++ ) { l = j + totrot[i]; if( l < 28 ) pcr[j] = pc1m[l]; else pcr[j] = pc1m[l - 28]; } for( j = 28; j < 56; j++ ) { l = j + totrot[i]; if( l < 56 ) pcr[j] = pc1m[l]; else pcr[j] = pc1m[l - 28]; } for( j = 0; j < 24; j++ ) { if( pcr[pc2[j]] ) kn[m] |= bigbyte[j]; if( pcr[pc2[j+24]] ) kn[n] |= bigbyte[j]; } } cookey(kn, res); return; } static void cookey(u32 * raw1, u32 * cook) { register u32 *raw0; register int i; for( i = 0; i < 16; i++, raw1++ ) { raw0 = raw1++; *cook = (*raw0 & 0x00fc0000L) << 6; *cook |= (*raw0 & 0x00000fc0L) << 10; *cook |= (*raw1 & 0x00fc0000L) >> 10; *cook++ |= (*raw1 & 0x00000fc0L) >> 6; *cook = (*raw0 & 0x0003f000L) << 12; *cook |= (*raw0 & 0x0000003fL) << 16; *cook |= (*raw1 & 0x0003f000L) >> 4; *cook++ |= (*raw1 & 0x0000003fL); } return; } void d3des_transform(u32 key[32], u8 inblock[8], u8 outblock[8]) { u32 work[2]; scrunch(inblock, work); desfunc(work, key); unscrun(work, outblock); } static void scrunch(u8 * outof, u32 * into) { into[0] = (outof[0] << 24) | (outof[1] << 16) | (outof[2] << 8) | outof[3]; into[1] = (outof[4] << 24) | (outof[5] << 16) | (outof[6] << 8) | outof[7]; } static void unscrun(u32 * outof, u8 * into) { u32 n; n = outof[0]; into[0] = (n >> 24); into[1] = (n >> 16); into[2] = (n >> 8); into[3] = n; n = outof[1]; into[4] = (n >> 24); into[5] = (n >> 16); into[6] = (n >> 8); into[7] = n; } static u32 SP1[64] = { 0x01010400L, 0x00000000L, 0x00010000L, 0x01010404L, 0x01010004L, 0x00010404L, 0x00000004L, 0x00010000L, 0x00000400L, 0x01010400L, 0x01010404L, 0x00000400L, 0x01000404L, 0x01010004L, 0x01000000L, 0x00000004L, 0x00000404L, 0x01000400L, 0x01000400L, 0x00010400L, 0x00010400L, 0x01010000L, 0x01010000L, 0x01000404L, 0x00010004L, 0x01000004L, 0x01000004L, 0x00010004L, 0x00000000L, 0x00000404L, 0x00010404L, 0x01000000L, 0x00010000L, 0x01010404L, 0x00000004L, 0x01010000L, 0x01010400L, 0x01000000L, 0x01000000L, 0x00000400L, 0x01010004L, 0x00010000L, 0x00010400L, 0x01000004L, 0x00000400L, 0x00000004L, 0x01000404L, 0x00010404L, 0x01010404L, 0x00010004L, 0x01010000L, 0x01000404L, 0x01000004L, 0x00000404L, 0x00010404L, 0x01010400L, 0x00000404L, 0x01000400L, 0x01000400L, 0x00000000L, 0x00010004L, 0x00010400L, 0x00000000L, 0x01010004L }; static u32 SP2[64] = { 0x80108020L, 0x80008000L, 0x00008000L, 0x00108020L, 0x00100000L, 0x00000020L, 0x80100020L, 0x80008020L, 0x80000020L, 0x80108020L, 0x80108000L, 0x80000000L, 0x80008000L, 0x00100000L, 0x00000020L, 0x80100020L, 0x00108000L, 0x00100020L, 0x80008020L, 0x00000000L, 0x80000000L, 0x00008000L, 0x00108020L, 0x80100000L, 0x00100020L, 0x80000020L, 0x00000000L, 0x00108000L, 0x00008020L, 0x80108000L, 0x80100000L, 0x00008020L, 0x00000000L, 0x00108020L, 0x80100020L, 0x00100000L, 0x80008020L, 0x80100000L, 0x80108000L, 0x00008000L, 0x80100000L, 0x80008000L, 0x00000020L, 0x80108020L, 0x00108020L, 0x00000020L, 0x00008000L, 0x80000000L, 0x00008020L, 0x80108000L, 0x00100000L, 0x80000020L, 0x00100020L, 0x80008020L, 0x80000020L, 0x00100020L, 0x00108000L, 0x00000000L, 0x80008000L, 0x00008020L, 0x80000000L, 0x80100020L, 0x80108020L, 0x00108000L }; static u32 SP3[64] = { 0x00000208L, 0x08020200L, 0x00000000L, 0x08020008L, 0x08000200L, 0x00000000L, 0x00020208L, 0x08000200L, 0x00020008L, 0x08000008L, 0x08000008L, 0x00020000L, 0x08020208L, 0x00020008L, 0x08020000L, 0x00000208L, 0x08000000L, 0x00000008L, 0x08020200L, 0x00000200L, 0x00020200L, 0x08020000L, 0x08020008L, 0x00020208L, 0x08000208L, 0x00020200L, 0x00020000L, 0x08000208L, 0x00000008L, 0x08020208L, 0x00000200L, 0x08000000L, 0x08020200L, 0x08000000L, 0x00020008L, 0x00000208L, 0x00020000L, 0x08020200L, 0x08000200L, 0x00000000L, 0x00000200L, 0x00020008L, 0x08020208L, 0x08000200L, 0x08000008L, 0x00000200L, 0x00000000L, 0x08020008L, 0x08000208L, 0x00020000L, 0x08000000L, 0x08020208L, 0x00000008L, 0x00020208L, 0x00020200L, 0x08000008L, 0x08020000L, 0x08000208L, 0x00000208L, 0x08020000L, 0x00020208L, 0x00000008L, 0x08020008L, 0x00020200L }; static u32 SP4[64] = { 0x00802001L, 0x00002081L, 0x00002081L, 0x00000080L, 0x00802080L, 0x00800081L, 0x00800001L, 0x00002001L, 0x00000000L, 0x00802000L, 0x00802000L, 0x00802081L, 0x00000081L, 0x00000000L, 0x00800080L, 0x00800001L, 0x00000001L, 0x00002000L, 0x00800000L, 0x00802001L, 0x00000080L, 0x00800000L, 0x00002001L, 0x00002080L, 0x00800081L, 0x00000001L, 0x00002080L, 0x00800080L, 0x00002000L, 0x00802080L, 0x00802081L, 0x00000081L, 0x00800080L, 0x00800001L, 0x00802000L, 0x00802081L, 0x00000081L, 0x00000000L, 0x00000000L, 0x00802000L, 0x00002080L, 0x00800080L, 0x00800081L, 0x00000001L, 0x00802001L, 0x00002081L, 0x00002081L, 0x00000080L, 0x00802081L, 0x00000081L, 0x00000001L, 0x00002000L, 0x00800001L, 0x00002001L, 0x00802080L, 0x00800081L, 0x00002001L, 0x00002080L, 0x00800000L, 0x00802001L, 0x00000080L, 0x00800000L, 0x00002000L, 0x00802080L }; static u32 SP5[64] = { 0x00000100L, 0x02080100L, 0x02080000L, 0x42000100L, 0x00080000L, 0x00000100L, 0x40000000L, 0x02080000L, 0x40080100L, 0x00080000L, 0x02000100L, 0x40080100L, 0x42000100L, 0x42080000L, 0x00080100L, 0x40000000L, 0x02000000L, 0x40080000L, 0x40080000L, 0x00000000L, 0x40000100L, 0x42080100L, 0x42080100L, 0x02000100L, 0x42080000L, 0x40000100L, 0x00000000L, 0x42000000L, 0x02080100L, 0x02000000L, 0x42000000L, 0x00080100L, 0x00080000L, 0x42000100L, 0x00000100L, 0x02000000L, 0x40000000L, 0x02080000L, 0x42000100L, 0x40080100L, 0x02000100L, 0x40000000L, 0x42080000L, 0x02080100L, 0x40080100L, 0x00000100L, 0x02000000L, 0x42080000L, 0x42080100L, 0x00080100L, 0x42000000L, 0x42080100L, 0x02080000L, 0x00000000L, 0x40080000L, 0x42000000L, 0x00080100L, 0x02000100L, 0x40000100L, 0x00080000L, 0x00000000L, 0x40080000L, 0x02080100L, 0x40000100L }; static u32 SP6[64] = { 0x20000010L, 0x20400000L, 0x00004000L, 0x20404010L, 0x20400000L, 0x00000010L, 0x20404010L, 0x00400000L, 0x20004000L, 0x00404010L, 0x00400000L, 0x20000010L, 0x00400010L, 0x20004000L, 0x20000000L, 0x00004010L, 0x00000000L, 0x00400010L, 0x20004010L, 0x00004000L, 0x00404000L, 0x20004010L, 0x00000010L, 0x20400010L, 0x20400010L, 0x00000000L, 0x00404010L, 0x20404000L, 0x00004010L, 0x00404000L, 0x20404000L, 0x20000000L, 0x20004000L, 0x00000010L, 0x20400010L, 0x00404000L, 0x20404010L, 0x00400000L, 0x00004010L, 0x20000010L, 0x00400000L, 0x20004000L, 0x20000000L, 0x00004010L, 0x20000010L, 0x20404010L, 0x00404000L, 0x20400000L, 0x00404010L, 0x20404000L, 0x00000000L, 0x20400010L, 0x00000010L, 0x00004000L, 0x20400000L, 0x00404010L, 0x00004000L, 0x00400010L, 0x20004010L, 0x00000000L, 0x20404000L, 0x20000000L, 0x00400010L, 0x20004010L }; static u32 SP7[64] = { 0x00200000L, 0x04200002L, 0x04000802L, 0x00000000L, 0x00000800L, 0x04000802L, 0x00200802L, 0x04200800L, 0x04200802L, 0x00200000L, 0x00000000L, 0x04000002L, 0x00000002L, 0x04000000L, 0x04200002L, 0x00000802L, 0x04000800L, 0x00200802L, 0x00200002L, 0x04000800L, 0x04000002L, 0x04200000L, 0x04200800L, 0x00200002L, 0x04200000L, 0x00000800L, 0x00000802L, 0x04200802L, 0x00200800L, 0x00000002L, 0x04000000L, 0x00200800L, 0x04000000L, 0x00200800L, 0x00200000L, 0x04000802L, 0x04000802L, 0x04200002L, 0x04200002L, 0x00000002L, 0x00200002L, 0x04000000L, 0x04000800L, 0x00200000L, 0x04200800L, 0x00000802L, 0x00200802L, 0x04200800L, 0x00000802L, 0x04000002L, 0x04200802L, 0x04200000L, 0x00200800L, 0x00000000L, 0x00000002L, 0x04200802L, 0x00000000L, 0x00200802L, 0x04200000L, 0x00000800L, 0x04000002L, 0x04000800L, 0x00000800L, 0x00200002L }; static u32 SP8[64] = { 0x10001040L, 0x00001000L, 0x00040000L, 0x10041040L, 0x10000000L, 0x10001040L, 0x00000040L, 0x10000000L, 0x00040040L, 0x10040000L, 0x10041040L, 0x00041000L, 0x10041000L, 0x00041040L, 0x00001000L, 0x00000040L, 0x10040000L, 0x10000040L, 0x10001000L, 0x00001040L, 0x00041000L, 0x00040040L, 0x10040040L, 0x10041000L, 0x00001040L, 0x00000000L, 0x00000000L, 0x10040040L, 0x10000040L, 0x10001000L, 0x00041040L, 0x00040000L, 0x00041040L, 0x00040000L, 0x10041000L, 0x00001000L, 0x00000040L, 0x10040040L, 0x00001000L, 0x00041040L, 0x10001000L, 0x00000040L, 0x10000040L, 0x10040000L, 0x10040040L, 0x10000000L, 0x00040000L, 0x10001040L, 0x00000000L, 0x10041040L, 0x00040040L, 0x10000040L, 0x10040000L, 0x10001000L, 0x10001040L, 0x00000000L, 0x10041040L, 0x00041000L, 0x00041000L, 0x00001040L, 0x00001040L, 0x00040040L, 0x10000000L, 0x10041000L }; static void desfunc(u32 * block, u32 * keys) { register u32 fval, work, right, leftt; register int round; leftt = block[0]; right = block[1]; work = ((leftt >> 4) ^ right) & 0x0f0f0f0fL; right ^= work; leftt ^= (work << 4); work = ((leftt >> 16) ^ right) & 0x0000ffffL; right ^= work; leftt ^= (work << 16); work = ((right >> 2) ^ leftt) & 0x33333333L; leftt ^= work; right ^= (work << 2); work = ((right >> 8) ^ leftt) & 0x00ff00ffL; leftt ^= work; right ^= (work << 8); right = ((right << 1) | ((right >> 31) & 1L)); work = (leftt ^ right) & 0xaaaaaaaaL; leftt ^= work; right ^= work; leftt = ((leftt << 1) | ((leftt >> 31) & 1L)); for( round = 0; round < 8; round++ ) { work = (right << 28) | (right >> 4); work ^= *keys++; fval = SP7[ work & 0x3fL]; fval |= SP5[(work >> 8) & 0x3fL]; fval |= SP3[(work >> 16) & 0x3fL]; fval |= SP1[(work >> 24) & 0x3fL]; work = right ^ *keys++; fval |= SP8[ work & 0x3fL]; fval |= SP6[(work >> 8) & 0x3fL]; fval |= SP4[(work >> 16) & 0x3fL]; fval |= SP2[(work >> 24) & 0x3fL]; leftt ^= fval; work = (leftt << 28) | (leftt >> 4); work ^= *keys++; fval = SP7[ work & 0x3fL]; fval |= SP5[(work >> 8) & 0x3fL]; fval |= SP3[(work >> 16) & 0x3fL]; fval |= SP1[(work >> 24) & 0x3fL]; work = leftt ^ *keys++; fval |= SP8[ work & 0x3fL]; fval |= SP6[(work >> 8) & 0x3fL]; fval |= SP4[(work >> 16) & 0x3fL]; fval |= SP2[(work >> 24) & 0x3fL]; right ^= fval; } right = (right << 31) | (right >> 1); work = (leftt ^ right) & 0xaaaaaaaaL; leftt ^= work; right ^= work; leftt = (leftt << 31) | (leftt >> 1); work = ((leftt >> 8) ^ right) & 0x00ff00ffL; right ^= work; leftt ^= (work << 8); work = ((leftt >> 2) ^ right) & 0x33333333L; right ^= work; leftt ^= (work << 2); work = ((right >> 16) ^ leftt) & 0x0000ffffL; leftt ^= work; right ^= (work << 16); work = ((right >> 4) ^ leftt) & 0x0f0f0f0fL; leftt ^= work; right ^= (work << 4); *block++ = right; *block = leftt; } /* Validation sets: * * Single-length key, single-length plaintext - * Key : 0123 4567 89ab cdef * Plain : 0123 4567 89ab cde7 * Cipher : c957 4425 6a5e d31d * * Double-length key, single-length plaintext - * Key : 0123 4567 89ab cdef fedc ba98 7654 3210 * Plain : 0123 4567 89ab cde7 * Cipher : 7f1d 0a77 826b 8aff * * Double-length key, double-length plaintext - * Key : 0123 4567 89ab cdef fedc ba98 7654 3210 * Plain : 0123 4567 89ab cdef 0123 4567 89ab cdff * Cipher : 27a0 8440 406a df60 278f 47cf 42d6 15d7 * * Triple-length key, single-length plaintext - * Key : 0123 4567 89ab cdef fedc ba98 7654 3210 89ab cdef 0123 4567 * Plain : 0123 4567 89ab cde7 * Cipher : de0b 7c06 ae5e 0ed5 * * Triple-length key, double-length plaintext - * Key : 0123 4567 89ab cdef fedc ba98 7654 3210 89ab cdef 0123 4567 * Plain : 0123 4567 89ab cdef 0123 4567 89ab cdff * Cipher : ad0d 1b30 ac17 cf07 0ed1 1c63 81e4 4de5 * * d3des V5.0a rwo 9208.07 18:44 Graven Imagery **********************************************************************/ cryptokit-1.9/src/stubs-ripemd160.c0000644000175000017500000000320511436706614016545 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2005 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-ripemd160.c 53 2010-08-30 10:53:00Z gildor-admin $ */ #include "ripemd160.h" #include #include #include #define Context_val(v) ((struct RIPEMD160Context *) String_val(v)) CAMLprim value caml_ripemd160_init(value unit) { value ctx = alloc_string(sizeof(struct RIPEMD160Context)); RIPEMD160_init(Context_val(ctx)); return ctx; } CAMLprim value caml_ripemd160_update(value ctx, value src, value ofs, value len) { RIPEMD160_add_data(Context_val(ctx), &Byte_u(src, Long_val(ofs)), Long_val(len)); return Val_unit; } CAMLprim value caml_ripemd160_final(value ctx) { CAMLparam1(ctx); CAMLlocal1(res); res = alloc_string(20); RIPEMD160_finish(Context_val(ctx), &Byte_u(res, 0)); CAMLreturn(res); } cryptokit-1.9/src/stubs-aes.c0000644000175000017500000000511711436706614015612 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-aes.c 53 2010-08-30 10:53:00Z gildor-admin $ */ /* Stub code for AES */ #include "rijndael-alg-fst.h" #include #include #include #define Cooked_key_NR_offset ((4 * (MAXNR + 1)) * sizeof(u32)) #define Cooked_key_size (Cooked_key_NR_offset + 1) CAMLprim value caml_aes_cook_encrypt_key(value key) { CAMLparam1(key); value ckey = alloc_string(Cooked_key_size); int nr = rijndaelKeySetupEnc((u32 *) String_val(ckey), (const u8 *) String_val(key), 8 * string_length(key)); Byte(ckey, Cooked_key_NR_offset) = nr; CAMLreturn(ckey); } CAMLprim value caml_aes_cook_decrypt_key(value key) { CAMLparam1(key); value ckey = alloc_string(Cooked_key_size); int nr = rijndaelKeySetupDec((u32 *) String_val(ckey), (const u8 *) String_val(key), 8 * string_length(key)); Byte(ckey, Cooked_key_NR_offset) = nr; CAMLreturn(ckey); } CAMLprim value caml_aes_encrypt(value ckey, value src, value src_ofs, value dst, value dst_ofs) { rijndaelEncrypt((const u32 *) String_val(ckey), Byte(ckey, Cooked_key_NR_offset), (const u8 *) &Byte(src, Long_val(src_ofs)), (u8 *) &Byte(dst, Long_val(dst_ofs))); return Val_unit; } CAMLprim value caml_aes_decrypt(value ckey, value src, value src_ofs, value dst, value dst_ofs) { rijndaelDecrypt((const u32 *) String_val(ckey), Byte(ckey, Cooked_key_NR_offset), (const u8 *) &Byte(src, Long_val(src_ofs)), (u8 *) &Byte(dst, Long_val(dst_ofs))); return Val_unit; } cryptokit-1.9/src/arcfour.h0000644000175000017500000000244311436706614015351 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: arcfour.h 53 2010-08-30 10:53:00Z gildor-admin $ */ struct arcfour_key { unsigned char state[256]; unsigned char x, y; }; extern void arcfour_cook_key(struct arcfour_key * key, unsigned char * key_data, int key_data_len); extern void arcfour_encrypt(struct arcfour_key * key, char * src, char * dst, long len); cryptokit-1.9/src/ripemd160.c0000644000175000017500000003012611436706614015411 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2005 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: ripemd160.c 53 2010-08-30 10:53:00Z gildor-admin $ */ /* RIPEMD160 hashing */ #include #include #include "ripemd160.h" /* Refs: - The reference implementation written by Antoon Bosselaers, available at http://www.esat.kuleuven.ac.be/~cosicart/ps/AB-9601/ - Handbook of Applied Cryptography, section 9.4.2, algorithm 9.55 */ /* Rotation n bits to the left */ #define ROL(x,n) (((x) << (n)) | ((x) >> (32-(n)))) /* The five basic functions */ #define F(x,y,z) ((x) ^ (y) ^ (z)) #define G(x,y,z) (((x) & (y)) | (~(x) & (z))) #define H(x,y,z) (((x) | ~(y)) ^ (z)) #define I(x,y,z) (((x) & (z)) | ((y) & ~(z))) #define J(x,y,z) ((x) ^ ((y) | ~(z))) /* The ten "steps" for the rounds */ #define FF(a, b, c, d, e, x, s) {\ (a) += F((b), (c), (d)) + (x);\ (a) = ROL((a), (s)) + (e);\ (c) = ROL((c), 10);\ } #define GG(a, b, c, d, e, x, s) {\ (a) += G((b), (c), (d)) + (x) + 0x5a827999U;\ (a) = ROL((a), (s)) + (e);\ (c) = ROL((c), 10);\ } #define HH(a, b, c, d, e, x, s) {\ (a) += H((b), (c), (d)) + (x) + 0x6ed9eba1U;\ (a) = ROL((a), (s)) + (e);\ (c) = ROL((c), 10);\ } #define II(a, b, c, d, e, x, s) {\ (a) += I((b), (c), (d)) + (x) + 0x8f1bbcdcU;\ (a) = ROL((a), (s)) + (e);\ (c) = ROL((c), 10);\ } #define JJ(a, b, c, d, e, x, s) {\ (a) += J((b), (c), (d)) + (x) + 0xa953fd4eU;\ (a) = ROL((a), (s)) + (e);\ (c) = ROL((c), 10);\ } #define FFF(a, b, c, d, e, x, s) {\ (a) += F((b), (c), (d)) + (x);\ (a) = ROL((a), (s)) + (e);\ (c) = ROL((c), 10);\ } #define GGG(a, b, c, d, e, x, s) {\ (a) += G((b), (c), (d)) + (x) + 0x7a6d76e9U;\ (a) = ROL((a), (s)) + (e);\ (c) = ROL((c), 10);\ } #define HHH(a, b, c, d, e, x, s) {\ (a) += H((b), (c), (d)) + (x) + 0x6d703ef3U;\ (a) = ROL((a), (s)) + (e);\ (c) = ROL((c), 10);\ } #define III(a, b, c, d, e, x, s) {\ (a) += I((b), (c), (d)) + (x) + 0x5c4dd124U;\ (a) = ROL((a), (s)) + (e);\ (c) = ROL((c), 10);\ } #define JJJ(a, b, c, d, e, x, s) {\ (a) += J((b), (c), (d)) + (x) + 0x50a28be6U;\ (a) = ROL((a), (s)) + (e);\ (c) = ROL((c), 10);\ } static void RIPEMD160_copy_and_swap(void * src, void * dst, int numwords) { #ifdef ARCH_BIG_ENDIAN unsigned char * s, * d; unsigned char a, b; for (s = src, d = dst; numwords > 0; s += 4, d += 4, numwords--) { a = s[0]; b = s[1]; d[0] = s[3]; d[1] = s[2]; d[2] = b; d[3] = a; } #else memcpy(dst, src, numwords * sizeof(u32)); #endif } static void RIPEMD160_compress(struct RIPEMD160Context * ctx) { register u32 a, b, c, d, e; u32 aa, bb, cc, dd, ee; u32 data[16]; /* Convert buffer data to 16 little-endian integers */ RIPEMD160_copy_and_swap(ctx->buffer, data, 16); /* Perform "left" rounds */ a = ctx->state[0]; b = ctx->state[1]; c = ctx->state[2]; d = ctx->state[3]; e = ctx->state[4]; /* left round 1 */ FF(a, b, c, d, e, data[ 0], 11); FF(e, a, b, c, d, data[ 1], 14); FF(d, e, a, b, c, data[ 2], 15); FF(c, d, e, a, b, data[ 3], 12); FF(b, c, d, e, a, data[ 4], 5); FF(a, b, c, d, e, data[ 5], 8); FF(e, a, b, c, d, data[ 6], 7); FF(d, e, a, b, c, data[ 7], 9); FF(c, d, e, a, b, data[ 8], 11); FF(b, c, d, e, a, data[ 9], 13); FF(a, b, c, d, e, data[10], 14); FF(e, a, b, c, d, data[11], 15); FF(d, e, a, b, c, data[12], 6); FF(c, d, e, a, b, data[13], 7); FF(b, c, d, e, a, data[14], 9); FF(a, b, c, d, e, data[15], 8); /* left round 2 */ GG(e, a, b, c, d, data[ 7], 7); GG(d, e, a, b, c, data[ 4], 6); GG(c, d, e, a, b, data[13], 8); GG(b, c, d, e, a, data[ 1], 13); GG(a, b, c, d, e, data[10], 11); GG(e, a, b, c, d, data[ 6], 9); GG(d, e, a, b, c, data[15], 7); GG(c, d, e, a, b, data[ 3], 15); GG(b, c, d, e, a, data[12], 7); GG(a, b, c, d, e, data[ 0], 12); GG(e, a, b, c, d, data[ 9], 15); GG(d, e, a, b, c, data[ 5], 9); GG(c, d, e, a, b, data[ 2], 11); GG(b, c, d, e, a, data[14], 7); GG(a, b, c, d, e, data[11], 13); GG(e, a, b, c, d, data[ 8], 12); /* left round 3 */ HH(d, e, a, b, c, data[ 3], 11); HH(c, d, e, a, b, data[10], 13); HH(b, c, d, e, a, data[14], 6); HH(a, b, c, d, e, data[ 4], 7); HH(e, a, b, c, d, data[ 9], 14); HH(d, e, a, b, c, data[15], 9); HH(c, d, e, a, b, data[ 8], 13); HH(b, c, d, e, a, data[ 1], 15); HH(a, b, c, d, e, data[ 2], 14); HH(e, a, b, c, d, data[ 7], 8); HH(d, e, a, b, c, data[ 0], 13); HH(c, d, e, a, b, data[ 6], 6); HH(b, c, d, e, a, data[13], 5); HH(a, b, c, d, e, data[11], 12); HH(e, a, b, c, d, data[ 5], 7); HH(d, e, a, b, c, data[12], 5); /* left round 4 */ II(c, d, e, a, b, data[ 1], 11); II(b, c, d, e, a, data[ 9], 12); II(a, b, c, d, e, data[11], 14); II(e, a, b, c, d, data[10], 15); II(d, e, a, b, c, data[ 0], 14); II(c, d, e, a, b, data[ 8], 15); II(b, c, d, e, a, data[12], 9); II(a, b, c, d, e, data[ 4], 8); II(e, a, b, c, d, data[13], 9); II(d, e, a, b, c, data[ 3], 14); II(c, d, e, a, b, data[ 7], 5); II(b, c, d, e, a, data[15], 6); II(a, b, c, d, e, data[14], 8); II(e, a, b, c, d, data[ 5], 6); II(d, e, a, b, c, data[ 6], 5); II(c, d, e, a, b, data[ 2], 12); /* left round 5 */ JJ(b, c, d, e, a, data[ 4], 9); JJ(a, b, c, d, e, data[ 0], 15); JJ(e, a, b, c, d, data[ 5], 5); JJ(d, e, a, b, c, data[ 9], 11); JJ(c, d, e, a, b, data[ 7], 6); JJ(b, c, d, e, a, data[12], 8); JJ(a, b, c, d, e, data[ 2], 13); JJ(e, a, b, c, d, data[10], 12); JJ(d, e, a, b, c, data[14], 5); JJ(c, d, e, a, b, data[ 1], 12); JJ(b, c, d, e, a, data[ 3], 13); JJ(a, b, c, d, e, data[ 8], 14); JJ(e, a, b, c, d, data[11], 11); JJ(d, e, a, b, c, data[ 6], 8); JJ(c, d, e, a, b, data[15], 5); JJ(b, c, d, e, a, data[13], 6); /* Save result of left rounds */ aa = a; bb = b; cc = c; dd = d; ee = e; /* Perform "right" rounds */ a = ctx->state[0]; b = ctx->state[1]; c = ctx->state[2]; d = ctx->state[3]; e = ctx->state[4]; /* right round 1 */ JJJ(a, b, c, d, e, data[ 5], 8); JJJ(e, a, b, c, d, data[14], 9); JJJ(d, e, a, b, c, data[ 7], 9); JJJ(c, d, e, a, b, data[ 0], 11); JJJ(b, c, d, e, a, data[ 9], 13); JJJ(a, b, c, d, e, data[ 2], 15); JJJ(e, a, b, c, d, data[11], 15); JJJ(d, e, a, b, c, data[ 4], 5); JJJ(c, d, e, a, b, data[13], 7); JJJ(b, c, d, e, a, data[ 6], 7); JJJ(a, b, c, d, e, data[15], 8); JJJ(e, a, b, c, d, data[ 8], 11); JJJ(d, e, a, b, c, data[ 1], 14); JJJ(c, d, e, a, b, data[10], 14); JJJ(b, c, d, e, a, data[ 3], 12); JJJ(a, b, c, d, e, data[12], 6); /* right round 2 */ III(e, a, b, c, d, data[ 6], 9); III(d, e, a, b, c, data[11], 13); III(c, d, e, a, b, data[ 3], 15); III(b, c, d, e, a, data[ 7], 7); III(a, b, c, d, e, data[ 0], 12); III(e, a, b, c, d, data[13], 8); III(d, e, a, b, c, data[ 5], 9); III(c, d, e, a, b, data[10], 11); III(b, c, d, e, a, data[14], 7); III(a, b, c, d, e, data[15], 7); III(e, a, b, c, d, data[ 8], 12); III(d, e, a, b, c, data[12], 7); III(c, d, e, a, b, data[ 4], 6); III(b, c, d, e, a, data[ 9], 15); III(a, b, c, d, e, data[ 1], 13); III(e, a, b, c, d, data[ 2], 11); /* right round 3 */ HHH(d, e, a, b, c, data[15], 9); HHH(c, d, e, a, b, data[ 5], 7); HHH(b, c, d, e, a, data[ 1], 15); HHH(a, b, c, d, e, data[ 3], 11); HHH(e, a, b, c, d, data[ 7], 8); HHH(d, e, a, b, c, data[14], 6); HHH(c, d, e, a, b, data[ 6], 6); HHH(b, c, d, e, a, data[ 9], 14); HHH(a, b, c, d, e, data[11], 12); HHH(e, a, b, c, d, data[ 8], 13); HHH(d, e, a, b, c, data[12], 5); HHH(c, d, e, a, b, data[ 2], 14); HHH(b, c, d, e, a, data[10], 13); HHH(a, b, c, d, e, data[ 0], 13); HHH(e, a, b, c, d, data[ 4], 7); HHH(d, e, a, b, c, data[13], 5); /* right round 4 */ GGG(c, d, e, a, b, data[ 8], 15); GGG(b, c, d, e, a, data[ 6], 5); GGG(a, b, c, d, e, data[ 4], 8); GGG(e, a, b, c, d, data[ 1], 11); GGG(d, e, a, b, c, data[ 3], 14); GGG(c, d, e, a, b, data[11], 14); GGG(b, c, d, e, a, data[15], 6); GGG(a, b, c, d, e, data[ 0], 14); GGG(e, a, b, c, d, data[ 5], 6); GGG(d, e, a, b, c, data[12], 9); GGG(c, d, e, a, b, data[ 2], 12); GGG(b, c, d, e, a, data[13], 9); GGG(a, b, c, d, e, data[ 9], 12); GGG(e, a, b, c, d, data[ 7], 5); GGG(d, e, a, b, c, data[10], 15); GGG(c, d, e, a, b, data[14], 8); /* right round 5 */ FFF(b, c, d, e, a, data[12] , 8); FFF(a, b, c, d, e, data[15] , 5); FFF(e, a, b, c, d, data[10] , 12); FFF(d, e, a, b, c, data[ 4] , 9); FFF(c, d, e, a, b, data[ 1] , 12); FFF(b, c, d, e, a, data[ 5] , 5); FFF(a, b, c, d, e, data[ 8] , 14); FFF(e, a, b, c, d, data[ 7] , 6); FFF(d, e, a, b, c, data[ 6] , 8); FFF(c, d, e, a, b, data[ 2] , 13); FFF(b, c, d, e, a, data[13] , 6); FFF(a, b, c, d, e, data[14] , 5); FFF(e, a, b, c, d, data[ 0] , 15); FFF(d, e, a, b, c, data[ 3] , 13); FFF(c, d, e, a, b, data[ 9] , 11); FFF(b, c, d, e, a, data[11] , 11); /* Update chaining values */ d += cc + ctx->state[1]; ctx->state[1] = ctx->state[2] + dd + e; ctx->state[2] = ctx->state[3] + ee + a; ctx->state[3] = ctx->state[4] + aa + b; ctx->state[4] = ctx->state[0] + bb + c; ctx->state[0] = d; } void RIPEMD160_init(struct RIPEMD160Context * ctx) { ctx->state[0] = 0x67452301U; ctx->state[1] = 0xEFCDAB89U; ctx->state[2] = 0x98BADCFEU; ctx->state[3] = 0x10325476U; ctx->state[4] = 0xC3D2E1F0U; ctx->numbytes = 0; ctx->length[0] = 0; ctx->length[1] = 0; } void RIPEMD160_add_data(struct RIPEMD160Context * ctx, unsigned char * data, unsigned long len) { u32 t; /* Update length */ t = ctx->length[0]; if ((ctx->length[0] = t + (u32) (len << 3)) < t) ctx->length[1]++; /* carry from low 32 bits to high 32 bits */ ctx->length[1] += (u32) (len >> 29); /* If data was left in buffer, pad it with fresh data and munge block */ if (ctx->numbytes != 0) { t = 64 - ctx->numbytes; if (len < t) { memcpy(ctx->buffer + ctx->numbytes, data, len); ctx->numbytes += len; return; } memcpy(ctx->buffer + ctx->numbytes, data, t); RIPEMD160_compress(ctx); data += t; len -= t; } /* Munge data in 64-byte chunks */ while (len >= 64) { memcpy(ctx->buffer, data, 64); RIPEMD160_compress(ctx); data += 64; len -= 64; } /* Save remaining data */ memcpy(ctx->buffer, data, len); ctx->numbytes = len; } void RIPEMD160_finish(struct RIPEMD160Context * ctx, unsigned char output[20]) { int i = ctx->numbytes; /* Set first char of padding to 0x80. There is always room. */ ctx->buffer[i++] = 0x80; /* If we do not have room for the length (8 bytes), pad to 64 bytes with zeroes and munge the data block */ if (i > 56) { memset(ctx->buffer + i, 0, 64 - i); RIPEMD160_compress(ctx); i = 0; } /* Pad to byte 56 with zeroes */ memset(ctx->buffer + i, 0, 56 - i); /* Add length in little-endian */ RIPEMD160_copy_and_swap(ctx->length, ctx->buffer + 56, 2); /* Munge the final block */ RIPEMD160_compress(ctx); /* Final hash value is in ctx->state modulo little-endian conversion */ RIPEMD160_copy_and_swap(ctx->state, output, 5); } cryptokit-1.9/src/d3des.h0000644000175000017500000000147511436706614014716 0ustar gildorgildor/* d3des.h - * * Headers and defines for d3des.c * Graven Imagery, 1992. * * Copyright (c) 1988,1989,1990,1991,1992 by Richard Outerbridge * (GEnie : OUTER; CIS : [71755,204]) * * Modified and adapted by Xavier Leroy, 2002. */ #define EN0 0 /* MODE == encrypt */ #define DE1 1 /* MODE == decrypt */ typedef unsigned char u8; typedef unsigned int u32; extern void d3des_cook_key(u8 key[8], int mode, u32 res[32]); /* Sets the key register [res] according to the hexadecimal * key contained in the 8 bytes of [key], according to the DES, * for encryption or decryption according to [mode]. */ extern void d3des_transform(u32 key[32], u8 from[8], u8 to[8]); /* Encrypts/Decrypts (according to the key [key]) * one block of eight bytes at address 'from' * into the block at address 'to'. They can be the same. */ cryptokit-1.9/src/stubs-des.c0000644000175000017500000000330611436706614015613 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-des.c 53 2010-08-30 10:53:00Z gildor-admin $ */ /* Stub code for DES */ #include "d3des.h" #include #include #include #define Cooked_key_size (32 * sizeof(u32)) CAMLprim value caml_des_cook_key(value key, value ofs, value direction) { CAMLparam2(key,direction); value ckey = alloc_string(Cooked_key_size); d3des_cook_key((u8 *) &Byte(key, Long_val(ofs)), Int_val(direction), (u32 *) String_val(ckey)); CAMLreturn(ckey); } CAMLprim value caml_des_transform(value ckey, value src, value src_ofs, value dst, value dst_ofs) { d3des_transform((u32 *) String_val(ckey), (u8 *) &Byte(src, Long_val(src_ofs)), (u8 *) &Byte(dst, Long_val(dst_ofs))); return Val_unit; } cryptokit-1.9/src/stubs-blowfish.c0000644000175000017500000000515111436706614016655 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ /* */ /* Copyright 2006 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-blowfish.c 53 2010-08-30 10:53:00Z gildor-admin $ */ /* Stub code for Blowfish */ #include "blowfish.h" #include #include #include CAMLprim value caml_blowfish_cook_key(value key) { CAMLparam1(key); value ckey = alloc_string(sizeof(BLOWFISH_CTX)); Blowfish_Init((BLOWFISH_CTX *) String_val(ckey), &Byte_u(key, 0), caml_string_length(key)); CAMLreturn(ckey); } #ifdef ARCH_BIG_ENDIAN #define COPY4BYTES(dst,src) \ (dst)[0] = (src)[0], \ (dst)[1] = (src)[1], \ (dst)[2] = (src)[2], \ (dst)[3] = (src)[3] #else #define COPY4BYTES(dst,src) \ (dst)[0] = (src)[3], \ (dst)[1] = (src)[2], \ (dst)[2] = (src)[1], \ (dst)[3] = (src)[0] #endif CAMLprim value caml_blowfish_encrypt(value ckey, value src, value src_ofs, value dst, value dst_ofs) { u32 xl, xr; unsigned char * p; p = &Byte_u(src, Long_val(src_ofs)); COPY4BYTES((unsigned char *) &xl, p); COPY4BYTES((unsigned char *) &xr, p + 4); Blowfish_Encrypt((BLOWFISH_CTX *) String_val(ckey), &xl, &xr); p = &Byte_u(dst, Long_val(dst_ofs)); COPY4BYTES(p, (unsigned char *) &xl); COPY4BYTES(p + 4, (unsigned char *) &xr); return Val_unit; } CAMLprim value caml_blowfish_decrypt(value ckey, value src, value src_ofs, value dst, value dst_ofs) { u32 xl, xr; unsigned char * p; p = &Byte_u(src, Long_val(src_ofs)); COPY4BYTES((unsigned char *) &xl, p); COPY4BYTES((unsigned char *) &xr, p + 4); Blowfish_Decrypt((BLOWFISH_CTX *) String_val(ckey), &xl, &xr); p = &Byte_u(dst, Long_val(dst_ofs)); COPY4BYTES(p, (unsigned char *) &xl); COPY4BYTES(p + 4, (unsigned char *) &xr); return Val_unit; } cryptokit-1.9/src/ripemd160.h0000644000175000017500000000265611436706614015425 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2005 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: ripemd160.h 53 2010-08-30 10:53:00Z gildor-admin $ */ /* RIPEMD160 hashing */ typedef unsigned int u32; struct RIPEMD160Context { u32 state[5]; u32 length[2]; int numbytes; unsigned char buffer[64]; }; extern void RIPEMD160_init(struct RIPEMD160Context * ctx); extern void RIPEMD160_add_data(struct RIPEMD160Context * ctx, unsigned char * data, unsigned long len); extern void RIPEMD160_finish(struct RIPEMD160Context * ctx, unsigned char output[20]); cryptokit-1.9/src/blowfish.c0000644000175000017500000005271411436706614015526 0ustar gildorgildor/* blowfish.c: C implementation of the Blowfish algorithm. Copyright (C) 1997 by Paul Kocher This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA COMMENTS ON USING THIS CODE: Normal usage is as follows: [1] Allocate a BLOWFISH_CTX. (It may be too big for the stack.) [2] Call Blowfish_Init with a pointer to your BLOWFISH_CTX, a pointer to the key, and the number of bytes in the key. [3] To encrypt a 64-bit block, call Blowfish_Encrypt with a pointer to BLOWFISH_CTX, a pointer to the 32-bit left half of the plaintext and a pointer to the 32-bit right half. The plaintext will be overwritten with the ciphertext. [4] Decryption is the same as encryption except that the plaintext and ciphertext are reversed. Warning #1: The code does not check key lengths. (Caveat encryptor.) Warning #2: Beware that Blowfish keys repeat such that "ab" = "abab". Warning #3: It is normally a good idea to zeroize the BLOWFISH_CTX before freeing it. Warning #4: Endianness conversions are the responsibility of the caller. (To encrypt bytes on a little-endian platforms, you'll probably want to swap bytes around instead of just casting.) Warning #5: Make sure to use a reasonable mode of operation for your application. (If you don't know what CBC mode is, see Warning #7.) Warning #6: This code is susceptible to timing attacks. Warning #7: Security engineering is risky and non-intuitive. Have someone check your work. If you don't know what you are doing, get help. This is code is fast enough for most applications, but is not optimized for speed. If you require this code under a license other than LGPL, please ask. (I can be located using your favorite search engine.) Unfortunately, I do not have time to provide unpaid support for everyone who uses this code. -- Paul Kocher Modifications by Xavier.Leroy@inria.fr, 2005. (Marked "XL".) - Speed improvements - Endianness handling. */ #include #include "blowfish.h" #define N 16 static const u32 ORIG_P[16 + 2] = { 0x243F6A88L, 0x85A308D3L, 0x13198A2EL, 0x03707344L, 0xA4093822L, 0x299F31D0L, 0x082EFA98L, 0xEC4E6C89L, 0x452821E6L, 0x38D01377L, 0xBE5466CFL, 0x34E90C6CL, 0xC0AC29B7L, 0xC97C50DDL, 0x3F84D5B5L, 0xB5470917L, 0x9216D5D9L, 0x8979FB1BL }; static const u32 ORIG_S[4][256] = { { 0xD1310BA6L, 0x98DFB5ACL, 0x2FFD72DBL, 0xD01ADFB7L, 0xB8E1AFEDL, 0x6A267E96L, 0xBA7C9045L, 0xF12C7F99L, 0x24A19947L, 0xB3916CF7L, 0x0801F2E2L, 0x858EFC16L, 0x636920D8L, 0x71574E69L, 0xA458FEA3L, 0xF4933D7EL, 0x0D95748FL, 0x728EB658L, 0x718BCD58L, 0x82154AEEL, 0x7B54A41DL, 0xC25A59B5L, 0x9C30D539L, 0x2AF26013L, 0xC5D1B023L, 0x286085F0L, 0xCA417918L, 0xB8DB38EFL, 0x8E79DCB0L, 0x603A180EL, 0x6C9E0E8BL, 0xB01E8A3EL, 0xD71577C1L, 0xBD314B27L, 0x78AF2FDAL, 0x55605C60L, 0xE65525F3L, 0xAA55AB94L, 0x57489862L, 0x63E81440L, 0x55CA396AL, 0x2AAB10B6L, 0xB4CC5C34L, 0x1141E8CEL, 0xA15486AFL, 0x7C72E993L, 0xB3EE1411L, 0x636FBC2AL, 0x2BA9C55DL, 0x741831F6L, 0xCE5C3E16L, 0x9B87931EL, 0xAFD6BA33L, 0x6C24CF5CL, 0x7A325381L, 0x28958677L, 0x3B8F4898L, 0x6B4BB9AFL, 0xC4BFE81BL, 0x66282193L, 0x61D809CCL, 0xFB21A991L, 0x487CAC60L, 0x5DEC8032L, 0xEF845D5DL, 0xE98575B1L, 0xDC262302L, 0xEB651B88L, 0x23893E81L, 0xD396ACC5L, 0x0F6D6FF3L, 0x83F44239L, 0x2E0B4482L, 0xA4842004L, 0x69C8F04AL, 0x9E1F9B5EL, 0x21C66842L, 0xF6E96C9AL, 0x670C9C61L, 0xABD388F0L, 0x6A51A0D2L, 0xD8542F68L, 0x960FA728L, 0xAB5133A3L, 0x6EEF0B6CL, 0x137A3BE4L, 0xBA3BF050L, 0x7EFB2A98L, 0xA1F1651DL, 0x39AF0176L, 0x66CA593EL, 0x82430E88L, 0x8CEE8619L, 0x456F9FB4L, 0x7D84A5C3L, 0x3B8B5EBEL, 0xE06F75D8L, 0x85C12073L, 0x401A449FL, 0x56C16AA6L, 0x4ED3AA62L, 0x363F7706L, 0x1BFEDF72L, 0x429B023DL, 0x37D0D724L, 0xD00A1248L, 0xDB0FEAD3L, 0x49F1C09BL, 0x075372C9L, 0x80991B7BL, 0x25D479D8L, 0xF6E8DEF7L, 0xE3FE501AL, 0xB6794C3BL, 0x976CE0BDL, 0x04C006BAL, 0xC1A94FB6L, 0x409F60C4L, 0x5E5C9EC2L, 0x196A2463L, 0x68FB6FAFL, 0x3E6C53B5L, 0x1339B2EBL, 0x3B52EC6FL, 0x6DFC511FL, 0x9B30952CL, 0xCC814544L, 0xAF5EBD09L, 0xBEE3D004L, 0xDE334AFDL, 0x660F2807L, 0x192E4BB3L, 0xC0CBA857L, 0x45C8740FL, 0xD20B5F39L, 0xB9D3FBDBL, 0x5579C0BDL, 0x1A60320AL, 0xD6A100C6L, 0x402C7279L, 0x679F25FEL, 0xFB1FA3CCL, 0x8EA5E9F8L, 0xDB3222F8L, 0x3C7516DFL, 0xFD616B15L, 0x2F501EC8L, 0xAD0552ABL, 0x323DB5FAL, 0xFD238760L, 0x53317B48L, 0x3E00DF82L, 0x9E5C57BBL, 0xCA6F8CA0L, 0x1A87562EL, 0xDF1769DBL, 0xD542A8F6L, 0x287EFFC3L, 0xAC6732C6L, 0x8C4F5573L, 0x695B27B0L, 0xBBCA58C8L, 0xE1FFA35DL, 0xB8F011A0L, 0x10FA3D98L, 0xFD2183B8L, 0x4AFCB56CL, 0x2DD1D35BL, 0x9A53E479L, 0xB6F84565L, 0xD28E49BCL, 0x4BFB9790L, 0xE1DDF2DAL, 0xA4CB7E33L, 0x62FB1341L, 0xCEE4C6E8L, 0xEF20CADAL, 0x36774C01L, 0xD07E9EFEL, 0x2BF11FB4L, 0x95DBDA4DL, 0xAE909198L, 0xEAAD8E71L, 0x6B93D5A0L, 0xD08ED1D0L, 0xAFC725E0L, 0x8E3C5B2FL, 0x8E7594B7L, 0x8FF6E2FBL, 0xF2122B64L, 0x8888B812L, 0x900DF01CL, 0x4FAD5EA0L, 0x688FC31CL, 0xD1CFF191L, 0xB3A8C1ADL, 0x2F2F2218L, 0xBE0E1777L, 0xEA752DFEL, 0x8B021FA1L, 0xE5A0CC0FL, 0xB56F74E8L, 0x18ACF3D6L, 0xCE89E299L, 0xB4A84FE0L, 0xFD13E0B7L, 0x7CC43B81L, 0xD2ADA8D9L, 0x165FA266L, 0x80957705L, 0x93CC7314L, 0x211A1477L, 0xE6AD2065L, 0x77B5FA86L, 0xC75442F5L, 0xFB9D35CFL, 0xEBCDAF0CL, 0x7B3E89A0L, 0xD6411BD3L, 0xAE1E7E49L, 0x00250E2DL, 0x2071B35EL, 0x226800BBL, 0x57B8E0AFL, 0x2464369BL, 0xF009B91EL, 0x5563911DL, 0x59DFA6AAL, 0x78C14389L, 0xD95A537FL, 0x207D5BA2L, 0x02E5B9C5L, 0x83260376L, 0x6295CFA9L, 0x11C81968L, 0x4E734A41L, 0xB3472DCAL, 0x7B14A94AL, 0x1B510052L, 0x9A532915L, 0xD60F573FL, 0xBC9BC6E4L, 0x2B60A476L, 0x81E67400L, 0x08BA6FB5L, 0x571BE91FL, 0xF296EC6BL, 0x2A0DD915L, 0xB6636521L, 0xE7B9F9B6L, 0xFF34052EL, 0xC5855664L, 0x53B02D5DL, 0xA99F8FA1L, 0x08BA4799L, 0x6E85076AL }, { 0x4B7A70E9L, 0xB5B32944L, 0xDB75092EL, 0xC4192623L, 0xAD6EA6B0L, 0x49A7DF7DL, 0x9CEE60B8L, 0x8FEDB266L, 0xECAA8C71L, 0x699A17FFL, 0x5664526CL, 0xC2B19EE1L, 0x193602A5L, 0x75094C29L, 0xA0591340L, 0xE4183A3EL, 0x3F54989AL, 0x5B429D65L, 0x6B8FE4D6L, 0x99F73FD6L, 0xA1D29C07L, 0xEFE830F5L, 0x4D2D38E6L, 0xF0255DC1L, 0x4CDD2086L, 0x8470EB26L, 0x6382E9C6L, 0x021ECC5EL, 0x09686B3FL, 0x3EBAEFC9L, 0x3C971814L, 0x6B6A70A1L, 0x687F3584L, 0x52A0E286L, 0xB79C5305L, 0xAA500737L, 0x3E07841CL, 0x7FDEAE5CL, 0x8E7D44ECL, 0x5716F2B8L, 0xB03ADA37L, 0xF0500C0DL, 0xF01C1F04L, 0x0200B3FFL, 0xAE0CF51AL, 0x3CB574B2L, 0x25837A58L, 0xDC0921BDL, 0xD19113F9L, 0x7CA92FF6L, 0x94324773L, 0x22F54701L, 0x3AE5E581L, 0x37C2DADCL, 0xC8B57634L, 0x9AF3DDA7L, 0xA9446146L, 0x0FD0030EL, 0xECC8C73EL, 0xA4751E41L, 0xE238CD99L, 0x3BEA0E2FL, 0x3280BBA1L, 0x183EB331L, 0x4E548B38L, 0x4F6DB908L, 0x6F420D03L, 0xF60A04BFL, 0x2CB81290L, 0x24977C79L, 0x5679B072L, 0xBCAF89AFL, 0xDE9A771FL, 0xD9930810L, 0xB38BAE12L, 0xDCCF3F2EL, 0x5512721FL, 0x2E6B7124L, 0x501ADDE6L, 0x9F84CD87L, 0x7A584718L, 0x7408DA17L, 0xBC9F9ABCL, 0xE94B7D8CL, 0xEC7AEC3AL, 0xDB851DFAL, 0x63094366L, 0xC464C3D2L, 0xEF1C1847L, 0x3215D908L, 0xDD433B37L, 0x24C2BA16L, 0x12A14D43L, 0x2A65C451L, 0x50940002L, 0x133AE4DDL, 0x71DFF89EL, 0x10314E55L, 0x81AC77D6L, 0x5F11199BL, 0x043556F1L, 0xD7A3C76BL, 0x3C11183BL, 0x5924A509L, 0xF28FE6EDL, 0x97F1FBFAL, 0x9EBABF2CL, 0x1E153C6EL, 0x86E34570L, 0xEAE96FB1L, 0x860E5E0AL, 0x5A3E2AB3L, 0x771FE71CL, 0x4E3D06FAL, 0x2965DCB9L, 0x99E71D0FL, 0x803E89D6L, 0x5266C825L, 0x2E4CC978L, 0x9C10B36AL, 0xC6150EBAL, 0x94E2EA78L, 0xA5FC3C53L, 0x1E0A2DF4L, 0xF2F74EA7L, 0x361D2B3DL, 0x1939260FL, 0x19C27960L, 0x5223A708L, 0xF71312B6L, 0xEBADFE6EL, 0xEAC31F66L, 0xE3BC4595L, 0xA67BC883L, 0xB17F37D1L, 0x018CFF28L, 0xC332DDEFL, 0xBE6C5AA5L, 0x65582185L, 0x68AB9802L, 0xEECEA50FL, 0xDB2F953BL, 0x2AEF7DADL, 0x5B6E2F84L, 0x1521B628L, 0x29076170L, 0xECDD4775L, 0x619F1510L, 0x13CCA830L, 0xEB61BD96L, 0x0334FE1EL, 0xAA0363CFL, 0xB5735C90L, 0x4C70A239L, 0xD59E9E0BL, 0xCBAADE14L, 0xEECC86BCL, 0x60622CA7L, 0x9CAB5CABL, 0xB2F3846EL, 0x648B1EAFL, 0x19BDF0CAL, 0xA02369B9L, 0x655ABB50L, 0x40685A32L, 0x3C2AB4B3L, 0x319EE9D5L, 0xC021B8F7L, 0x9B540B19L, 0x875FA099L, 0x95F7997EL, 0x623D7DA8L, 0xF837889AL, 0x97E32D77L, 0x11ED935FL, 0x16681281L, 0x0E358829L, 0xC7E61FD6L, 0x96DEDFA1L, 0x7858BA99L, 0x57F584A5L, 0x1B227263L, 0x9B83C3FFL, 0x1AC24696L, 0xCDB30AEBL, 0x532E3054L, 0x8FD948E4L, 0x6DBC3128L, 0x58EBF2EFL, 0x34C6FFEAL, 0xFE28ED61L, 0xEE7C3C73L, 0x5D4A14D9L, 0xE864B7E3L, 0x42105D14L, 0x203E13E0L, 0x45EEE2B6L, 0xA3AAABEAL, 0xDB6C4F15L, 0xFACB4FD0L, 0xC742F442L, 0xEF6ABBB5L, 0x654F3B1DL, 0x41CD2105L, 0xD81E799EL, 0x86854DC7L, 0xE44B476AL, 0x3D816250L, 0xCF62A1F2L, 0x5B8D2646L, 0xFC8883A0L, 0xC1C7B6A3L, 0x7F1524C3L, 0x69CB7492L, 0x47848A0BL, 0x5692B285L, 0x095BBF00L, 0xAD19489DL, 0x1462B174L, 0x23820E00L, 0x58428D2AL, 0x0C55F5EAL, 0x1DADF43EL, 0x233F7061L, 0x3372F092L, 0x8D937E41L, 0xD65FECF1L, 0x6C223BDBL, 0x7CDE3759L, 0xCBEE7460L, 0x4085F2A7L, 0xCE77326EL, 0xA6078084L, 0x19F8509EL, 0xE8EFD855L, 0x61D99735L, 0xA969A7AAL, 0xC50C06C2L, 0x5A04ABFCL, 0x800BCADCL, 0x9E447A2EL, 0xC3453484L, 0xFDD56705L, 0x0E1E9EC9L, 0xDB73DBD3L, 0x105588CDL, 0x675FDA79L, 0xE3674340L, 0xC5C43465L, 0x713E38D8L, 0x3D28F89EL, 0xF16DFF20L, 0x153E21E7L, 0x8FB03D4AL, 0xE6E39F2BL, 0xDB83ADF7L }, { 0xE93D5A68L, 0x948140F7L, 0xF64C261CL, 0x94692934L, 0x411520F7L, 0x7602D4F7L, 0xBCF46B2EL, 0xD4A20068L, 0xD4082471L, 0x3320F46AL, 0x43B7D4B7L, 0x500061AFL, 0x1E39F62EL, 0x97244546L, 0x14214F74L, 0xBF8B8840L, 0x4D95FC1DL, 0x96B591AFL, 0x70F4DDD3L, 0x66A02F45L, 0xBFBC09ECL, 0x03BD9785L, 0x7FAC6DD0L, 0x31CB8504L, 0x96EB27B3L, 0x55FD3941L, 0xDA2547E6L, 0xABCA0A9AL, 0x28507825L, 0x530429F4L, 0x0A2C86DAL, 0xE9B66DFBL, 0x68DC1462L, 0xD7486900L, 0x680EC0A4L, 0x27A18DEEL, 0x4F3FFEA2L, 0xE887AD8CL, 0xB58CE006L, 0x7AF4D6B6L, 0xAACE1E7CL, 0xD3375FECL, 0xCE78A399L, 0x406B2A42L, 0x20FE9E35L, 0xD9F385B9L, 0xEE39D7ABL, 0x3B124E8BL, 0x1DC9FAF7L, 0x4B6D1856L, 0x26A36631L, 0xEAE397B2L, 0x3A6EFA74L, 0xDD5B4332L, 0x6841E7F7L, 0xCA7820FBL, 0xFB0AF54EL, 0xD8FEB397L, 0x454056ACL, 0xBA489527L, 0x55533A3AL, 0x20838D87L, 0xFE6BA9B7L, 0xD096954BL, 0x55A867BCL, 0xA1159A58L, 0xCCA92963L, 0x99E1DB33L, 0xA62A4A56L, 0x3F3125F9L, 0x5EF47E1CL, 0x9029317CL, 0xFDF8E802L, 0x04272F70L, 0x80BB155CL, 0x05282CE3L, 0x95C11548L, 0xE4C66D22L, 0x48C1133FL, 0xC70F86DCL, 0x07F9C9EEL, 0x41041F0FL, 0x404779A4L, 0x5D886E17L, 0x325F51EBL, 0xD59BC0D1L, 0xF2BCC18FL, 0x41113564L, 0x257B7834L, 0x602A9C60L, 0xDFF8E8A3L, 0x1F636C1BL, 0x0E12B4C2L, 0x02E1329EL, 0xAF664FD1L, 0xCAD18115L, 0x6B2395E0L, 0x333E92E1L, 0x3B240B62L, 0xEEBEB922L, 0x85B2A20EL, 0xE6BA0D99L, 0xDE720C8CL, 0x2DA2F728L, 0xD0127845L, 0x95B794FDL, 0x647D0862L, 0xE7CCF5F0L, 0x5449A36FL, 0x877D48FAL, 0xC39DFD27L, 0xF33E8D1EL, 0x0A476341L, 0x992EFF74L, 0x3A6F6EABL, 0xF4F8FD37L, 0xA812DC60L, 0xA1EBDDF8L, 0x991BE14CL, 0xDB6E6B0DL, 0xC67B5510L, 0x6D672C37L, 0x2765D43BL, 0xDCD0E804L, 0xF1290DC7L, 0xCC00FFA3L, 0xB5390F92L, 0x690FED0BL, 0x667B9FFBL, 0xCEDB7D9CL, 0xA091CF0BL, 0xD9155EA3L, 0xBB132F88L, 0x515BAD24L, 0x7B9479BFL, 0x763BD6EBL, 0x37392EB3L, 0xCC115979L, 0x8026E297L, 0xF42E312DL, 0x6842ADA7L, 0xC66A2B3BL, 0x12754CCCL, 0x782EF11CL, 0x6A124237L, 0xB79251E7L, 0x06A1BBE6L, 0x4BFB6350L, 0x1A6B1018L, 0x11CAEDFAL, 0x3D25BDD8L, 0xE2E1C3C9L, 0x44421659L, 0x0A121386L, 0xD90CEC6EL, 0xD5ABEA2AL, 0x64AF674EL, 0xDA86A85FL, 0xBEBFE988L, 0x64E4C3FEL, 0x9DBC8057L, 0xF0F7C086L, 0x60787BF8L, 0x6003604DL, 0xD1FD8346L, 0xF6381FB0L, 0x7745AE04L, 0xD736FCCCL, 0x83426B33L, 0xF01EAB71L, 0xB0804187L, 0x3C005E5FL, 0x77A057BEL, 0xBDE8AE24L, 0x55464299L, 0xBF582E61L, 0x4E58F48FL, 0xF2DDFDA2L, 0xF474EF38L, 0x8789BDC2L, 0x5366F9C3L, 0xC8B38E74L, 0xB475F255L, 0x46FCD9B9L, 0x7AEB2661L, 0x8B1DDF84L, 0x846A0E79L, 0x915F95E2L, 0x466E598EL, 0x20B45770L, 0x8CD55591L, 0xC902DE4CL, 0xB90BACE1L, 0xBB8205D0L, 0x11A86248L, 0x7574A99EL, 0xB77F19B6L, 0xE0A9DC09L, 0x662D09A1L, 0xC4324633L, 0xE85A1F02L, 0x09F0BE8CL, 0x4A99A025L, 0x1D6EFE10L, 0x1AB93D1DL, 0x0BA5A4DFL, 0xA186F20FL, 0x2868F169L, 0xDCB7DA83L, 0x573906FEL, 0xA1E2CE9BL, 0x4FCD7F52L, 0x50115E01L, 0xA70683FAL, 0xA002B5C4L, 0x0DE6D027L, 0x9AF88C27L, 0x773F8641L, 0xC3604C06L, 0x61A806B5L, 0xF0177A28L, 0xC0F586E0L, 0x006058AAL, 0x30DC7D62L, 0x11E69ED7L, 0x2338EA63L, 0x53C2DD94L, 0xC2C21634L, 0xBBCBEE56L, 0x90BCB6DEL, 0xEBFC7DA1L, 0xCE591D76L, 0x6F05E409L, 0x4B7C0188L, 0x39720A3DL, 0x7C927C24L, 0x86E3725FL, 0x724D9DB9L, 0x1AC15BB4L, 0xD39EB8FCL, 0xED545578L, 0x08FCA5B5L, 0xD83D7CD3L, 0x4DAD0FC4L, 0x1E50EF5EL, 0xB161E6F8L, 0xA28514D9L, 0x6C51133CL, 0x6FD5C7E7L, 0x56E14EC4L, 0x362ABFCEL, 0xDDC6C837L, 0xD79A3234L, 0x92638212L, 0x670EFA8EL, 0x406000E0L }, { 0x3A39CE37L, 0xD3FAF5CFL, 0xABC27737L, 0x5AC52D1BL, 0x5CB0679EL, 0x4FA33742L, 0xD3822740L, 0x99BC9BBEL, 0xD5118E9DL, 0xBF0F7315L, 0xD62D1C7EL, 0xC700C47BL, 0xB78C1B6BL, 0x21A19045L, 0xB26EB1BEL, 0x6A366EB4L, 0x5748AB2FL, 0xBC946E79L, 0xC6A376D2L, 0x6549C2C8L, 0x530FF8EEL, 0x468DDE7DL, 0xD5730A1DL, 0x4CD04DC6L, 0x2939BBDBL, 0xA9BA4650L, 0xAC9526E8L, 0xBE5EE304L, 0xA1FAD5F0L, 0x6A2D519AL, 0x63EF8CE2L, 0x9A86EE22L, 0xC089C2B8L, 0x43242EF6L, 0xA51E03AAL, 0x9CF2D0A4L, 0x83C061BAL, 0x9BE96A4DL, 0x8FE51550L, 0xBA645BD6L, 0x2826A2F9L, 0xA73A3AE1L, 0x4BA99586L, 0xEF5562E9L, 0xC72FEFD3L, 0xF752F7DAL, 0x3F046F69L, 0x77FA0A59L, 0x80E4A915L, 0x87B08601L, 0x9B09E6ADL, 0x3B3EE593L, 0xE990FD5AL, 0x9E34D797L, 0x2CF0B7D9L, 0x022B8B51L, 0x96D5AC3AL, 0x017DA67DL, 0xD1CF3ED6L, 0x7C7D2D28L, 0x1F9F25CFL, 0xADF2B89BL, 0x5AD6B472L, 0x5A88F54CL, 0xE029AC71L, 0xE019A5E6L, 0x47B0ACFDL, 0xED93FA9BL, 0xE8D3C48DL, 0x283B57CCL, 0xF8D56629L, 0x79132E28L, 0x785F0191L, 0xED756055L, 0xF7960E44L, 0xE3D35E8CL, 0x15056DD4L, 0x88F46DBAL, 0x03A16125L, 0x0564F0BDL, 0xC3EB9E15L, 0x3C9057A2L, 0x97271AECL, 0xA93A072AL, 0x1B3F6D9BL, 0x1E6321F5L, 0xF59C66FBL, 0x26DCF319L, 0x7533D928L, 0xB155FDF5L, 0x03563482L, 0x8ABA3CBBL, 0x28517711L, 0xC20AD9F8L, 0xABCC5167L, 0xCCAD925FL, 0x4DE81751L, 0x3830DC8EL, 0x379D5862L, 0x9320F991L, 0xEA7A90C2L, 0xFB3E7BCEL, 0x5121CE64L, 0x774FBE32L, 0xA8B6E37EL, 0xC3293D46L, 0x48DE5369L, 0x6413E680L, 0xA2AE0810L, 0xDD6DB224L, 0x69852DFDL, 0x09072166L, 0xB39A460AL, 0x6445C0DDL, 0x586CDECFL, 0x1C20C8AEL, 0x5BBEF7DDL, 0x1B588D40L, 0xCCD2017FL, 0x6BB4E3BBL, 0xDDA26A7EL, 0x3A59FF45L, 0x3E350A44L, 0xBCB4CDD5L, 0x72EACEA8L, 0xFA6484BBL, 0x8D6612AEL, 0xBF3C6F47L, 0xD29BE463L, 0x542F5D9EL, 0xAEC2771BL, 0xF64E6370L, 0x740E0D8DL, 0xE75B1357L, 0xF8721671L, 0xAF537D5DL, 0x4040CB08L, 0x4EB4E2CCL, 0x34D2466AL, 0x0115AF84L, 0xE1B00428L, 0x95983A1DL, 0x06B89FB4L, 0xCE6EA048L, 0x6F3F3B82L, 0x3520AB82L, 0x011A1D4BL, 0x277227F8L, 0x611560B1L, 0xE7933FDCL, 0xBB3A792BL, 0x344525BDL, 0xA08839E1L, 0x51CE794BL, 0x2F32C9B7L, 0xA01FBAC9L, 0xE01CC87EL, 0xBCC7D1F6L, 0xCF0111C3L, 0xA1E8AAC7L, 0x1A908749L, 0xD44FBD9AL, 0xD0DADECBL, 0xD50ADA38L, 0x0339C32AL, 0xC6913667L, 0x8DF9317CL, 0xE0B12B4FL, 0xF79E59B7L, 0x43F5BB3AL, 0xF2D519FFL, 0x27D9459CL, 0xBF97222CL, 0x15E6FC2AL, 0x0F91FC71L, 0x9B941525L, 0xFAE59361L, 0xCEB69CEBL, 0xC2A86459L, 0x12BAA8D1L, 0xB6C1075EL, 0xE3056A0CL, 0x10D25065L, 0xCB03A442L, 0xE0EC6E0EL, 0x1698DB3BL, 0x4C98A0BEL, 0x3278E964L, 0x9F1F9532L, 0xE0D392DFL, 0xD3A0342BL, 0x8971F21EL, 0x1B0A7441L, 0x4BA3348CL, 0xC5BE7120L, 0xC37632D8L, 0xDF359F8DL, 0x9B992F2EL, 0xE60B6F47L, 0x0FE3F11DL, 0xE54CDA54L, 0x1EDAD891L, 0xCE6279CFL, 0xCD3E7E6FL, 0x1618B166L, 0xFD2C1D05L, 0x848FD2C5L, 0xF6FB2299L, 0xF523F357L, 0xA6327623L, 0x93A83531L, 0x56CCCD02L, 0xACF08162L, 0x5A75EBB5L, 0x6E163697L, 0x88D273CCL, 0xDE966292L, 0x81B949D0L, 0x4C50901BL, 0x71C65614L, 0xE6C6C7BDL, 0x327A140AL, 0x45E1D006L, 0xC3F27B9AL, 0xC9AA53FDL, 0x62A80F00L, 0xBB25BFE2L, 0x35BDD2F6L, 0x71126905L, 0xB2040222L, 0xB6CBCF7CL, 0xCD769C2BL, 0x53113EC0L, 0x1640E3D3L, 0x38ABBD60L, 0x2547ADF0L, 0xBA38209CL, 0xF746CE76L, 0x77AFA1C5L, 0x20756060L, 0x85CBFE4EL, 0x8AE88DD8L, 0x7AAAF9B0L, 0x4CF9AA7EL, 0x1948C25CL, 0x02FB8A8CL, 0x01C36AE4L, 0xD6EBE1F9L, 0x90D4F869L, 0xA65CDEA0L, 0x3F09252DL, 0xC208E69FL, 0xB74E6132L, 0xCE77E25BL, 0x578FDFE3L, 0x3AC372E6L } }; /* XL: turned F into a macro + endianness handling */ #if 0 static u32 F(BLOWFISH_CTX *ctx, u32 x) { unsigned short a, b, c, d; u32 y; d = (unsigned short)(x & 0xFF); x >>= 8; c = (unsigned short)(x & 0xFF); x >>= 8; b = (unsigned short)(x & 0xFF); x >>= 8; a = (unsigned short)(x & 0xFF); y = ctx->S[0][a] + ctx->S[1][b]; y = y ^ ctx->S[2][c]; y = y + ctx->S[3][d]; return y; } #else #define F(ctx,x) \ (((ctx->S[0][x >> 24] \ + ctx->S[1][(x >> 16) & 0xFF]) \ ^ ctx->S[2][(x >> 8) & 0xFF]) \ + ctx->S[3][x & 0xFF]) #endif void Blowfish_Encrypt(BLOWFISH_CTX *ctx, u32 *xl, u32 *xr){ u32 Xl; u32 Xr; #if 0 u32 temp; short i; Xl = *xl; Xr = *xr; for (i = 0; i < N; ++i) { Xl = Xl ^ ctx->P[i]; Xr = F(ctx, Xl) ^ Xr; temp = Xl; Xl = Xr; Xr = temp; } temp = Xl; Xl = Xr; Xr = temp; Xr = Xr ^ ctx->P[N]; Xl = Xl ^ ctx->P[N + 1]; *xl = Xl; *xr = Xr; #else Xl = *xl; Xr = *xr; /* XL: loop unrolling */ Xl ^= ctx->P[0]; Xr ^= F(ctx,Xl) ^ ctx->P[1]; Xl ^= F(ctx,Xr) ^ ctx->P[2]; Xr ^= F(ctx,Xl) ^ ctx->P[3]; Xl ^= F(ctx,Xr) ^ ctx->P[4]; Xr ^= F(ctx,Xl) ^ ctx->P[5]; Xl ^= F(ctx,Xr) ^ ctx->P[6]; Xr ^= F(ctx,Xl) ^ ctx->P[7]; Xl ^= F(ctx,Xr) ^ ctx->P[8]; Xr ^= F(ctx,Xl) ^ ctx->P[9]; Xl ^= F(ctx,Xr) ^ ctx->P[10]; Xr ^= F(ctx,Xl) ^ ctx->P[11]; Xl ^= F(ctx,Xr) ^ ctx->P[12]; Xr ^= F(ctx,Xl) ^ ctx->P[13]; Xl ^= F(ctx,Xr) ^ ctx->P[14]; Xr ^= F(ctx,Xl) ^ ctx->P[15]; Xl ^= F(ctx,Xr) ^ ctx->P[16]; Xr ^= ctx->P[17]; *xl = Xr; *xr = Xl; #endif } void Blowfish_Decrypt(BLOWFISH_CTX *ctx, u32 *xl, u32 *xr){ u32 Xl; u32 Xr; #if 0 u32 temp; short i; Xl = *xl; Xr = *xr; for (i = N + 1; i > 1; --i) { Xl = Xl ^ ctx->P[i]; Xr = F(ctx, Xl) ^ Xr; /* Exchange Xl and Xr */ temp = Xl; Xl = Xr; Xr = temp; } /* Exchange Xl and Xr */ temp = Xl; Xl = Xr; Xr = temp; Xr = Xr ^ ctx->P[1]; Xl = Xl ^ ctx->P[0]; *xl = Xl; *xr = Xr; #else Xl = *xl; Xr = *xr; /* XL: loop unrolling */ Xl ^= ctx->P[17]; Xr ^= F(ctx,Xl) ^ ctx->P[16]; Xl ^= F(ctx,Xr) ^ ctx->P[15]; Xr ^= F(ctx,Xl) ^ ctx->P[14]; Xl ^= F(ctx,Xr) ^ ctx->P[13]; Xr ^= F(ctx,Xl) ^ ctx->P[12]; Xl ^= F(ctx,Xr) ^ ctx->P[11]; Xr ^= F(ctx,Xl) ^ ctx->P[10]; Xl ^= F(ctx,Xr) ^ ctx->P[9]; Xr ^= F(ctx,Xl) ^ ctx->P[8]; Xl ^= F(ctx,Xr) ^ ctx->P[7]; Xr ^= F(ctx,Xl) ^ ctx->P[6]; Xl ^= F(ctx,Xr) ^ ctx->P[5]; Xr ^= F(ctx,Xl) ^ ctx->P[4]; Xl ^= F(ctx,Xr) ^ ctx->P[3]; Xr ^= F(ctx,Xl) ^ ctx->P[2]; Xl ^= F(ctx,Xr) ^ ctx->P[1]; Xr ^= ctx->P[0]; *xl = Xr; *xr = Xl; #endif } void Blowfish_Init(BLOWFISH_CTX *ctx, unsigned char *key, int keyLen) { int i, j, k; u32 data, datal, datar; for (i = 0; i < 4; i++) { for (j = 0; j < 256; j++) ctx->S[i][j] = ORIG_S[i][j]; } j = 0; for (i = 0; i < N + 2; ++i) { data = 0x00000000; for (k = 0; k < 4; ++k) { data = (data << 8) | key[j]; j = j + 1; if (j >= keyLen) j = 0; } ctx->P[i] = ORIG_P[i] ^ data; } datal = 0x00000000; datar = 0x00000000; for (i = 0; i < N + 2; i += 2) { Blowfish_Encrypt(ctx, &datal, &datar); ctx->P[i] = datal; ctx->P[i + 1] = datar; } for (i = 0; i < 4; ++i) { for (j = 0; j < 256; j += 2) { Blowfish_Encrypt(ctx, &datal, &datar); ctx->S[i][j] = datal; ctx->S[i][j + 1] = datar; } } } cryptokit-1.9/src/cryptokit.ml0000644000175000017500000020610012135543724016113 0ustar gildorgildor(***********************************************************************) (* *) (* The Cryptokit library *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2002 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License, with *) (* the special exception on linking described in file LICENSE. *) (* *) (***********************************************************************) (* $Id: cryptokit.ml 71 2013-04-23 17:41:40Z xleroy $ *) open Nat let wipe_string s = String.fill s 0 (String.length s) '\000' let wipe_nat n = set_to_zero_nat n 0 (length_nat n) type error = | Wrong_key_size | Wrong_IV_size | Wrong_data_length | Bad_padding | Output_buffer_overflow | Incompatible_block_size | Number_too_long | Seed_too_short | Message_too_long | Bad_encoding | Compression_error of string * string | No_entropy_source | Entropy_source_closed | Compression_not_supported exception Error of error let _ = Callback.register_exception "Cryptokit.Error" (Error Wrong_key_size) (* Interface with C *) type dir = Encrypt | Decrypt external xor_string: string -> int -> string -> int -> int -> unit = "caml_xor_string" external aes_cook_encrypt_key : string -> string = "caml_aes_cook_encrypt_key" external aes_cook_decrypt_key : string -> string = "caml_aes_cook_decrypt_key" external aes_encrypt : string -> string -> int -> string -> int -> unit = "caml_aes_encrypt" external aes_decrypt : string -> string -> int -> string -> int -> unit = "caml_aes_decrypt" external blowfish_cook_key : string -> string = "caml_blowfish_cook_key" external blowfish_encrypt : string -> string -> int -> string -> int -> unit = "caml_blowfish_encrypt" external blowfish_decrypt : string -> string -> int -> string -> int -> unit = "caml_blowfish_decrypt" external des_cook_key : string -> int -> dir -> string = "caml_des_cook_key" external des_transform : string -> string -> int -> string -> int -> unit = "caml_des_transform" external arcfour_cook_key : string -> string = "caml_arcfour_cook_key" external arcfour_transform : string -> string -> int -> string -> int -> int -> unit = "caml_arcfour_transform_bytecode" "caml_arcfour_transform" external sha1_init: unit -> string = "caml_sha1_init" external sha1_update: string -> string -> int -> int -> unit = "caml_sha1_update" external sha1_final: string -> string = "caml_sha1_final" external sha256_init: unit -> string = "caml_sha256_init" external sha256_update: string -> string -> int -> int -> unit = "caml_sha256_update" external sha256_final: string -> string = "caml_sha256_final" type sha3_context external sha3_init: int -> sha3_context = "caml_sha3_init" external sha3_absorb: sha3_context -> string -> int -> int -> unit = "caml_sha3_absorb" external sha3_extract: sha3_context -> string = "caml_sha3_extract" external sha3_wipe: sha3_context -> unit = "caml_sha3_wipe" external ripemd160_init: unit -> string = "caml_ripemd160_init" external ripemd160_update: string -> string -> int -> int -> unit = "caml_ripemd160_update" external ripemd160_final: string -> string = "caml_ripemd160_final" external md5_init: unit -> string = "caml_md5_init" external md5_update: string -> string -> int -> int -> unit = "caml_md5_update" external md5_final: string -> string = "caml_md5_final" (* Abstract transform type *) class type transform = object method input_block_size: int method output_block_size: int method put_substring: string -> int -> int -> unit method put_string: string -> unit method put_char: char -> unit method put_byte: int -> unit method finish: unit method flush: unit method available_output: int method get_string: string method get_substring: string * int * int method get_char: char method get_byte: int method wipe: unit end let transform_string tr s = tr#put_string s; tr#finish; let r = tr#get_string in tr#wipe; r let transform_channel tr ?len ic oc = let ibuf = String.create 256 in let rec transf_to_eof () = let r = input ic ibuf 0 256 in if r > 0 then begin tr#put_substring ibuf 0 r; let (obuf, opos, olen) = tr#get_substring in output oc obuf opos olen; transf_to_eof() end and transf_bounded numleft = if numleft > 0 then begin let r = input ic ibuf 0 (min 256 numleft) in if r = 0 then raise End_of_file; tr#put_substring ibuf 0 r; let (obuf, opos, olen) = tr#get_substring in output oc obuf opos olen; transf_bounded (numleft - r) end in begin match len with None -> transf_to_eof () | Some l -> transf_bounded l end; wipe_string ibuf; tr#finish; let (obuf, opos, olen) = tr#get_substring in output oc obuf opos olen; tr#wipe class compose (tr1 : transform) (tr2 : transform) = object(self) method input_block_size = tr1#input_block_size method output_block_size = tr2#output_block_size method put_substring buf ofs len = tr1#put_substring buf ofs len; self#transfer method put_string s = tr1#put_string s; self#transfer method put_char c = tr1#put_char c; self#transfer method put_byte b = tr1#put_byte b; self#transfer method private transfer = let (buf, ofs, len) = tr1#get_substring in tr2#put_substring buf ofs len method available_output = tr2#available_output method get_string = tr2#get_string method get_substring = tr2#get_substring method get_char = tr2#get_char method get_byte = tr2#get_byte method flush = tr1#flush; self#transfer; tr2#flush method finish = tr1#finish; self#transfer; tr2#finish method wipe = tr1#wipe; tr2#wipe end let compose tr1 tr2 = new compose tr1 tr2 class type hash = object method hash_size: int method add_substring: string -> int -> int -> unit method add_string: string -> unit method add_char: char -> unit method add_byte: int -> unit method result: string method wipe: unit end let hash_string hash s = hash#add_string s; let r = hash#result in hash#wipe; r let hash_channel hash ?len ic = let ibuf = String.create 256 in let rec hash_to_eof () = let r = input ic ibuf 0 256 in if r > 0 then begin hash#add_substring ibuf 0 r; hash_to_eof() end and hash_bounded numleft = if numleft > 0 then begin let r = input ic ibuf 0 (min 256 numleft) in if r = 0 then raise End_of_file; hash#add_substring ibuf 0 r; hash_bounded (numleft - r) end in begin match len with None -> hash_to_eof () | Some l -> hash_bounded l end; wipe_string ibuf; let res = hash#result in hash#wipe; res (* Padding schemes *) module Padding = struct class type scheme = object method pad: string -> int -> unit method strip: string -> int end class length = object method pad buffer used = let n = String.length buffer - used in assert (n > 0 && n < 256); String.fill buffer used n (Char.chr n) method strip buffer = let blocksize = String.length buffer in let n = Char.code buffer.[blocksize - 1] in if n = 0 || n > blocksize then raise (Error Bad_padding); (* Characters blocksize - n to blocksize - 1 must be equal to n *) for i = blocksize - n to blocksize - 2 do if Char.code buffer.[i] <> n then raise (Error Bad_padding) done; blocksize - n end let length = new length class _8000 = object method pad buffer used = buffer.[used] <- '\128'; for i = used + 1 to String.length buffer - 1 do buffer.[i] <- '\000' done method strip buffer = let rec strip pos = if pos < 0 then raise (Error Bad_padding) else match buffer.[pos] with '\128' -> pos | '\000' -> strip (pos - 1) | _ -> raise (Error Bad_padding) in strip (String.length buffer - 1) end let _8000 = new _8000 end (* Generic handling of output buffering *) class buffered_output initial_buffer_size = object(self) val mutable obuf = String.create initial_buffer_size val mutable obeg = 0 val mutable oend = 0 method private ensure_capacity n = let len = String.length obuf in if oend + n > len then begin if oend - obeg + n < len then begin String.blit obuf obeg obuf 0 (oend - obeg); oend <- oend - obeg; obeg <- 0 end else begin let newlen = ref (2 * len) in while oend - obeg + n > (!newlen) do newlen := (!newlen) * 2 done; if (!newlen) > Sys.max_string_length then begin if (oend - obeg + n) <= Sys.max_string_length then newlen := Sys.max_string_length else raise (Error Output_buffer_overflow) end; let newbuf = String.create (!newlen) in String.blit obuf obeg newbuf 0 (oend - obeg); obuf <- newbuf; oend <- oend - obeg; obeg <- 0 end end method available_output = oend - obeg method get_substring = let res = (obuf, obeg, oend - obeg) in obeg <- 0; oend <- 0; res method get_string = let res = String.sub obuf obeg (oend - obeg) in obeg <- 0; oend <- 0; res method get_char = if obeg >= oend then raise End_of_file; let r = obuf.[obeg] in obeg <- obeg + 1; r method get_byte = Char.code self#get_char method wipe = wipe_string obuf end (* Block ciphers *) module Block = struct class type block_cipher = object method blocksize: int method transform: string -> int -> string -> int -> unit method wipe: unit end class aes_encrypt key = object val ckey = let kl = String.length key in if kl = 16 || kl = 24 || kl = 32 then aes_cook_encrypt_key key else raise(Error Wrong_key_size) method blocksize = 16 method transform src src_ofs dst dst_ofs = if src_ofs < 0 || src_ofs + 16 > String.length src || dst_ofs < 0 || dst_ofs + 16 > String.length dst then invalid_arg "aes#transform"; aes_encrypt ckey src src_ofs dst dst_ofs method wipe = wipe_string ckey; ckey.[String.length ckey - 1] <- '\016' end class aes_decrypt key = object val ckey = let kl = String.length key in if kl = 16 || kl = 24 || kl = 32 then aes_cook_decrypt_key key else raise(Error Wrong_key_size) method blocksize = 16 method transform src src_ofs dst dst_ofs = if src_ofs < 0 || src_ofs + 16 > String.length src || dst_ofs < 0 || dst_ofs + 16 > String.length dst then invalid_arg "aes#transform"; aes_decrypt ckey src src_ofs dst dst_ofs method wipe = wipe_string ckey; ckey.[String.length ckey - 1] <- '\016' end class blowfish_encrypt key = object val ckey = let kl = String.length key in if kl >= 4 && kl <= 56 then blowfish_cook_key key else raise(Error Wrong_key_size) method blocksize = 8 method transform src src_ofs dst dst_ofs = if src_ofs < 0 || src_ofs + 8 > String.length src || dst_ofs < 0 || dst_ofs + 8 > String.length dst then invalid_arg "blowfish#transform"; blowfish_encrypt ckey src src_ofs dst dst_ofs method wipe = wipe_string ckey end class blowfish_decrypt key = object val ckey = let kl = String.length key in if kl >= 4 && kl <= 56 then blowfish_cook_key key else raise(Error Wrong_key_size) method blocksize = 8 method transform src src_ofs dst dst_ofs = if src_ofs < 0 || src_ofs + 8 > String.length src || dst_ofs < 0 || dst_ofs + 8 > String.length dst then invalid_arg "blowfish#transform"; blowfish_decrypt ckey src src_ofs dst dst_ofs method wipe = wipe_string ckey end class des direction key = object val ckey = if String.length key = 8 then des_cook_key key 0 direction else raise(Error Wrong_key_size) method blocksize = 8 method transform src src_ofs dst dst_ofs = if src_ofs < 0 || src_ofs + 8 > String.length src || dst_ofs < 0 || dst_ofs + 8 > String.length dst then invalid_arg "des#transform"; des_transform ckey src src_ofs dst dst_ofs method wipe = wipe_string ckey end class des_encrypt = des Encrypt class des_decrypt = des Decrypt class triple_des_encrypt key = let _ = let kl = String.length key in if kl <> 16 && kl <> 24 then raise (Error Wrong_key_size) in let ckey1 = des_cook_key key 0 Encrypt in let ckey2 = des_cook_key key 8 Decrypt in let ckey3 = if String.length key = 24 then des_cook_key key 16 Encrypt else ckey1 in object method blocksize = 8 method transform src src_ofs dst dst_ofs = if src_ofs < 0 || src_ofs + 8 > String.length src || dst_ofs < 0 || dst_ofs + 8 > String.length dst then invalid_arg "triple_des#transform"; des_transform ckey1 src src_ofs dst dst_ofs; des_transform ckey2 dst dst_ofs dst dst_ofs; des_transform ckey3 dst dst_ofs dst dst_ofs method wipe = wipe_string ckey1; wipe_string ckey2; wipe_string ckey3 end class triple_des_decrypt key = let _ = let kl = String.length key in if kl <> 16 && kl <> 24 then raise (Error Wrong_key_size) in let ckey3 = des_cook_key key 0 Decrypt in let ckey2 = des_cook_key key 8 Encrypt in let ckey1 = if String.length key = 24 then des_cook_key key 16 Decrypt else ckey3 in object method blocksize = 8 method transform src src_ofs dst dst_ofs = if src_ofs < 0 || src_ofs + 8 > String.length src || dst_ofs < 0 || dst_ofs + 8 > String.length dst then invalid_arg "triple_des#transform"; des_transform ckey1 src src_ofs dst dst_ofs; des_transform ckey2 dst dst_ofs dst dst_ofs; des_transform ckey3 dst dst_ofs dst dst_ofs method wipe = wipe_string ckey1; wipe_string ckey2; wipe_string ckey3 end (* Chaining modes *) let make_initial_iv blocksize = function | None -> String.make blocksize '\000' | Some s -> if String.length s <> blocksize then raise (Error Wrong_IV_size); String.copy s class cbc_encrypt ?iv:iv_init (cipher : block_cipher) = let blocksize = cipher#blocksize in object(self) val iv = make_initial_iv blocksize iv_init method blocksize = blocksize method transform src src_off dst dst_off = xor_string src src_off iv 0 blocksize; cipher#transform iv 0 dst dst_off; String.blit dst dst_off iv 0 blocksize method wipe = cipher#wipe; wipe_string iv end class cbc_decrypt ?iv:iv_init (cipher : block_cipher) = let blocksize = cipher#blocksize in object(self) val iv = make_initial_iv blocksize iv_init val next_iv = String.create blocksize method blocksize = blocksize method transform src src_off dst dst_off = String.blit src src_off next_iv 0 blocksize; cipher#transform src src_off dst dst_off; xor_string iv 0 dst dst_off blocksize; String.blit next_iv 0 iv 0 blocksize method wipe = cipher#wipe; wipe_string iv; wipe_string next_iv end class cfb_encrypt ?iv:iv_init chunksize (cipher : block_cipher) = let blocksize = cipher#blocksize in let _ = assert (chunksize > 0 && chunksize <= blocksize) in object(self) val iv = make_initial_iv blocksize iv_init val out = String.create blocksize method blocksize = chunksize method transform src src_off dst dst_off = cipher#transform iv 0 out 0; String.blit src src_off dst dst_off chunksize; xor_string out 0 dst dst_off chunksize; String.blit iv chunksize iv 0 (blocksize - chunksize); String.blit dst dst_off iv (blocksize - chunksize) chunksize method wipe = cipher#wipe; wipe_string iv; wipe_string out end class cfb_decrypt ?iv:iv_init chunksize (cipher : block_cipher) = let blocksize = cipher#blocksize in let _ = assert (chunksize > 0 && chunksize <= blocksize) in object(self) val iv = make_initial_iv blocksize iv_init val out = String.create blocksize method blocksize = chunksize method transform src src_off dst dst_off = cipher#transform iv 0 out 0; String.blit iv chunksize iv 0 (blocksize - chunksize); String.blit src src_off iv (blocksize - chunksize) chunksize; String.blit src src_off dst dst_off chunksize; xor_string out 0 dst dst_off chunksize method wipe = cipher#wipe; wipe_string iv; wipe_string out end class ofb ?iv:iv_init chunksize (cipher : block_cipher) = let blocksize = cipher#blocksize in let _ = assert (chunksize > 0 && chunksize <= blocksize) in object(self) val iv = make_initial_iv blocksize iv_init method blocksize = chunksize method transform src src_off dst dst_off = cipher#transform iv 0 iv 0; String.blit src src_off dst dst_off chunksize; xor_string iv 0 dst dst_off chunksize method wipe = cipher#wipe; wipe_string iv end (* Wrapping of a block cipher as a transform *) class cipher (cipher : block_cipher) = let blocksize = cipher#blocksize in object(self) val ibuf = String.create blocksize val mutable used = 0 inherit buffered_output (max 256 (2 * blocksize)) as output_buffer method input_block_size = blocksize method output_block_size = blocksize method put_substring src ofs len = if len <= 0 then () else if used + len <= blocksize then begin (* Just accumulate len characters in ibuf *) String.blit src ofs ibuf used len; used <- used + len end else begin (* Fill buffer and run it through cipher *) let n = blocksize - used in String.blit src ofs ibuf used n; self#ensure_capacity blocksize; cipher#transform ibuf 0 obuf oend; oend <- oend + blocksize; used <- 0; (* Recurse on remainder of string *) self#put_substring src (ofs + n) (len - n) end method put_string s = self#put_substring s 0 (String.length s) method put_char c = if used < blocksize then begin ibuf.[used] <- c; used <- used + 1 end else begin self#ensure_capacity blocksize; cipher#transform ibuf 0 obuf oend; oend <- oend + blocksize; ibuf.[0] <- c; used <- 1 end method put_byte b = self#put_char (Char.unsafe_chr b) method wipe = cipher#wipe; output_buffer#wipe; wipe_string ibuf method flush = if used = 0 then () else if used = blocksize then begin self#ensure_capacity blocksize; cipher#transform ibuf 0 obuf oend; used <- 0; oend <- oend + blocksize end else raise (Error Wrong_data_length) method finish = self#flush end (* Block cipher with padding *) class cipher_padded_encrypt (padding : Padding.scheme) (cipher : block_cipher) = let blocksize = cipher#blocksize in object(self) inherit cipher cipher method input_block_size = 1 method finish = if used >= blocksize then begin self#ensure_capacity blocksize; cipher#transform ibuf 0 obuf oend; oend <- oend + blocksize; used <- 0 end; padding#pad ibuf used; self#ensure_capacity blocksize; cipher#transform ibuf 0 obuf oend; oend <- oend + blocksize end class cipher_padded_decrypt (padding : Padding.scheme) (cipher : block_cipher) = let blocksize = cipher#blocksize in object(self) inherit cipher cipher method output_block_size = 1 method finish = if used <> blocksize then raise (Error Wrong_data_length); cipher#transform ibuf 0 ibuf 0; let valid = padding#strip ibuf in self#ensure_capacity valid; String.blit ibuf 0 obuf oend valid; oend <- oend + valid end (* Wrapping of a block cipher as a MAC *) class mac ?iv:iv_init ?(pad: Padding.scheme option) (cipher : block_cipher) = let blocksize = cipher#blocksize in object(self) val iv = make_initial_iv blocksize iv_init val buffer = String.create blocksize val mutable used = 0 method hash_size = blocksize method add_substring src src_ofs len = let rec add src_ofs len = if len <= 0 then () else if used + len <= blocksize then begin (* Just accumulate len characters in buffer *) String.blit src src_ofs buffer used len; used <- used + len end else begin (* Fill buffer and run it through cipher *) let n = blocksize - used in String.blit src src_ofs buffer used n; xor_string iv 0 buffer 0 blocksize; cipher#transform buffer 0 iv 0; used <- 0; (* Recurse on remainder of string *) add (src_ofs + n) (len - n) end in add src_ofs len method add_string s = self#add_substring s 0 (String.length s) method add_char c = if used < blocksize then begin buffer.[used] <- c; used <- used + 1 end else begin xor_string iv 0 buffer 0 blocksize; cipher#transform buffer 0 iv 0; buffer.[0] <- c; used <- 1 end method add_byte b = self#add_char (Char.unsafe_chr b) method wipe = cipher#wipe; wipe_string buffer; wipe_string iv method result = if used = blocksize then begin xor_string iv 0 buffer 0 blocksize; cipher#transform buffer 0 iv 0; used <- 0 end; begin match pad with None -> if used <> 0 then raise (Error Wrong_data_length) | Some p -> p#pad buffer used; xor_string iv 0 buffer 0 blocksize; cipher#transform buffer 0 iv 0; used <- 0 end; String.copy iv end class mac_final_triple ?iv ?pad (cipher1 : block_cipher) (cipher2 : block_cipher) (cipher3 : block_cipher) = let _ = if cipher1#blocksize <> cipher2#blocksize || cipher2#blocksize <> cipher3#blocksize then raise(Error Incompatible_block_size) in object inherit mac ?iv ?pad cipher1 as super method result = let r = super#result in cipher2#transform r 0 r 0; cipher3#transform r 0 r 0; r method wipe = super#wipe; cipher2#wipe; cipher3#wipe end end (* Stream ciphers *) module Stream = struct class type stream_cipher = object method transform: string -> int -> string -> int -> int -> unit method wipe: unit end class arcfour key = object val ckey = if String.length key > 0 && String.length key <= 256 then arcfour_cook_key key else raise(Error Wrong_key_size) method transform src src_ofs dst dst_ofs len = if src_ofs < 0 || src_ofs + len > String.length src || dst_ofs < 0 || dst_ofs + len > String.length dst then invalid_arg "arcfour#transform"; arcfour_transform ckey src src_ofs dst dst_ofs len method wipe = wipe_string ckey end (* Wrapping of a stream cipher as a cipher *) class cipher (cipher : stream_cipher) = object(self) val charbuf = String.create 1 inherit buffered_output 256 as output_buffer method input_block_size = 1 method output_block_size = 1 method put_substring src ofs len = self#ensure_capacity len; cipher#transform src ofs obuf oend len; oend <- oend + len method put_string s = self#put_substring s 0 (String.length s) method put_char c = charbuf.[0] <- c; self#ensure_capacity 1; cipher#transform charbuf 0 obuf oend 1; oend <- oend + 1 method put_byte b = self#put_char (Char.unsafe_chr b) method flush = () method finish = () method wipe = cipher#wipe; output_buffer#wipe; wipe_string charbuf end end (* Hash functions *) module Hash = struct class sha1 = object(self) val context = sha1_init() method hash_size = 20 method add_substring src ofs len = if ofs < 0 || ofs + len > String.length src then invalid_arg "sha1#add_substring"; sha1_update context src ofs len method add_string src = sha1_update context src 0 (String.length src) method add_char c = self#add_string (String.make 1 c) method add_byte b = self#add_char (Char.unsafe_chr b) method result = sha1_final context method wipe = wipe_string context end let sha1 () = new sha1 class sha256 = object(self) val context = sha256_init() method hash_size = 32 method add_substring src ofs len = if ofs < 0 || ofs + len > String.length src then invalid_arg "sha256#add_substring"; sha256_update context src ofs len method add_string src = sha256_update context src 0 (String.length src) method add_char c = self#add_string (String.make 1 c) method add_byte b = self#add_char (Char.unsafe_chr b) method result = sha256_final context method wipe = wipe_string context end let sha256 () = new sha256 class sha3 sz = object(self) val context = if sz = 224 || sz = 256 || sz = 384 || sz = 512 then sha3_init sz else raise (Error Wrong_key_size) method hash_size = sz / 8 method add_substring src ofs len = if ofs < 0 || ofs + len > String.length src then invalid_arg "sha3#add_substring"; sha3_absorb context src ofs len method add_string src = sha3_absorb context src 0 (String.length src) method add_char c = self#add_string (String.make 1 c) method add_byte b = self#add_char (Char.unsafe_chr b) method result = sha3_extract context method wipe = sha3_wipe context end let sha3 sz = new sha3 sz class ripemd160 = object(self) val context = ripemd160_init() method hash_size = 32 method add_substring src ofs len = if ofs < 0 || ofs + len > String.length src then invalid_arg "ripemd160#add_substring"; ripemd160_update context src ofs len method add_string src = ripemd160_update context src 0 (String.length src) method add_char c = self#add_string (String.make 1 c) method add_byte b = self#add_char (Char.unsafe_chr b) method result = ripemd160_final context method wipe = wipe_string context end let ripemd160 () = new ripemd160 class md5 = object(self) val context = md5_init() method hash_size = 16 method add_substring src ofs len = if ofs < 0 || ofs + len > String.length src then invalid_arg "md5#add_substring"; md5_update context src ofs len method add_string src = md5_update context src 0 (String.length src) method add_char c = self#add_string (String.make 1 c) method add_byte b = self#add_char (Char.unsafe_chr b) method result = md5_final context method wipe = wipe_string context end let md5 () = new md5 end (* High-level entry points for ciphers *) module Cipher = struct type direction = dir = Encrypt | Decrypt type chaining_mode = ECB | CBC | CFB of int | OFB of int let make_block_cipher ?(mode = CBC) ?pad ?iv dir block_cipher = let chained_cipher = match (mode, dir) with (ECB, _) -> block_cipher | (CBC, Encrypt) -> new Block.cbc_encrypt ?iv block_cipher | (CBC, Decrypt) -> new Block.cbc_decrypt ?iv block_cipher | (CFB n, Encrypt) -> new Block.cfb_encrypt ?iv n block_cipher | (CFB n, Decrypt) -> new Block.cfb_decrypt ?iv n block_cipher | (OFB n, _) -> new Block.ofb ?iv n block_cipher in match pad with None -> new Block.cipher chained_cipher | Some p -> match dir with Encrypt -> new Block.cipher_padded_encrypt p chained_cipher | Decrypt -> new Block.cipher_padded_decrypt p chained_cipher let normalize_dir mode dir = match mode with Some(CFB _) | Some(OFB _) -> Encrypt | _ -> dir let aes ?mode ?pad ?iv key dir = make_block_cipher ?mode ?pad ?iv dir (match normalize_dir mode dir with Encrypt -> new Block.aes_encrypt key | Decrypt -> new Block.aes_decrypt key) let blowfish ?mode ?pad ?iv key dir = make_block_cipher ?mode ?pad ?iv dir (match normalize_dir mode dir with Encrypt -> new Block.blowfish_encrypt key | Decrypt -> new Block.blowfish_decrypt key) let des ?mode ?pad ?iv key dir = make_block_cipher ?mode ?pad ?iv dir (new Block.des (normalize_dir mode dir) key) let triple_des ?mode ?pad ?iv key dir = make_block_cipher ?mode ?pad ?iv dir (match normalize_dir mode dir with Encrypt -> new Block.triple_des_encrypt key | Decrypt -> new Block.triple_des_decrypt key) let arcfour key dir = new Stream.cipher (new Stream.arcfour key) end (* The hmac construction *) module HMAC(H: sig class h: hash val blocksize: int end) = struct let hmac_pad key byte = let key = if String.length key > H.blocksize then hash_string (new H.h) key else key in let r = String.make H.blocksize (Char.chr byte) in xor_string key 0 r 0 (String.length key); r class hmac key = object(self) inherit H.h as super initializer (let s = hmac_pad key 0x36 in self#add_string s; wipe_string s) method result = let h' = new H.h in let s = hmac_pad key 0x5C in h'#add_string s; wipe_string s; h'#add_string (super#result); let r = h'#result in h'#wipe; r end end (* High-level entry points for MACs *) module MAC = struct module HMAC_SHA1 = HMAC(struct class h = Hash.sha1 let blocksize = 64 end) module HMAC_SHA256 = HMAC(struct class h = Hash.sha256 let blocksize = 64 end) module HMAC_RIPEMD160 = HMAC(struct class h = Hash.ripemd160 let blocksize = 64 end) module HMAC_MD5 = HMAC(struct class h = Hash.md5 let blocksize = 64 end) let hmac_sha1 key = new HMAC_SHA1.hmac key let hmac_sha256 key = new HMAC_SHA256.hmac key let hmac_ripemd160 key = new HMAC_RIPEMD160.hmac key let hmac_md5 key = new HMAC_MD5.hmac key let aes ?iv ?pad key = new Block.mac ?iv ?pad (new Block.aes_encrypt key) let des ?iv ?pad key = new Block.mac ?iv ?pad (new Block.des_encrypt key) let triple_des ?iv ?pad key = new Block.mac ?iv ?pad (new Block.triple_des_encrypt key) let des_final_triple_des ?iv ?pad key = let kl = String.length key in if kl <> 16 && kl <> 24 then raise (Error Wrong_key_size); let k1 = String.sub key 0 8 in let k2 = String.sub key 8 8 in let k3 = if kl = 24 then String.sub key 16 8 else k1 in let c1 = new Block.des_encrypt k1 and c2 = new Block.des_decrypt k2 and c3 = new Block.des_encrypt k3 in wipe_string k1; wipe_string k2; wipe_string k3; new Block.mac_final_triple ?iv ?pad c1 c2 c3 end (* Random number generation *) module Random = struct class type rng = object method random_bytes: string -> int -> int -> unit method wipe: unit end let string rng len = let res = String.create len in rng#random_bytes res 0 len; res type system_rng_handle external get_system_rng: unit -> system_rng_handle = "caml_get_system_rng" external close_system_rng: system_rng_handle -> unit = "caml_close_system_rng" external system_rng_random_bytes: system_rng_handle -> string -> int -> int -> bool = "caml_system_rng_random_bytes" class system_rng = object(self) val h = get_system_rng () method random_bytes buf ofs len = if ofs < 0 || len < 0 || ofs > String.length buf - len then invalid_arg "random_bytes"; if system_rng_random_bytes h buf ofs len then () else raise(Error Entropy_source_closed) method wipe = close_system_rng h end let system_rng () = try new system_rng with Not_found -> raise(Error No_entropy_source) class device_rng filename = object(self) val fd = Unix.openfile filename [Unix.O_RDONLY] 0 method random_bytes buf ofs len = if len > 0 then begin let n = Unix.read fd buf ofs len in if n = 0 then raise(Error Entropy_source_closed); if n < len then self#random_bytes buf (ofs + n) (len - n) end method wipe = Unix.close fd end let device_rng filename = new device_rng filename class egd_rng socketname = object(self) val fd = let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in try Unix.connect s (Unix.ADDR_UNIX socketname); s with exn -> Unix.close s; raise exn method random_bytes buf ofs len = if len > 0 then begin let reqd = min 255 len in let msg = String.create 2 in msg.[0] <- '\002'; (* read entropy blocking *) msg.[1] <- Char.chr reqd; ignore (Unix.write fd msg 0 2); let rec do_read ofs len = if len > 0 then begin let r = Unix.read fd buf ofs len in if r = 0 then raise(Error Entropy_source_closed); do_read (ofs + r) (len - r) end in do_read ofs reqd; if reqd < len then self#random_bytes buf (ofs + reqd) (len - reqd) end method wipe = Unix.close fd end let egd_rng socketname = new egd_rng socketname class no_rng = object method random_bytes (buf:string) (ofs:int) (len:int) : unit = raise (Error No_entropy_source) method wipe = () end let secure_rng = try new system_rng with Not_found -> try new device_rng "/dev/random" with Unix.Unix_error(_,_,_) -> try new egd_rng (Sys.getenv "EGD_SOCKET") with Not_found | Unix.Unix_error(_,_,_) -> try new egd_rng (Filename.concat (Sys.getenv "HOME") ".gnupg/entropy") with Not_found | Unix.Unix_error(_,_,_) -> try new egd_rng "/var/run/egd-pool" with Unix.Unix_error(_,_,_) -> try new egd_rng "/dev/egd-pool" with Unix.Unix_error(_,_,_) -> try new egd_rng "/etc/egd-pool" with Unix.Unix_error(_,_,_) -> new no_rng class pseudo_rng seed = let _ = if String.length seed < 16 then raise (Error Seed_too_short) in object (self) val cipher = new Block.cbc_encrypt (new Block.aes_encrypt (String.sub seed 0 16)) val state = let s = String.make 71 '\001' in String.blit seed 0 s 0 (min 55 (String.length seed)); s val obuf = String.create 16 val mutable opos = 16 method random_bytes buf ofs len = if len > 0 then begin if opos >= 16 then begin (* Clock the lagged Fibonacci generator 16 times *) for i = 55 to 70 do state.[i] <- Char.unsafe_chr(Char.code state.[i-55] + Char.code state.[i-24]) done; (* Encrypt resulting 16 bytes *) cipher#transform state 55 obuf 0; (* Shift Fibonacci generator by 16 bytes *) String.blit state 16 state 0 55; (* We have 16 fresh bytes of pseudo-random data *) opos <- 0 end; let r = min (16 - opos) len in String.blit obuf opos buf ofs r; opos <- opos + r; if r < len then self#random_bytes buf (ofs + r) (len - r) end method wipe = wipe_string obuf; wipe_string seed end let pseudo_rng seed = new pseudo_rng seed end (* Arithmetic on big integers *) module Bn = struct let zero = nat_of_int 0 let one = nat_of_int 1 let compare a b = compare_nat a 0 (length_nat a) b 0 (length_nat b) let num_digits a = num_digits_nat a 0 (length_nat a) let num_bits a = let ndigits = num_digits a in ndigits * length_of_digit - num_leading_zero_bits_in_digit a (ndigits-1) let copy a = copy_nat a 0 (num_digits a) let add a b = let la = num_digits a and lb = num_digits b in if la >= lb then begin let r = create_nat (la + 1) in blit_nat r 0 a 0 la; set_digit_nat r la 0; ignore(add_nat r 0 (la + 1) b 0 lb 0); r end else begin let r = create_nat (lb + 1) in blit_nat r 0 b 0 lb; set_digit_nat r lb 0; ignore(add_nat r 0 (lb + 1) a 0 la 0); r end let sub a b = let la = num_digits a and lb = num_digits b in let lr = max la lb in let r = create_nat lr in blit_nat r 0 a 0 la; set_to_zero_nat r la (lr - la); let carry = sub_nat r 0 lr b 0 lb 1 in assert (carry = 1); r let sub_mod a b c = let la = num_digits a and lb = num_digits b and lc = num_digits c in let lr = max (max la lb) lc in let r = create_nat lr in blit_nat r 0 a 0 la; set_to_zero_nat r la (lr - la); if sub_nat r 0 lr b 0 lb 1 = 0 then ignore (add_nat r 0 lr c 0 lc 0); r let mult a b = let la = num_digits a and lb = num_digits b in let r = make_nat (la + lb) in ignore(mult_nat r 0 (la + lb) a 0 la b 0 lb); r let mult_add a b c = let la = num_digits a and lb = num_digits b and lc = num_digits c in let lr = 1 + max (la + lb) lc in let r = create_nat lr in blit_nat r 0 c 0 lc; set_to_zero_nat r lc (lr - lc); ignore(mult_nat r 0 lr a 0 la b 0 lb); r let mod_ a b = let la = num_digits a and lb = num_digits b in let ltmp = max la lb + 1 in let tmp = create_nat ltmp in blit_nat tmp 0 a 0 la; set_to_zero_nat tmp la (ltmp - la); div_nat tmp 0 ltmp b 0 lb; let lres = num_digits_nat tmp 0 lb in let res = create_nat lres in blit_nat res 0 tmp 0 lres; wipe_nat tmp; res let quo_mod a b = let la = num_digits a and lb = num_digits b in let ltmp = max la lb + 1 in let tmp = create_nat ltmp in blit_nat tmp 0 a 0 la; set_to_zero_nat tmp la (ltmp - la); div_nat tmp 0 ltmp b 0 lb; let lq = num_digits_nat tmp lb (ltmp - lb) in let lm = num_digits_nat tmp 0 lb in let q = create_nat lq in let m = create_nat lm in blit_nat q 0 tmp lb lq; blit_nat m 0 tmp 0 lm; wipe_nat tmp; (q, m) let relative_prime a b = let la = num_digits a and lb = num_digits b in let ltmp = max la lb in let tmp = create_nat ltmp in blit_nat tmp 0 a 0 la; set_to_zero_nat tmp la (ltmp - la); let lgcd = gcd_nat tmp 0 la b 0 lb in let res = lgcd = 1 && is_digit_int tmp 0 && nth_digit_nat tmp 0 = 1 in wipe_nat tmp; res (* Compute a^b mod c. Must have [a < c]. *) let mod_power a b c = let la = num_digits a and lb = num_digits b and lc = num_digits c in let res = make_nat lc in set_digit_nat res 0 1; (* res = 1 initially *) let prod = create_nat (lc + lc + 1) in let window = create_nat 2 in (* For each bit of b, from MSB to LSB... *) for i = lb - 1 downto 0 do blit_nat window 0 b i 1; for j = length_of_digit downto 1 do (* res <- res ^ 2 mod c *) set_to_zero_nat prod 0 (lc + lc + 1); ignore(square_nat prod 0 (lc + lc) res 0 lc); (* prod[lc+lc] = 0 < c[lc-1] != 0 *) div_nat prod 0 (lc + lc + 1) c 0 lc; (* remainder is in (prod,0,lc) *) blit_nat res 0 prod 0 lc; (* shift window[0] left 1 bit and test carry out; that is, test bit number j of b[i] *) shift_left_nat window 0 1 window 1 1; if is_digit_odd window 1 then begin (* res <- res * a mod c *) set_to_zero_nat prod 0 (lc + la + 1); ignore(mult_nat prod 0 (lc + la) res 0 lc a 0 la); (* prod[lc+la] = 0 < c[lc-1] != 0 *) div_nat prod 0 (lc + la + 1) c 0 lc; (* remainder in (prod,0,lc) *) blit_nat res 0 prod 0 lc; end done done; wipe_nat prod; wipe_nat window; res (* Modular exponentiation via the Chinese Remainder Theorem. Compute a ^ d mod pq, where d is defined by dp = d mod (p-1) and dq = d mod (q-1). qinv is q^-1 mod p. Formula: mp = (a mod p)^dp mod p mq = (a mod q)^dq mod q m = ((((mp - mq) mod p) * qInv) mod p) * q + mq *) let mod_power_CRT a p q dp dq qinv = let amodp = mod_ a p and amodq = mod_ a q in let mp = mod_power amodp dp p and mq = mod_power amodq dq q in let diff = sub_mod mp mq p in let diff_qinv = mult diff qinv in let diff_qinv_mod_p = mod_ diff_qinv p in let res = mult_add q diff_qinv_mod_p mq in wipe_nat amodp; wipe_nat amodq; wipe_nat mp; wipe_nat mq; wipe_nat diff; wipe_nat diff_qinv; wipe_nat diff_qinv_mod_p; res (* Modular inverse. Return u such that n.u mod m = 1, or raise Not_invertible if no such u exists (i.e. gcd(n,m) <> 1). Must have [n < m]. *) exception Not_invertible let mod_inv b c = let rec extended_euclid u1 v1 u3 v3 sign = if compare v3 zero = 0 then if compare u3 one = 0 then begin wipe_nat v1; if sign < 0 then sub c u1 else u1 end else begin wipe_nat u1; wipe_nat v1; wipe_nat u3; raise Not_invertible end else begin let (q,r) = quo_mod u3 v3 in let t1 = mult_add q v1 u1 in wipe_nat u3; wipe_nat q; wipe_nat u1; extended_euclid v1 t1 v3 r (-sign) end in extended_euclid (nat_of_int 1) (nat_of_int 0) (copy b) (copy c) 1 end (* Conversions between nats and strings *) let bytes_per_digit = length_of_digit / 8 let nat_of_bytes s = let l = String.length s in if l = 0 then make_nat 1 else begin let n = make_nat ((l + bytes_per_digit - 1) / bytes_per_digit) in let tmp = create_nat 2 in for i = 0 to l - 1 do let pos = i / bytes_per_digit and shift = (i mod bytes_per_digit) * 8 in set_digit_nat tmp 0 (Char.code s.[l-1-i]); shift_left_nat tmp 0 1 tmp 1 shift; lor_digit_nat n pos tmp 0 done; wipe_nat tmp; n end let bytes_of_nat ?numbits n = let nbits = Bn.num_bits n in begin match numbits with None -> () | Some n -> if nbits > n then raise(Error Number_too_long) end; let l = ((nbits + 7) / 8) in let s = String.create ((nbits + 7) / 8) in let tmp = create_nat 2 in for i = 0 to l - 1 do let pos = i / bytes_per_digit and shift = (i mod bytes_per_digit) * 8 in blit_nat tmp 0 n pos 1; shift_right_nat tmp 0 1 tmp 1 shift; s.[l-1-i] <- Char.unsafe_chr(nth_digit_nat tmp 0) done; wipe_nat tmp; match numbits with None -> s | Some n -> let l' = ((n + 7) / 8) in if l = l' then s else String.make (l' - l) '\000' ^ s (* RSA operations *) module RSA = struct type key = { size: int; n: string; e: string; d: string; p: string; q: string; dp: string; dq: string; qinv: string } let wipe_key k = wipe_string k.n; wipe_string k.e; wipe_string k.d; wipe_string k.p; wipe_string k.q; wipe_string k.dp; wipe_string k.dq; wipe_string k.qinv let encrypt key msg = let msg = nat_of_bytes msg in let n = nat_of_bytes key.n in let e = nat_of_bytes key.e in if Bn.compare msg n >= 0 then raise (Error Message_too_long); let r = Bn.mod_power msg e n in let s = bytes_of_nat ~numbits:key.size r in wipe_nat msg; wipe_nat n; wipe_nat e; wipe_nat r; s let unwrap_signature = encrypt let decrypt key msg = let msg = nat_of_bytes msg in let n = nat_of_bytes key.n in let d = nat_of_bytes key.d in if Bn.compare msg n >= 0 then raise (Error Message_too_long); let r = Bn.mod_power msg d n in let s = bytes_of_nat ~numbits:key.size r in wipe_nat msg; wipe_nat n; wipe_nat d; wipe_nat r; s let sign = decrypt let decrypt_CRT key msg = let msg = nat_of_bytes msg in let n = nat_of_bytes key.n in let p = nat_of_bytes key.p in let q = nat_of_bytes key.q in let dp = nat_of_bytes key.dp in let dq = nat_of_bytes key.dq in let qinv = nat_of_bytes key.qinv in if Bn.compare msg n >= 0 then raise (Error Message_too_long); let r = Bn.mod_power_CRT msg p q dp dq qinv in let s = bytes_of_nat ~numbits:key.size r in wipe_nat msg; wipe_nat n; wipe_nat p; wipe_nat q; wipe_nat dp; wipe_nat dq; wipe_nat qinv; wipe_nat r; s let sign_CRT = decrypt_CRT let random_nat ?(rng = Random.secure_rng) ?(lowbits = 0) numbits = let numdigits = ((numbits + length_of_digit - 1) / length_of_digit) in let buf = String.create (numdigits * length_of_digit / 8) in rng#random_bytes buf 0 (String.length buf); (* move them to a nat *) let n = nat_of_bytes buf in wipe_string buf; let tmp = create_nat 2 in (* adjust low digit of n if requested *) if lowbits <> 0 then begin set_digit_nat tmp 0 lowbits; lor_digit_nat n 0 tmp 0 end; (* adjust high digit of n so that it is exactly numbits long *) shift_left_nat tmp 0 1 tmp 1 ((numbits - 1) land (length_of_digit - 1)); ignore(decr_nat tmp 0 1 0); land_digit_nat n (numdigits - 1) tmp 0; ignore(incr_nat tmp 0 1 1); lor_digit_nat n (numdigits - 1) tmp 0; (* done *) n let small_primes = [ 2; 3; 5; 7; 11; 13; 17; 19; 23; 29; 31; 37; 41; 43; 47; 53; 59; 61; 67; 71; 73; 79; 83; 89; 97; 101; 103; 107; 109; 113; 127; 131; 137; 139; 149; 151; 157; 163; 167; 173; 179; 181; 191; 193; 197; 199; 211; 223; 227; 229; 233; 239; 241; 251; 257; 263; 269; 271; 277; 281; 283; 293; 307; 311; 313; 317; 331; 337; 347; 349; 353; 359; 367; 373; 379; 383; 389; 397; 401; 409; 419; 421; 431; 433; 439; 443; 449; 457; 461; 463; 467; 479; 487; 491; 499; 503; 509; 521; 523; 541; 547; 557; 563; 569; 571; 577; 587; 593; 599; 601; 607; 613; 617; 619; 631; 641; 643; 647; 653; 659; 661; 673; 677; 683; 691; 701; 709; 719; 727; 733; 739; 743; 751; 757; 761; 769; 773; 787; 797; 809; 811; 821; 823; 827; 829; 839; 853; 857; 859; 863; 877; 881; 883; 887; 907; 911; 919; 929; 937; 941; 947; 953; 967; 971; 977; 983; 991; 997; 1009; 1013; 1019; 1021; 1031; 1033; 1039; 1049; 1051; 1061; 1063; 1069; 1087; 1091; 1093; 1097; 1103; 1109; 1117; 1123; 1129; 1151; 1153; 1163; 1171; 1181; 1187; 1193; 1201; 1213; 1217; 1223; 1229; 1231; 1237; 1249; 1259; 1277; 1279; 1283; 1289; 1291; 1297; 1301; 1303; 1307; 1319; 1321; 1327; 1361; 1367; 1373; 1381; 1399; 1409; 1423; 1427; 1429; 1433; 1439; 1447; 1451; 1453; 1459; 1471; 1481; 1483; 1487; 1489; 1493; 1499; 1511; 1523; 1531; 1543; 1549; 1553; 1559; 1567; 1571; 1579; 1583; 1597; 1601; 1607; 1609; 1613; 1619; 1621; 1627; 1637; 1657; 1663; 1667; 1669; 1693; 1697; 1699; 1709; 1721; 1723; 1733; 1741; 1747; 1753; 1759; 1777; 1783; 1787; 1789; 1801; 1811; 1823; 1831; 1847; 1861; 1867; 1871; 1873; 1877; 1879; 1889; 1901; 1907; 1913; 1931; 1933; 1949; 1951; 1973; 1979; 1987; 1993; 1997; 1999; 2003; 2011; 2017; 2027; 2029; 2039; 2053; 2063; 2069; 2081; 2083; 2087; 2089; 2099; 2111; 2113; 2129; 2131; 2137; 2141; 2143; 2153; 2161; 2179; 2203; 2207; 2213; 2221; 2237; 2239; 2243; 2251; 2267; 2269; 2273; 2281; 2287; 2293; 2297; 2309; 2311; 2333; 2339; 2341; 2347; 2351; 2357; 2371; 2377; 2381; 2383; 2389; 2393; 2399; 2411; 2417; 2423; 2437; 2441; 2447; 2459; 2467; 2473; 2477; 2503; 2521; 2531; 2539; 2543; 2549; 2551; 2557; 2579; 2591; 2593; 2609; 2617; 2621; 2633; 2647; 2657; 2659; 2663; 2671; 2677; 2683; 2687; 2689; 2693; 2699; 2707; 2711; 2713; 2719; 2729; 2731; 2741; 2749; 2753; 2767; 2777; 2789; 2791; 2797; 2801; 2803; 2819; 2833; 2837; 2843; 2851; 2857; 2861; 2879; 2887; 2897; 2903; 2909; 2917; 2927; 2939; 2953; 2957; 2963; 2969; 2971; 2999; 3001; 3011; 3019; 3023; 3037; 3041; 3049; 3061; 3067; 3079; 3083; 3089; 3109; 3119; 3121; 3137; 3163; 3167; 3169; 3181; 3187; 3191; 3203; 3209; 3217; 3221; 3229; 3251; 3253; 3257; 3259; 3271; 3299; 3301; 3307; 3313; 3319; 3323; 3329; 3331; 3343; 3347; 3359; 3361; 3371; 3373; 3389; 3391; 3407; 3413; 3433; 3449; 3457; 3461; 3463; 3467; 3469; 3491; 3499; 3511; 3517; 3527; 3529; 3533; 3539; 3541; 3547; 3557; 3559; 3571; 3581; 3583; 3593; 3607; 3613; 3617; 3623; 3631; 3637; 3643; 3659; 3671; 3673; 3677; 3691; 3697; 3701; 3709; 3719; 3727; 3733; 3739; 3761; 3767; 3769; 3779; 3793; 3797; 3803; 3821; 3823; 3833; 3847; 3851; 3853; 3863; 3877; 3881; 3889; 3907; 3911; 3917; 3919; 3923; 3929; 3931; 3943; 3947; 3967; 3989; 4001; 4003; 4007; 4013; 4019; 4021; 4027; 4049; 4051; 4057; 4073; 4079; 4091; 4093; 4099; 4111; 4127; 4129; 4133; 4139; 4153; 4157; 4159; 4177; 4201; 4211; 4217; 4219; 4229; 4231; 4241; 4243; 4253; 4259; 4261; 4271; 4273; 4283; 4289; 4297; 4327; 4337; 4339; 4349; 4357; 4363; 4373; 4391; 4397; 4409; 4421; 4423; 4441; 4447; 4451; 4457; 4463; 4481; 4483; 4493; 4507; 4513; 4517; 4519; 4523; 4547; 4549; 4561; 4567; 4583; 4591; 4597; 4603; 4621; 4637; 4639; 4643; 4649; 4651; 4657; 4663; 4673; 4679; 4691; 4703; 4721; 4723; 4729; 4733; 4751; 4759; 4783; 4787; 4789; 4793; 4799; 4801; 4813; 4817; 4831; 4861; 4871; 4877; 4889; 4903; 4909; 4919; 4931; 4933; 4937; 4943; 4951; 4957; 4967; 4969; 4973; 4987; 4993; 4999; 5003; 5009; 5011; 5021; 5023; 5039; 5051; 5059; 5077; 5081; 5087; 5099; 5101; 5107; 5113; 5119; 5147; 5153; 5167; 5171; 5179; 5189; 5197; 5209; 5227; 5231; 5233; 5237; 5261; 5273; 5279; 5281; 5297; 5303; 5309; 5323; 5333; 5347; 5351; 5381; 5387; 5393; 5399; 5407; 5413; 5417; 5419; 5431; 5437; 5441; 5443; 5449; 5471; 5477; 5479; 5483; 5501; 5503; 5507; 5519; 5521; 5527; 5531; 5557; 5563; 5569; 5573; 5581; 5591; 5623; 5639; 5641; 5647; 5651; 5653; 5657; 5659; 5669; 5683; 5689; 5693; 5701; 5711; 5717; 5737; 5741; 5743; 5749; 5779; 5783; 5791; 5801; 5807; 5813; 5821; 5827; 5839; 5843; 5849; 5851; 5857; 5861; 5867; 5869; 5879; 5881; 5897; 5903; 5923; 5927; 5939; 5953; 5981; 5987; 6007; 6011; 6029; 6037; 6043; 6047; 6053; 6067; 6073; 6079; 6089; 6091; 6101; 6113; 6121; 6131; 6133; 6143; 6151; 6163; 6173; 6197; 6199; 6203; 6211; 6217; 6221; 6229; 6247; 6257; 6263; 6269; 6271; 6277; 6287; 6299; 6301; 6311; 6317; 6323; 6329; 6337; 6343; 6353; 6359; 6361; 6367; 6373; 6379; 6389; 6397; 6421; 6427; 6449; 6451; 6469; 6473; 6481; 6491; 6521; 6529; 6547; 6551; 6553; 6563; 6569; 6571; 6577; 6581; 6599; 6607; 6619; 6637; 6653; 6659; 6661; 6673; 6679; 6689; 6691; 6701; 6703; 6709; 6719; 6733; 6737; 6761; 6763; 6779; 6781; 6791; 6793; 6803; 6823; 6827; 6829; 6833; 6841; 6857; 6863; 6869; 6871; 6883; 6899; 6907; 6911; 6917; 6947; 6949; 6959; 6961; 6967; 6971; 6977; 6983; 6991; 6997; 7001; 7013; 7019; 7027; 7039; 7043; 7057; 7069; 7079; 7103; 7109; 7121; 7127; 7129; 7151; 7159; 7177; 7187; 7193; 7207; 7211; 7213; 7219; 7229; 7237; 7243; 7247; 7253; 7283; 7297; 7307; 7309; 7321; 7331; 7333; 7349; 7351; 7369; 7393; 7411; 7417; 7433; 7451; 7457; 7459; 7477; 7481; 7487; 7489; 7499; 7507; 7517; 7523; 7529; 7537; 7541; 7547; 7549; 7559; 7561; 7573; 7577; 7583; 7589; 7591; 7603; 7607; 7621; 7639; 7643; 7649; 7669; 7673; 7681; 7687; 7691; 7699; 7703; 7717; 7723; 7727; 7741; 7753; 7757; 7759; 7789; 7793; 7817; 7823; 7829; 7841; 7853; 7867; 7873; 7877; 7879; 7883; 7901; 7907; 7919; 7927; 7933; 7937; 7949; 7951; 7963; 7993; 8009; 8011; 8017; 8039; 8053; 8059; 8069; 8081; 8087; 8089; 8093; 8101; 8111; 8117; 8123; 8147; 8161; 8167; 8171; 8179; 8191 ] let moduli_small_primes n = let ln = Bn.num_digits n in let dend = create_nat (ln + 1) and dsor = create_nat 1 and quot = create_nat ln and rem = create_nat 1 in let res = List.map (fun p -> (* Compute m = n mod p *) blit_nat dend 0 n 0 ln; set_digit_nat dend ln 0; set_digit_nat dsor 0 p; div_digit_nat quot 0 rem 0 dend 0 (ln + 1) dsor 0; nth_digit_nat rem 0) small_primes in wipe_nat dend; wipe_nat dsor; wipe_nat quot; wipe_nat rem; res let is_divisible_by_small_prime delta remainders = List.exists2 (fun p m -> (m + delta) mod p = 0) small_primes remainders let pseudoprime_test_values = [2;3;5;7;11;13;17;19] let is_pseudoprime p = let p1 = Bn.sub p Bn.one in let res = List.for_all (fun x -> let q = Bn.mod_power (nat_of_int x) p1 p in let r = Bn.compare q Bn.one in wipe_nat q; r = 0) pseudoprime_test_values in wipe_nat p1; res let rec random_prime ?rng numbits = (* Generate random odd number *) let n = random_nat ?rng ~lowbits:1 numbits in (* Precompute moduli with small primes *) let moduli = moduli_small_primes n in (* Search from n *) let rec find_prime delta = if delta < 0 then (* arithmetic overflow in incrementing delta *) random_prime ?rng numbits else if is_divisible_by_small_prime delta moduli then find_prime (delta + 2) else begin let n' = Bn.add n (nat_of_int delta) in if is_pseudoprime n' then if Bn.num_bits n' = numbits then begin wipe_nat n; n' end else begin (* overflow in adding delta to n *) wipe_nat n; wipe_nat n'; random_prime ?rng numbits end else find_prime (delta + 2) end in find_prime 0 let new_key ?rng ?e numbits = if numbits < 32 || numbits land 1 > 0 then raise(Error Wrong_key_size); let numbits2 = numbits / 2 in (* Generate primes p, q with numbits / 2 digits. If fixed exponent e, make sure gcd(p-1,e) = 1 and gcd(q-1,e) = 1. *) let rec gen_factor nbits = let n = random_prime ?rng nbits in match e with None -> n | Some e -> if Bn.relative_prime (Bn.sub n Bn.one) (nat_of_int e) then n else gen_factor nbits in (* Make sure p > q *) let rec gen_factors nbits = let p = gen_factor nbits and q = gen_factor nbits in let cmp = Bn.compare p q in if cmp = 0 then gen_factors nbits else if cmp < 0 then (q, p) else (p, q) in let (p, q) = gen_factors numbits2 in (* p1 = p - 1 and q1 = q - 1 *) let p1 = Bn.sub p Bn.one and q1 = Bn.sub q Bn.one in (* If no fixed exponent specified, generate random exponent e such that gcd(p-1,e) = 1 and gcd(q-1,e) = 1 *) let e = match e with Some e -> nat_of_int e | None -> let rec gen_exponent () = let n = random_nat ?rng numbits in if Bn.relative_prime n p1 && Bn.relative_prime n q1 then n else gen_exponent () in gen_exponent () in (* n = pq *) let n = Bn.mult p q in (* d = e^-1 mod (p-1)(q-1) *) let d = Bn.mod_inv e (Bn.mult p1 q1) in (* dp = d mod p-1 and dq = d mod q-1 *) let dp = Bn.mod_ d p1 and dq = Bn.mod_ d q1 in (* qinv = q^-1 mod p *) let qinv = Bn.mod_inv q p in (* Build key *) let res = { size = numbits; n = bytes_of_nat ~numbits:numbits n; e = bytes_of_nat ~numbits:numbits e; d = bytes_of_nat ~numbits:numbits d; p = bytes_of_nat ~numbits:numbits2 p; q = bytes_of_nat ~numbits:numbits2 q; dp = bytes_of_nat ~numbits:numbits2 dp; dq = bytes_of_nat ~numbits:numbits2 dq; qinv = bytes_of_nat ~numbits:numbits2 qinv } in wipe_nat n; wipe_nat e; wipe_nat d; wipe_nat p; wipe_nat q; wipe_nat p1; wipe_nat q1; wipe_nat dp; wipe_nat dq; wipe_nat qinv; res end (* Diffie-Hellman key agreement *) module DH = struct type parameters = { p: string; g: string; privlen: int } let new_parameters ?(rng = Random.secure_rng) ?(privlen = 160) numbits = if numbits < 32 || numbits <= privlen then raise(Error Wrong_key_size); let np = RSA.random_prime ~rng numbits in let rec find_generator () = let g = RSA.random_nat ~rng (numbits - 1) in if Bn.compare g Bn.one <= 0 then find_generator() else g in let ng = find_generator () in { p = bytes_of_nat ~numbits np; g = bytes_of_nat ~numbits ng; privlen = privlen } type private_secret = nat let private_secret ?(rng = Random.secure_rng) params = RSA.random_nat ~rng params.privlen let message params privsec = bytes_of_nat ~numbits:(String.length params.p * 8) (Bn.mod_power (nat_of_bytes params.g) privsec (nat_of_bytes params.p)) let shared_secret params privsec othermsg = let res = bytes_of_nat ~numbits:(String.length params.p * 8) (Bn.mod_power (nat_of_bytes othermsg) privsec (nat_of_bytes params.p)) in wipe_nat privsec; res let derive_key ?(diversification = "") sharedsec numbytes = let result = String.create numbytes in let rec derive pos counter = if pos < numbytes then begin let h = hash_string (Hash.sha1()) (diversification ^ sharedsec ^ string_of_int counter) in String.blit h 0 result pos (min (String.length h) (numbytes - pos)); wipe_string h; derive (pos + String.length h) (counter + 1) end in derive 0 1; result end (* Base64 encoding *) module Base64 = struct let base64_conv_table = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" class encode multiline padding = object (self) method input_block_size = 1 method output_block_size = 1 inherit buffered_output 256 as output_buffer val ibuf = String.create 3 val mutable ipos = 0 val mutable ocolumn = 0 method put_char c = ibuf.[ipos] <- c; ipos <- ipos + 1; if ipos = 3 then begin let b0 = Char.code ibuf.[0] and b1 = Char.code ibuf.[1] and b2 = Char.code ibuf.[2] in self#ensure_capacity 4; obuf.[oend] <- base64_conv_table.[b0 lsr 2]; obuf.[oend+1] <- base64_conv_table.[(b0 land 3) lsl 4 + (b1 lsr 4)]; obuf.[oend+2] <- base64_conv_table.[(b1 land 15) lsl 2 + (b2 lsr 6)]; obuf.[oend+3] <- base64_conv_table.[b2 land 63]; oend <- oend + 4; ipos <- 0; ocolumn <- ocolumn + 4; if multiline && ocolumn >= 72 then begin self#ensure_capacity 1; obuf.[oend] <- '\n'; oend <- oend + 1; ocolumn <- 0 end end method put_substring s ofs len = for i = ofs to ofs + len - 1 do self#put_char s.[i] done method put_string s = self#put_substring s 0 (String.length s) method put_byte b = self#put_char (Char.chr b) method flush : unit = raise (Error Wrong_data_length) method finish = begin match ipos with 1 -> self#ensure_capacity 2; let b0 = Char.code ibuf.[0] in obuf.[oend] <- base64_conv_table.[b0 lsr 2]; obuf.[oend+1] <- base64_conv_table.[(b0 land 3) lsl 4]; oend <- oend + 2 | 2 -> self#ensure_capacity 3; let b0 = Char.code ibuf.[0] and b1 = Char.code ibuf.[1] in obuf.[oend] <- base64_conv_table.[b0 lsr 2]; obuf.[oend+1] <- base64_conv_table.[(b0 land 3) lsl 4 + (b1 lsr 4)]; obuf.[oend+2] <- base64_conv_table.[(b1 land 15) lsl 2]; oend <- oend + 3 | _ -> () end; if multiline or padding then begin let num_equals = match ipos with 1 -> 2 | 2 -> 1 | _ -> 0 in self#ensure_capacity num_equals; String.fill obuf oend num_equals '='; oend <- oend + num_equals end; if multiline && ocolumn > 0 then begin self#ensure_capacity 1; obuf.[oend] <- '\n'; oend <- oend + 1 end; ocolumn <- 0 method wipe = wipe_string ibuf; output_buffer#wipe end let encode_multiline () = new encode true true let encode_compact () = new encode false false let encode_compact_pad () = new encode false true let base64_decode_char c = match c with 'A' .. 'Z' -> Char.code c - 65 | 'a' .. 'z' -> Char.code c - 97 + 26 | '0' .. '9' -> Char.code c - 48 + 52 | '+' -> 62 | '/' -> 63 | ' '|'\t'|'\n'|'\r' -> -1 | _ -> raise (Error Bad_encoding) class decode = object (self) inherit buffered_output 256 as output_buffer method input_block_size = 1 method output_block_size = 1 val ibuf = Array.create 4 0 val mutable ipos = 0 val mutable finished = false method put_char c = if c = '=' then finished <- true else begin let n = base64_decode_char c in if n >= 0 then begin if finished then raise(Error Bad_encoding); ibuf.(ipos) <- n; ipos <- ipos + 1; if ipos = 4 then begin self#ensure_capacity 3; obuf.[oend] <- Char.chr(ibuf.(0) lsl 2 + ibuf.(1) lsr 4); obuf.[oend+1] <- Char.chr((ibuf.(1) land 15) lsl 4 + ibuf.(2) lsr 2); obuf.[oend+2] <- Char.chr((ibuf.(2) land 3) lsl 6 + ibuf.(3)); oend <- oend + 3; ipos <- 0 end end end method put_substring s ofs len = for i = ofs to ofs + len - 1 do self#put_char s.[i] done method put_string s = self#put_substring s 0 (String.length s) method put_byte b = self#put_char (Char.chr b) method flush : unit = raise (Error Wrong_data_length) method finish = finished <- true; match ipos with | 1 -> raise(Error Bad_encoding) | 2 -> self#ensure_capacity 1; obuf.[oend] <- Char.chr(ibuf.(0) lsl 2 + ibuf.(1) lsr 4); oend <- oend + 1 | 3 -> self#ensure_capacity 2; obuf.[oend] <- Char.chr(ibuf.(0) lsl 2 + ibuf.(1) lsr 4); obuf.[oend+1] <- Char.chr((ibuf.(1) land 15) lsl 4 + ibuf.(2) lsr 2); oend <- oend + 2 | _ -> () method wipe = Array.fill ibuf 0 4 0; output_buffer#wipe end let decode () = new decode end (* Hexadecimal encoding *) module Hexa = struct let hex_conv_table = "0123456789abcdef" class encode = object (self) method input_block_size = 1 method output_block_size = 1 inherit buffered_output 256 as output_buffer method put_byte b = self#ensure_capacity 2; obuf.[oend] <- hex_conv_table.[b lsr 4]; obuf.[oend + 1] <- hex_conv_table.[b land 0xF]; oend <- oend + 2 method put_char c = self#put_byte (Char.code c) method put_substring s ofs len = for i = ofs to ofs + len - 1 do self#put_char s.[i] done method put_string s = self#put_substring s 0 (String.length s) method flush = () method finish = () method wipe = output_buffer#wipe end let encode () = new encode let hex_decode_char c = match c with | '0' .. '9' -> Char.code c - 48 | 'A' .. 'F' -> Char.code c - 65 + 10 | 'a' .. 'f' -> Char.code c - 97 + 10 | ' '|'\t'|'\n'|'\r' -> -1 | _ -> raise (Error Bad_encoding) class decode = object (self) inherit buffered_output 256 as output_buffer method input_block_size = 1 method output_block_size = 1 val ibuf = Array.create 2 0 val mutable ipos = 0 method put_char c = let n = hex_decode_char c in if n >= 0 then begin ibuf.(ipos) <- n; ipos <- ipos + 1; if ipos = 2 then begin self#ensure_capacity 1; obuf.[oend] <- Char.chr(ibuf.(0) lsl 4 lor ibuf.(1)); oend <- oend + 1; ipos <- 0 end end method put_substring s ofs len = for i = ofs to ofs + len - 1 do self#put_char s.[i] done method put_string s = self#put_substring s 0 (String.length s) method put_byte b = self#put_char (Char.chr b) method flush = if ipos <> 0 then raise(Error Wrong_data_length) method finish = if ipos <> 0 then raise(Error Bad_encoding) method wipe = Array.fill ibuf 0 2 0; output_buffer#wipe end let decode () = new decode end (* Compression *) module Zlib = struct type stream type flush_command = Z_NO_FLUSH | Z_SYNC_FLUSH | Z_FULL_FLUSH | Z_FINISH external deflate_init: int -> bool -> stream = "caml_zlib_deflateInit" external deflate: stream -> string -> int -> int -> string -> int -> int -> flush_command -> bool * int * int = "caml_zlib_deflate_bytecode" "caml_zlib_deflate" external deflate_end: stream -> unit = "caml_zlib_deflateEnd" external inflate_init: bool -> stream = "caml_zlib_inflateInit" external inflate: stream -> string -> int -> int -> string -> int -> int -> flush_command -> bool * int * int = "caml_zlib_inflate_bytecode" "caml_zlib_inflate" external inflate_end: stream -> unit = "caml_zlib_inflateEnd" class compress level = object(self) val zs = deflate_init level false inherit buffered_output 512 as output_buffer method input_block_size = 1 method output_block_size = 1 method put_substring src ofs len = if len > 0 then begin self#ensure_capacity 256; let (_, used_in, used_out) = deflate zs src ofs len obuf oend (String.length obuf - oend) Z_NO_FLUSH in oend <- oend + used_out; if used_in < len then self#put_substring src (ofs + used_in) (len - used_in) end method put_string s = self#put_substring s 0 (String.length s) method put_char c = self#put_string (String.make 1 c) method put_byte b = self#put_char (Char.chr b) method flush = self#ensure_capacity 256; let (_, _, used_out) = deflate zs "" 0 0 obuf oend (String.length obuf - oend) Z_SYNC_FLUSH in oend <- oend + used_out; if oend = String.length obuf then self#flush method finish = self#ensure_capacity 256; let (finished, _, used_out) = deflate zs "" 0 0 obuf oend (String.length obuf - oend) Z_FINISH in oend <- oend + used_out; if finished then deflate_end zs else self#finish method wipe = output_buffer#wipe end let compress ?(level = 6) () = new compress level class uncompress = object(self) val zs = inflate_init false inherit buffered_output 512 as output_buffer method input_block_size = 1 method output_block_size = 1 method put_substring src ofs len = if len > 0 then begin self#ensure_capacity 256; let (finished, used_in, used_out) = inflate zs src ofs len obuf oend (String.length obuf - oend) Z_SYNC_FLUSH in oend <- oend + used_out; if used_in < len then begin if finished then raise(Error(Compression_error("Zlib.uncompress", "garbage at end of compressed data"))); self#put_substring src (ofs + used_in) (len - used_in) end end method put_string s = self#put_substring s 0 (String.length s) method put_char c = self#put_string (String.make 1 c) method put_byte b = self#put_char (Char.chr b) method flush = () method finish = let rec do_finish first_finish = self#ensure_capacity 256; let (finished, _, used_out) = inflate zs " " 0 (if first_finish then 1 else 0) obuf oend (String.length obuf - oend) Z_SYNC_FLUSH in oend <- oend + used_out; if not finished then do_finish false in do_finish true; inflate_end zs method wipe = output_buffer#wipe end let uncompress () = new uncompress end (* Utilities *) let xor_string src src_ofs dst dst_ofs len = if src_ofs < 0 || src_ofs + len > String.length src || dst_ofs < 0 || dst_ofs + len > String.length dst then invalid_arg "xor_string"; xor_string src src_ofs dst dst_ofs len let mod_power a b c = bytes_of_nat ~numbits:(String.length c * 8) (Bn.mod_power (nat_of_bytes a) (nat_of_bytes b) (nat_of_bytes c)) let mod_mult a b c = bytes_of_nat ~numbits:(String.length c * 8) (Bn.mod_ (Bn.mult (nat_of_bytes a) (nat_of_bytes b)) (nat_of_bytes c)) cryptokit-1.9/src/blowfish.h0000644000175000017500000000214611436706614015525 0ustar gildorgildor/* blowfish.h: Header file for blowfish.c Copyright (C) 1997 by Paul Kocher This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA See blowfish.c for more information about this file. */ typedef unsigned int u32; typedef struct { u32 P[16 + 2]; u32 S[4][256]; } BLOWFISH_CTX; void Blowfish_Init(BLOWFISH_CTX *ctx, unsigned char *key, int keyLen); void Blowfish_Encrypt(BLOWFISH_CTX *ctx, u32 *xl, u32 *xr); void Blowfish_Decrypt(BLOWFISH_CTX *ctx, u32 *xl, u32 *xr); cryptokit-1.9/src/rijndael-alg-fst.c0000644000175000017500000017426411436706614017041 0ustar gildorgildor/** * rijndael-alg-fst.c * * @version 3.0 (December 2000) * * Optimised ANSI C code for the Rijndael cipher (now AES) * * @author Vincent Rijmen * @author Antoon Bosselaers * @author Paulo Barreto * * This code is hereby placed in the public domain. * * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include #include #include "rijndael-alg-fst.h" /* Te0[x] = S [x].[02, 01, 01, 03]; Te1[x] = S [x].[03, 02, 01, 01]; Te2[x] = S [x].[01, 03, 02, 01]; Te3[x] = S [x].[01, 01, 03, 02]; Te4[x] = S [x].[01, 01, 01, 01]; Td0[x] = Si[x].[0e, 09, 0d, 0b]; Td1[x] = Si[x].[0b, 0e, 09, 0d]; Td2[x] = Si[x].[0d, 0b, 0e, 09]; Td3[x] = Si[x].[09, 0d, 0b, 0e]; Td4[x] = Si[x].[01, 01, 01, 01]; */ static const u32 Te0[256] = { 0xc66363a5U, 0xf87c7c84U, 0xee777799U, 0xf67b7b8dU, 0xfff2f20dU, 0xd66b6bbdU, 0xde6f6fb1U, 0x91c5c554U, 0x60303050U, 0x02010103U, 0xce6767a9U, 0x562b2b7dU, 0xe7fefe19U, 0xb5d7d762U, 0x4dababe6U, 0xec76769aU, 0x8fcaca45U, 0x1f82829dU, 0x89c9c940U, 0xfa7d7d87U, 0xeffafa15U, 0xb25959ebU, 0x8e4747c9U, 0xfbf0f00bU, 0x41adadecU, 0xb3d4d467U, 0x5fa2a2fdU, 0x45afafeaU, 0x239c9cbfU, 0x53a4a4f7U, 0xe4727296U, 0x9bc0c05bU, 0x75b7b7c2U, 0xe1fdfd1cU, 0x3d9393aeU, 0x4c26266aU, 0x6c36365aU, 0x7e3f3f41U, 0xf5f7f702U, 0x83cccc4fU, 0x6834345cU, 0x51a5a5f4U, 0xd1e5e534U, 0xf9f1f108U, 0xe2717193U, 0xabd8d873U, 0x62313153U, 0x2a15153fU, 0x0804040cU, 0x95c7c752U, 0x46232365U, 0x9dc3c35eU, 0x30181828U, 0x379696a1U, 0x0a05050fU, 0x2f9a9ab5U, 0x0e070709U, 0x24121236U, 0x1b80809bU, 0xdfe2e23dU, 0xcdebeb26U, 0x4e272769U, 0x7fb2b2cdU, 0xea75759fU, 0x1209091bU, 0x1d83839eU, 0x582c2c74U, 0x341a1a2eU, 0x361b1b2dU, 0xdc6e6eb2U, 0xb45a5aeeU, 0x5ba0a0fbU, 0xa45252f6U, 0x763b3b4dU, 0xb7d6d661U, 0x7db3b3ceU, 0x5229297bU, 0xdde3e33eU, 0x5e2f2f71U, 0x13848497U, 0xa65353f5U, 0xb9d1d168U, 0x00000000U, 0xc1eded2cU, 0x40202060U, 0xe3fcfc1fU, 0x79b1b1c8U, 0xb65b5bedU, 0xd46a6abeU, 0x8dcbcb46U, 0x67bebed9U, 0x7239394bU, 0x944a4adeU, 0x984c4cd4U, 0xb05858e8U, 0x85cfcf4aU, 0xbbd0d06bU, 0xc5efef2aU, 0x4faaaae5U, 0xedfbfb16U, 0x864343c5U, 0x9a4d4dd7U, 0x66333355U, 0x11858594U, 0x8a4545cfU, 0xe9f9f910U, 0x04020206U, 0xfe7f7f81U, 0xa05050f0U, 0x783c3c44U, 0x259f9fbaU, 0x4ba8a8e3U, 0xa25151f3U, 0x5da3a3feU, 0x804040c0U, 0x058f8f8aU, 0x3f9292adU, 0x219d9dbcU, 0x70383848U, 0xf1f5f504U, 0x63bcbcdfU, 0x77b6b6c1U, 0xafdada75U, 0x42212163U, 0x20101030U, 0xe5ffff1aU, 0xfdf3f30eU, 0xbfd2d26dU, 0x81cdcd4cU, 0x180c0c14U, 0x26131335U, 0xc3ecec2fU, 0xbe5f5fe1U, 0x359797a2U, 0x884444ccU, 0x2e171739U, 0x93c4c457U, 0x55a7a7f2U, 0xfc7e7e82U, 0x7a3d3d47U, 0xc86464acU, 0xba5d5de7U, 0x3219192bU, 0xe6737395U, 0xc06060a0U, 0x19818198U, 0x9e4f4fd1U, 0xa3dcdc7fU, 0x44222266U, 0x542a2a7eU, 0x3b9090abU, 0x0b888883U, 0x8c4646caU, 0xc7eeee29U, 0x6bb8b8d3U, 0x2814143cU, 0xa7dede79U, 0xbc5e5ee2U, 0x160b0b1dU, 0xaddbdb76U, 0xdbe0e03bU, 0x64323256U, 0x743a3a4eU, 0x140a0a1eU, 0x924949dbU, 0x0c06060aU, 0x4824246cU, 0xb85c5ce4U, 0x9fc2c25dU, 0xbdd3d36eU, 0x43acacefU, 0xc46262a6U, 0x399191a8U, 0x319595a4U, 0xd3e4e437U, 0xf279798bU, 0xd5e7e732U, 0x8bc8c843U, 0x6e373759U, 0xda6d6db7U, 0x018d8d8cU, 0xb1d5d564U, 0x9c4e4ed2U, 0x49a9a9e0U, 0xd86c6cb4U, 0xac5656faU, 0xf3f4f407U, 0xcfeaea25U, 0xca6565afU, 0xf47a7a8eU, 0x47aeaee9U, 0x10080818U, 0x6fbabad5U, 0xf0787888U, 0x4a25256fU, 0x5c2e2e72U, 0x381c1c24U, 0x57a6a6f1U, 0x73b4b4c7U, 0x97c6c651U, 0xcbe8e823U, 0xa1dddd7cU, 0xe874749cU, 0x3e1f1f21U, 0x964b4bddU, 0x61bdbddcU, 0x0d8b8b86U, 0x0f8a8a85U, 0xe0707090U, 0x7c3e3e42U, 0x71b5b5c4U, 0xcc6666aaU, 0x904848d8U, 0x06030305U, 0xf7f6f601U, 0x1c0e0e12U, 0xc26161a3U, 0x6a35355fU, 0xae5757f9U, 0x69b9b9d0U, 0x17868691U, 0x99c1c158U, 0x3a1d1d27U, 0x279e9eb9U, 0xd9e1e138U, 0xebf8f813U, 0x2b9898b3U, 0x22111133U, 0xd26969bbU, 0xa9d9d970U, 0x078e8e89U, 0x339494a7U, 0x2d9b9bb6U, 0x3c1e1e22U, 0x15878792U, 0xc9e9e920U, 0x87cece49U, 0xaa5555ffU, 0x50282878U, 0xa5dfdf7aU, 0x038c8c8fU, 0x59a1a1f8U, 0x09898980U, 0x1a0d0d17U, 0x65bfbfdaU, 0xd7e6e631U, 0x844242c6U, 0xd06868b8U, 0x824141c3U, 0x299999b0U, 0x5a2d2d77U, 0x1e0f0f11U, 0x7bb0b0cbU, 0xa85454fcU, 0x6dbbbbd6U, 0x2c16163aU, }; static const u32 Te1[256] = { 0xa5c66363U, 0x84f87c7cU, 0x99ee7777U, 0x8df67b7bU, 0x0dfff2f2U, 0xbdd66b6bU, 0xb1de6f6fU, 0x5491c5c5U, 0x50603030U, 0x03020101U, 0xa9ce6767U, 0x7d562b2bU, 0x19e7fefeU, 0x62b5d7d7U, 0xe64dababU, 0x9aec7676U, 0x458fcacaU, 0x9d1f8282U, 0x4089c9c9U, 0x87fa7d7dU, 0x15effafaU, 0xebb25959U, 0xc98e4747U, 0x0bfbf0f0U, 0xec41adadU, 0x67b3d4d4U, 0xfd5fa2a2U, 0xea45afafU, 0xbf239c9cU, 0xf753a4a4U, 0x96e47272U, 0x5b9bc0c0U, 0xc275b7b7U, 0x1ce1fdfdU, 0xae3d9393U, 0x6a4c2626U, 0x5a6c3636U, 0x417e3f3fU, 0x02f5f7f7U, 0x4f83ccccU, 0x5c683434U, 0xf451a5a5U, 0x34d1e5e5U, 0x08f9f1f1U, 0x93e27171U, 0x73abd8d8U, 0x53623131U, 0x3f2a1515U, 0x0c080404U, 0x5295c7c7U, 0x65462323U, 0x5e9dc3c3U, 0x28301818U, 0xa1379696U, 0x0f0a0505U, 0xb52f9a9aU, 0x090e0707U, 0x36241212U, 0x9b1b8080U, 0x3ddfe2e2U, 0x26cdebebU, 0x694e2727U, 0xcd7fb2b2U, 0x9fea7575U, 0x1b120909U, 0x9e1d8383U, 0x74582c2cU, 0x2e341a1aU, 0x2d361b1bU, 0xb2dc6e6eU, 0xeeb45a5aU, 0xfb5ba0a0U, 0xf6a45252U, 0x4d763b3bU, 0x61b7d6d6U, 0xce7db3b3U, 0x7b522929U, 0x3edde3e3U, 0x715e2f2fU, 0x97138484U, 0xf5a65353U, 0x68b9d1d1U, 0x00000000U, 0x2cc1ededU, 0x60402020U, 0x1fe3fcfcU, 0xc879b1b1U, 0xedb65b5bU, 0xbed46a6aU, 0x468dcbcbU, 0xd967bebeU, 0x4b723939U, 0xde944a4aU, 0xd4984c4cU, 0xe8b05858U, 0x4a85cfcfU, 0x6bbbd0d0U, 0x2ac5efefU, 0xe54faaaaU, 0x16edfbfbU, 0xc5864343U, 0xd79a4d4dU, 0x55663333U, 0x94118585U, 0xcf8a4545U, 0x10e9f9f9U, 0x06040202U, 0x81fe7f7fU, 0xf0a05050U, 0x44783c3cU, 0xba259f9fU, 0xe34ba8a8U, 0xf3a25151U, 0xfe5da3a3U, 0xc0804040U, 0x8a058f8fU, 0xad3f9292U, 0xbc219d9dU, 0x48703838U, 0x04f1f5f5U, 0xdf63bcbcU, 0xc177b6b6U, 0x75afdadaU, 0x63422121U, 0x30201010U, 0x1ae5ffffU, 0x0efdf3f3U, 0x6dbfd2d2U, 0x4c81cdcdU, 0x14180c0cU, 0x35261313U, 0x2fc3ececU, 0xe1be5f5fU, 0xa2359797U, 0xcc884444U, 0x392e1717U, 0x5793c4c4U, 0xf255a7a7U, 0x82fc7e7eU, 0x477a3d3dU, 0xacc86464U, 0xe7ba5d5dU, 0x2b321919U, 0x95e67373U, 0xa0c06060U, 0x98198181U, 0xd19e4f4fU, 0x7fa3dcdcU, 0x66442222U, 0x7e542a2aU, 0xab3b9090U, 0x830b8888U, 0xca8c4646U, 0x29c7eeeeU, 0xd36bb8b8U, 0x3c281414U, 0x79a7dedeU, 0xe2bc5e5eU, 0x1d160b0bU, 0x76addbdbU, 0x3bdbe0e0U, 0x56643232U, 0x4e743a3aU, 0x1e140a0aU, 0xdb924949U, 0x0a0c0606U, 0x6c482424U, 0xe4b85c5cU, 0x5d9fc2c2U, 0x6ebdd3d3U, 0xef43acacU, 0xa6c46262U, 0xa8399191U, 0xa4319595U, 0x37d3e4e4U, 0x8bf27979U, 0x32d5e7e7U, 0x438bc8c8U, 0x596e3737U, 0xb7da6d6dU, 0x8c018d8dU, 0x64b1d5d5U, 0xd29c4e4eU, 0xe049a9a9U, 0xb4d86c6cU, 0xfaac5656U, 0x07f3f4f4U, 0x25cfeaeaU, 0xafca6565U, 0x8ef47a7aU, 0xe947aeaeU, 0x18100808U, 0xd56fbabaU, 0x88f07878U, 0x6f4a2525U, 0x725c2e2eU, 0x24381c1cU, 0xf157a6a6U, 0xc773b4b4U, 0x5197c6c6U, 0x23cbe8e8U, 0x7ca1ddddU, 0x9ce87474U, 0x213e1f1fU, 0xdd964b4bU, 0xdc61bdbdU, 0x860d8b8bU, 0x850f8a8aU, 0x90e07070U, 0x427c3e3eU, 0xc471b5b5U, 0xaacc6666U, 0xd8904848U, 0x05060303U, 0x01f7f6f6U, 0x121c0e0eU, 0xa3c26161U, 0x5f6a3535U, 0xf9ae5757U, 0xd069b9b9U, 0x91178686U, 0x5899c1c1U, 0x273a1d1dU, 0xb9279e9eU, 0x38d9e1e1U, 0x13ebf8f8U, 0xb32b9898U, 0x33221111U, 0xbbd26969U, 0x70a9d9d9U, 0x89078e8eU, 0xa7339494U, 0xb62d9b9bU, 0x223c1e1eU, 0x92158787U, 0x20c9e9e9U, 0x4987ceceU, 0xffaa5555U, 0x78502828U, 0x7aa5dfdfU, 0x8f038c8cU, 0xf859a1a1U, 0x80098989U, 0x171a0d0dU, 0xda65bfbfU, 0x31d7e6e6U, 0xc6844242U, 0xb8d06868U, 0xc3824141U, 0xb0299999U, 0x775a2d2dU, 0x111e0f0fU, 0xcb7bb0b0U, 0xfca85454U, 0xd66dbbbbU, 0x3a2c1616U, }; static const u32 Te2[256] = { 0x63a5c663U, 0x7c84f87cU, 0x7799ee77U, 0x7b8df67bU, 0xf20dfff2U, 0x6bbdd66bU, 0x6fb1de6fU, 0xc55491c5U, 0x30506030U, 0x01030201U, 0x67a9ce67U, 0x2b7d562bU, 0xfe19e7feU, 0xd762b5d7U, 0xabe64dabU, 0x769aec76U, 0xca458fcaU, 0x829d1f82U, 0xc94089c9U, 0x7d87fa7dU, 0xfa15effaU, 0x59ebb259U, 0x47c98e47U, 0xf00bfbf0U, 0xadec41adU, 0xd467b3d4U, 0xa2fd5fa2U, 0xafea45afU, 0x9cbf239cU, 0xa4f753a4U, 0x7296e472U, 0xc05b9bc0U, 0xb7c275b7U, 0xfd1ce1fdU, 0x93ae3d93U, 0x266a4c26U, 0x365a6c36U, 0x3f417e3fU, 0xf702f5f7U, 0xcc4f83ccU, 0x345c6834U, 0xa5f451a5U, 0xe534d1e5U, 0xf108f9f1U, 0x7193e271U, 0xd873abd8U, 0x31536231U, 0x153f2a15U, 0x040c0804U, 0xc75295c7U, 0x23654623U, 0xc35e9dc3U, 0x18283018U, 0x96a13796U, 0x050f0a05U, 0x9ab52f9aU, 0x07090e07U, 0x12362412U, 0x809b1b80U, 0xe23ddfe2U, 0xeb26cdebU, 0x27694e27U, 0xb2cd7fb2U, 0x759fea75U, 0x091b1209U, 0x839e1d83U, 0x2c74582cU, 0x1a2e341aU, 0x1b2d361bU, 0x6eb2dc6eU, 0x5aeeb45aU, 0xa0fb5ba0U, 0x52f6a452U, 0x3b4d763bU, 0xd661b7d6U, 0xb3ce7db3U, 0x297b5229U, 0xe33edde3U, 0x2f715e2fU, 0x84971384U, 0x53f5a653U, 0xd168b9d1U, 0x00000000U, 0xed2cc1edU, 0x20604020U, 0xfc1fe3fcU, 0xb1c879b1U, 0x5bedb65bU, 0x6abed46aU, 0xcb468dcbU, 0xbed967beU, 0x394b7239U, 0x4ade944aU, 0x4cd4984cU, 0x58e8b058U, 0xcf4a85cfU, 0xd06bbbd0U, 0xef2ac5efU, 0xaae54faaU, 0xfb16edfbU, 0x43c58643U, 0x4dd79a4dU, 0x33556633U, 0x85941185U, 0x45cf8a45U, 0xf910e9f9U, 0x02060402U, 0x7f81fe7fU, 0x50f0a050U, 0x3c44783cU, 0x9fba259fU, 0xa8e34ba8U, 0x51f3a251U, 0xa3fe5da3U, 0x40c08040U, 0x8f8a058fU, 0x92ad3f92U, 0x9dbc219dU, 0x38487038U, 0xf504f1f5U, 0xbcdf63bcU, 0xb6c177b6U, 0xda75afdaU, 0x21634221U, 0x10302010U, 0xff1ae5ffU, 0xf30efdf3U, 0xd26dbfd2U, 0xcd4c81cdU, 0x0c14180cU, 0x13352613U, 0xec2fc3ecU, 0x5fe1be5fU, 0x97a23597U, 0x44cc8844U, 0x17392e17U, 0xc45793c4U, 0xa7f255a7U, 0x7e82fc7eU, 0x3d477a3dU, 0x64acc864U, 0x5de7ba5dU, 0x192b3219U, 0x7395e673U, 0x60a0c060U, 0x81981981U, 0x4fd19e4fU, 0xdc7fa3dcU, 0x22664422U, 0x2a7e542aU, 0x90ab3b90U, 0x88830b88U, 0x46ca8c46U, 0xee29c7eeU, 0xb8d36bb8U, 0x143c2814U, 0xde79a7deU, 0x5ee2bc5eU, 0x0b1d160bU, 0xdb76addbU, 0xe03bdbe0U, 0x32566432U, 0x3a4e743aU, 0x0a1e140aU, 0x49db9249U, 0x060a0c06U, 0x246c4824U, 0x5ce4b85cU, 0xc25d9fc2U, 0xd36ebdd3U, 0xacef43acU, 0x62a6c462U, 0x91a83991U, 0x95a43195U, 0xe437d3e4U, 0x798bf279U, 0xe732d5e7U, 0xc8438bc8U, 0x37596e37U, 0x6db7da6dU, 0x8d8c018dU, 0xd564b1d5U, 0x4ed29c4eU, 0xa9e049a9U, 0x6cb4d86cU, 0x56faac56U, 0xf407f3f4U, 0xea25cfeaU, 0x65afca65U, 0x7a8ef47aU, 0xaee947aeU, 0x08181008U, 0xbad56fbaU, 0x7888f078U, 0x256f4a25U, 0x2e725c2eU, 0x1c24381cU, 0xa6f157a6U, 0xb4c773b4U, 0xc65197c6U, 0xe823cbe8U, 0xdd7ca1ddU, 0x749ce874U, 0x1f213e1fU, 0x4bdd964bU, 0xbddc61bdU, 0x8b860d8bU, 0x8a850f8aU, 0x7090e070U, 0x3e427c3eU, 0xb5c471b5U, 0x66aacc66U, 0x48d89048U, 0x03050603U, 0xf601f7f6U, 0x0e121c0eU, 0x61a3c261U, 0x355f6a35U, 0x57f9ae57U, 0xb9d069b9U, 0x86911786U, 0xc15899c1U, 0x1d273a1dU, 0x9eb9279eU, 0xe138d9e1U, 0xf813ebf8U, 0x98b32b98U, 0x11332211U, 0x69bbd269U, 0xd970a9d9U, 0x8e89078eU, 0x94a73394U, 0x9bb62d9bU, 0x1e223c1eU, 0x87921587U, 0xe920c9e9U, 0xce4987ceU, 0x55ffaa55U, 0x28785028U, 0xdf7aa5dfU, 0x8c8f038cU, 0xa1f859a1U, 0x89800989U, 0x0d171a0dU, 0xbfda65bfU, 0xe631d7e6U, 0x42c68442U, 0x68b8d068U, 0x41c38241U, 0x99b02999U, 0x2d775a2dU, 0x0f111e0fU, 0xb0cb7bb0U, 0x54fca854U, 0xbbd66dbbU, 0x163a2c16U, }; static const u32 Te3[256] = { 0x6363a5c6U, 0x7c7c84f8U, 0x777799eeU, 0x7b7b8df6U, 0xf2f20dffU, 0x6b6bbdd6U, 0x6f6fb1deU, 0xc5c55491U, 0x30305060U, 0x01010302U, 0x6767a9ceU, 0x2b2b7d56U, 0xfefe19e7U, 0xd7d762b5U, 0xababe64dU, 0x76769aecU, 0xcaca458fU, 0x82829d1fU, 0xc9c94089U, 0x7d7d87faU, 0xfafa15efU, 0x5959ebb2U, 0x4747c98eU, 0xf0f00bfbU, 0xadadec41U, 0xd4d467b3U, 0xa2a2fd5fU, 0xafafea45U, 0x9c9cbf23U, 0xa4a4f753U, 0x727296e4U, 0xc0c05b9bU, 0xb7b7c275U, 0xfdfd1ce1U, 0x9393ae3dU, 0x26266a4cU, 0x36365a6cU, 0x3f3f417eU, 0xf7f702f5U, 0xcccc4f83U, 0x34345c68U, 0xa5a5f451U, 0xe5e534d1U, 0xf1f108f9U, 0x717193e2U, 0xd8d873abU, 0x31315362U, 0x15153f2aU, 0x04040c08U, 0xc7c75295U, 0x23236546U, 0xc3c35e9dU, 0x18182830U, 0x9696a137U, 0x05050f0aU, 0x9a9ab52fU, 0x0707090eU, 0x12123624U, 0x80809b1bU, 0xe2e23ddfU, 0xebeb26cdU, 0x2727694eU, 0xb2b2cd7fU, 0x75759feaU, 0x09091b12U, 0x83839e1dU, 0x2c2c7458U, 0x1a1a2e34U, 0x1b1b2d36U, 0x6e6eb2dcU, 0x5a5aeeb4U, 0xa0a0fb5bU, 0x5252f6a4U, 0x3b3b4d76U, 0xd6d661b7U, 0xb3b3ce7dU, 0x29297b52U, 0xe3e33eddU, 0x2f2f715eU, 0x84849713U, 0x5353f5a6U, 0xd1d168b9U, 0x00000000U, 0xeded2cc1U, 0x20206040U, 0xfcfc1fe3U, 0xb1b1c879U, 0x5b5bedb6U, 0x6a6abed4U, 0xcbcb468dU, 0xbebed967U, 0x39394b72U, 0x4a4ade94U, 0x4c4cd498U, 0x5858e8b0U, 0xcfcf4a85U, 0xd0d06bbbU, 0xefef2ac5U, 0xaaaae54fU, 0xfbfb16edU, 0x4343c586U, 0x4d4dd79aU, 0x33335566U, 0x85859411U, 0x4545cf8aU, 0xf9f910e9U, 0x02020604U, 0x7f7f81feU, 0x5050f0a0U, 0x3c3c4478U, 0x9f9fba25U, 0xa8a8e34bU, 0x5151f3a2U, 0xa3a3fe5dU, 0x4040c080U, 0x8f8f8a05U, 0x9292ad3fU, 0x9d9dbc21U, 0x38384870U, 0xf5f504f1U, 0xbcbcdf63U, 0xb6b6c177U, 0xdada75afU, 0x21216342U, 0x10103020U, 0xffff1ae5U, 0xf3f30efdU, 0xd2d26dbfU, 0xcdcd4c81U, 0x0c0c1418U, 0x13133526U, 0xecec2fc3U, 0x5f5fe1beU, 0x9797a235U, 0x4444cc88U, 0x1717392eU, 0xc4c45793U, 0xa7a7f255U, 0x7e7e82fcU, 0x3d3d477aU, 0x6464acc8U, 0x5d5de7baU, 0x19192b32U, 0x737395e6U, 0x6060a0c0U, 0x81819819U, 0x4f4fd19eU, 0xdcdc7fa3U, 0x22226644U, 0x2a2a7e54U, 0x9090ab3bU, 0x8888830bU, 0x4646ca8cU, 0xeeee29c7U, 0xb8b8d36bU, 0x14143c28U, 0xdede79a7U, 0x5e5ee2bcU, 0x0b0b1d16U, 0xdbdb76adU, 0xe0e03bdbU, 0x32325664U, 0x3a3a4e74U, 0x0a0a1e14U, 0x4949db92U, 0x06060a0cU, 0x24246c48U, 0x5c5ce4b8U, 0xc2c25d9fU, 0xd3d36ebdU, 0xacacef43U, 0x6262a6c4U, 0x9191a839U, 0x9595a431U, 0xe4e437d3U, 0x79798bf2U, 0xe7e732d5U, 0xc8c8438bU, 0x3737596eU, 0x6d6db7daU, 0x8d8d8c01U, 0xd5d564b1U, 0x4e4ed29cU, 0xa9a9e049U, 0x6c6cb4d8U, 0x5656faacU, 0xf4f407f3U, 0xeaea25cfU, 0x6565afcaU, 0x7a7a8ef4U, 0xaeaee947U, 0x08081810U, 0xbabad56fU, 0x787888f0U, 0x25256f4aU, 0x2e2e725cU, 0x1c1c2438U, 0xa6a6f157U, 0xb4b4c773U, 0xc6c65197U, 0xe8e823cbU, 0xdddd7ca1U, 0x74749ce8U, 0x1f1f213eU, 0x4b4bdd96U, 0xbdbddc61U, 0x8b8b860dU, 0x8a8a850fU, 0x707090e0U, 0x3e3e427cU, 0xb5b5c471U, 0x6666aaccU, 0x4848d890U, 0x03030506U, 0xf6f601f7U, 0x0e0e121cU, 0x6161a3c2U, 0x35355f6aU, 0x5757f9aeU, 0xb9b9d069U, 0x86869117U, 0xc1c15899U, 0x1d1d273aU, 0x9e9eb927U, 0xe1e138d9U, 0xf8f813ebU, 0x9898b32bU, 0x11113322U, 0x6969bbd2U, 0xd9d970a9U, 0x8e8e8907U, 0x9494a733U, 0x9b9bb62dU, 0x1e1e223cU, 0x87879215U, 0xe9e920c9U, 0xcece4987U, 0x5555ffaaU, 0x28287850U, 0xdfdf7aa5U, 0x8c8c8f03U, 0xa1a1f859U, 0x89898009U, 0x0d0d171aU, 0xbfbfda65U, 0xe6e631d7U, 0x4242c684U, 0x6868b8d0U, 0x4141c382U, 0x9999b029U, 0x2d2d775aU, 0x0f0f111eU, 0xb0b0cb7bU, 0x5454fca8U, 0xbbbbd66dU, 0x16163a2cU, }; static const u32 Te4[256] = { 0x63636363U, 0x7c7c7c7cU, 0x77777777U, 0x7b7b7b7bU, 0xf2f2f2f2U, 0x6b6b6b6bU, 0x6f6f6f6fU, 0xc5c5c5c5U, 0x30303030U, 0x01010101U, 0x67676767U, 0x2b2b2b2bU, 0xfefefefeU, 0xd7d7d7d7U, 0xababababU, 0x76767676U, 0xcacacacaU, 0x82828282U, 0xc9c9c9c9U, 0x7d7d7d7dU, 0xfafafafaU, 0x59595959U, 0x47474747U, 0xf0f0f0f0U, 0xadadadadU, 0xd4d4d4d4U, 0xa2a2a2a2U, 0xafafafafU, 0x9c9c9c9cU, 0xa4a4a4a4U, 0x72727272U, 0xc0c0c0c0U, 0xb7b7b7b7U, 0xfdfdfdfdU, 0x93939393U, 0x26262626U, 0x36363636U, 0x3f3f3f3fU, 0xf7f7f7f7U, 0xccccccccU, 0x34343434U, 0xa5a5a5a5U, 0xe5e5e5e5U, 0xf1f1f1f1U, 0x71717171U, 0xd8d8d8d8U, 0x31313131U, 0x15151515U, 0x04040404U, 0xc7c7c7c7U, 0x23232323U, 0xc3c3c3c3U, 0x18181818U, 0x96969696U, 0x05050505U, 0x9a9a9a9aU, 0x07070707U, 0x12121212U, 0x80808080U, 0xe2e2e2e2U, 0xebebebebU, 0x27272727U, 0xb2b2b2b2U, 0x75757575U, 0x09090909U, 0x83838383U, 0x2c2c2c2cU, 0x1a1a1a1aU, 0x1b1b1b1bU, 0x6e6e6e6eU, 0x5a5a5a5aU, 0xa0a0a0a0U, 0x52525252U, 0x3b3b3b3bU, 0xd6d6d6d6U, 0xb3b3b3b3U, 0x29292929U, 0xe3e3e3e3U, 0x2f2f2f2fU, 0x84848484U, 0x53535353U, 0xd1d1d1d1U, 0x00000000U, 0xededededU, 0x20202020U, 0xfcfcfcfcU, 0xb1b1b1b1U, 0x5b5b5b5bU, 0x6a6a6a6aU, 0xcbcbcbcbU, 0xbebebebeU, 0x39393939U, 0x4a4a4a4aU, 0x4c4c4c4cU, 0x58585858U, 0xcfcfcfcfU, 0xd0d0d0d0U, 0xefefefefU, 0xaaaaaaaaU, 0xfbfbfbfbU, 0x43434343U, 0x4d4d4d4dU, 0x33333333U, 0x85858585U, 0x45454545U, 0xf9f9f9f9U, 0x02020202U, 0x7f7f7f7fU, 0x50505050U, 0x3c3c3c3cU, 0x9f9f9f9fU, 0xa8a8a8a8U, 0x51515151U, 0xa3a3a3a3U, 0x40404040U, 0x8f8f8f8fU, 0x92929292U, 0x9d9d9d9dU, 0x38383838U, 0xf5f5f5f5U, 0xbcbcbcbcU, 0xb6b6b6b6U, 0xdadadadaU, 0x21212121U, 0x10101010U, 0xffffffffU, 0xf3f3f3f3U, 0xd2d2d2d2U, 0xcdcdcdcdU, 0x0c0c0c0cU, 0x13131313U, 0xececececU, 0x5f5f5f5fU, 0x97979797U, 0x44444444U, 0x17171717U, 0xc4c4c4c4U, 0xa7a7a7a7U, 0x7e7e7e7eU, 0x3d3d3d3dU, 0x64646464U, 0x5d5d5d5dU, 0x19191919U, 0x73737373U, 0x60606060U, 0x81818181U, 0x4f4f4f4fU, 0xdcdcdcdcU, 0x22222222U, 0x2a2a2a2aU, 0x90909090U, 0x88888888U, 0x46464646U, 0xeeeeeeeeU, 0xb8b8b8b8U, 0x14141414U, 0xdedededeU, 0x5e5e5e5eU, 0x0b0b0b0bU, 0xdbdbdbdbU, 0xe0e0e0e0U, 0x32323232U, 0x3a3a3a3aU, 0x0a0a0a0aU, 0x49494949U, 0x06060606U, 0x24242424U, 0x5c5c5c5cU, 0xc2c2c2c2U, 0xd3d3d3d3U, 0xacacacacU, 0x62626262U, 0x91919191U, 0x95959595U, 0xe4e4e4e4U, 0x79797979U, 0xe7e7e7e7U, 0xc8c8c8c8U, 0x37373737U, 0x6d6d6d6dU, 0x8d8d8d8dU, 0xd5d5d5d5U, 0x4e4e4e4eU, 0xa9a9a9a9U, 0x6c6c6c6cU, 0x56565656U, 0xf4f4f4f4U, 0xeaeaeaeaU, 0x65656565U, 0x7a7a7a7aU, 0xaeaeaeaeU, 0x08080808U, 0xbabababaU, 0x78787878U, 0x25252525U, 0x2e2e2e2eU, 0x1c1c1c1cU, 0xa6a6a6a6U, 0xb4b4b4b4U, 0xc6c6c6c6U, 0xe8e8e8e8U, 0xddddddddU, 0x74747474U, 0x1f1f1f1fU, 0x4b4b4b4bU, 0xbdbdbdbdU, 0x8b8b8b8bU, 0x8a8a8a8aU, 0x70707070U, 0x3e3e3e3eU, 0xb5b5b5b5U, 0x66666666U, 0x48484848U, 0x03030303U, 0xf6f6f6f6U, 0x0e0e0e0eU, 0x61616161U, 0x35353535U, 0x57575757U, 0xb9b9b9b9U, 0x86868686U, 0xc1c1c1c1U, 0x1d1d1d1dU, 0x9e9e9e9eU, 0xe1e1e1e1U, 0xf8f8f8f8U, 0x98989898U, 0x11111111U, 0x69696969U, 0xd9d9d9d9U, 0x8e8e8e8eU, 0x94949494U, 0x9b9b9b9bU, 0x1e1e1e1eU, 0x87878787U, 0xe9e9e9e9U, 0xcecececeU, 0x55555555U, 0x28282828U, 0xdfdfdfdfU, 0x8c8c8c8cU, 0xa1a1a1a1U, 0x89898989U, 0x0d0d0d0dU, 0xbfbfbfbfU, 0xe6e6e6e6U, 0x42424242U, 0x68686868U, 0x41414141U, 0x99999999U, 0x2d2d2d2dU, 0x0f0f0f0fU, 0xb0b0b0b0U, 0x54545454U, 0xbbbbbbbbU, 0x16161616U, }; static const u32 Td0[256] = { 0x51f4a750U, 0x7e416553U, 0x1a17a4c3U, 0x3a275e96U, 0x3bab6bcbU, 0x1f9d45f1U, 0xacfa58abU, 0x4be30393U, 0x2030fa55U, 0xad766df6U, 0x88cc7691U, 0xf5024c25U, 0x4fe5d7fcU, 0xc52acbd7U, 0x26354480U, 0xb562a38fU, 0xdeb15a49U, 0x25ba1b67U, 0x45ea0e98U, 0x5dfec0e1U, 0xc32f7502U, 0x814cf012U, 0x8d4697a3U, 0x6bd3f9c6U, 0x038f5fe7U, 0x15929c95U, 0xbf6d7aebU, 0x955259daU, 0xd4be832dU, 0x587421d3U, 0x49e06929U, 0x8ec9c844U, 0x75c2896aU, 0xf48e7978U, 0x99583e6bU, 0x27b971ddU, 0xbee14fb6U, 0xf088ad17U, 0xc920ac66U, 0x7dce3ab4U, 0x63df4a18U, 0xe51a3182U, 0x97513360U, 0x62537f45U, 0xb16477e0U, 0xbb6bae84U, 0xfe81a01cU, 0xf9082b94U, 0x70486858U, 0x8f45fd19U, 0x94de6c87U, 0x527bf8b7U, 0xab73d323U, 0x724b02e2U, 0xe31f8f57U, 0x6655ab2aU, 0xb2eb2807U, 0x2fb5c203U, 0x86c57b9aU, 0xd33708a5U, 0x302887f2U, 0x23bfa5b2U, 0x02036abaU, 0xed16825cU, 0x8acf1c2bU, 0xa779b492U, 0xf307f2f0U, 0x4e69e2a1U, 0x65daf4cdU, 0x0605bed5U, 0xd134621fU, 0xc4a6fe8aU, 0x342e539dU, 0xa2f355a0U, 0x058ae132U, 0xa4f6eb75U, 0x0b83ec39U, 0x4060efaaU, 0x5e719f06U, 0xbd6e1051U, 0x3e218af9U, 0x96dd063dU, 0xdd3e05aeU, 0x4de6bd46U, 0x91548db5U, 0x71c45d05U, 0x0406d46fU, 0x605015ffU, 0x1998fb24U, 0xd6bde997U, 0x894043ccU, 0x67d99e77U, 0xb0e842bdU, 0x07898b88U, 0xe7195b38U, 0x79c8eedbU, 0xa17c0a47U, 0x7c420fe9U, 0xf8841ec9U, 0x00000000U, 0x09808683U, 0x322bed48U, 0x1e1170acU, 0x6c5a724eU, 0xfd0efffbU, 0x0f853856U, 0x3daed51eU, 0x362d3927U, 0x0a0fd964U, 0x685ca621U, 0x9b5b54d1U, 0x24362e3aU, 0x0c0a67b1U, 0x9357e70fU, 0xb4ee96d2U, 0x1b9b919eU, 0x80c0c54fU, 0x61dc20a2U, 0x5a774b69U, 0x1c121a16U, 0xe293ba0aU, 0xc0a02ae5U, 0x3c22e043U, 0x121b171dU, 0x0e090d0bU, 0xf28bc7adU, 0x2db6a8b9U, 0x141ea9c8U, 0x57f11985U, 0xaf75074cU, 0xee99ddbbU, 0xa37f60fdU, 0xf701269fU, 0x5c72f5bcU, 0x44663bc5U, 0x5bfb7e34U, 0x8b432976U, 0xcb23c6dcU, 0xb6edfc68U, 0xb8e4f163U, 0xd731dccaU, 0x42638510U, 0x13972240U, 0x84c61120U, 0x854a247dU, 0xd2bb3df8U, 0xaef93211U, 0xc729a16dU, 0x1d9e2f4bU, 0xdcb230f3U, 0x0d8652ecU, 0x77c1e3d0U, 0x2bb3166cU, 0xa970b999U, 0x119448faU, 0x47e96422U, 0xa8fc8cc4U, 0xa0f03f1aU, 0x567d2cd8U, 0x223390efU, 0x87494ec7U, 0xd938d1c1U, 0x8ccaa2feU, 0x98d40b36U, 0xa6f581cfU, 0xa57ade28U, 0xdab78e26U, 0x3fadbfa4U, 0x2c3a9de4U, 0x5078920dU, 0x6a5fcc9bU, 0x547e4662U, 0xf68d13c2U, 0x90d8b8e8U, 0x2e39f75eU, 0x82c3aff5U, 0x9f5d80beU, 0x69d0937cU, 0x6fd52da9U, 0xcf2512b3U, 0xc8ac993bU, 0x10187da7U, 0xe89c636eU, 0xdb3bbb7bU, 0xcd267809U, 0x6e5918f4U, 0xec9ab701U, 0x834f9aa8U, 0xe6956e65U, 0xaaffe67eU, 0x21bccf08U, 0xef15e8e6U, 0xbae79bd9U, 0x4a6f36ceU, 0xea9f09d4U, 0x29b07cd6U, 0x31a4b2afU, 0x2a3f2331U, 0xc6a59430U, 0x35a266c0U, 0x744ebc37U, 0xfc82caa6U, 0xe090d0b0U, 0x33a7d815U, 0xf104984aU, 0x41ecdaf7U, 0x7fcd500eU, 0x1791f62fU, 0x764dd68dU, 0x43efb04dU, 0xccaa4d54U, 0xe49604dfU, 0x9ed1b5e3U, 0x4c6a881bU, 0xc12c1fb8U, 0x4665517fU, 0x9d5eea04U, 0x018c355dU, 0xfa877473U, 0xfb0b412eU, 0xb3671d5aU, 0x92dbd252U, 0xe9105633U, 0x6dd64713U, 0x9ad7618cU, 0x37a10c7aU, 0x59f8148eU, 0xeb133c89U, 0xcea927eeU, 0xb761c935U, 0xe11ce5edU, 0x7a47b13cU, 0x9cd2df59U, 0x55f2733fU, 0x1814ce79U, 0x73c737bfU, 0x53f7cdeaU, 0x5ffdaa5bU, 0xdf3d6f14U, 0x7844db86U, 0xcaaff381U, 0xb968c43eU, 0x3824342cU, 0xc2a3405fU, 0x161dc372U, 0xbce2250cU, 0x283c498bU, 0xff0d9541U, 0x39a80171U, 0x080cb3deU, 0xd8b4e49cU, 0x6456c190U, 0x7bcb8461U, 0xd532b670U, 0x486c5c74U, 0xd0b85742U, }; static const u32 Td1[256] = { 0x5051f4a7U, 0x537e4165U, 0xc31a17a4U, 0x963a275eU, 0xcb3bab6bU, 0xf11f9d45U, 0xabacfa58U, 0x934be303U, 0x552030faU, 0xf6ad766dU, 0x9188cc76U, 0x25f5024cU, 0xfc4fe5d7U, 0xd7c52acbU, 0x80263544U, 0x8fb562a3U, 0x49deb15aU, 0x6725ba1bU, 0x9845ea0eU, 0xe15dfec0U, 0x02c32f75U, 0x12814cf0U, 0xa38d4697U, 0xc66bd3f9U, 0xe7038f5fU, 0x9515929cU, 0xebbf6d7aU, 0xda955259U, 0x2dd4be83U, 0xd3587421U, 0x2949e069U, 0x448ec9c8U, 0x6a75c289U, 0x78f48e79U, 0x6b99583eU, 0xdd27b971U, 0xb6bee14fU, 0x17f088adU, 0x66c920acU, 0xb47dce3aU, 0x1863df4aU, 0x82e51a31U, 0x60975133U, 0x4562537fU, 0xe0b16477U, 0x84bb6baeU, 0x1cfe81a0U, 0x94f9082bU, 0x58704868U, 0x198f45fdU, 0x8794de6cU, 0xb7527bf8U, 0x23ab73d3U, 0xe2724b02U, 0x57e31f8fU, 0x2a6655abU, 0x07b2eb28U, 0x032fb5c2U, 0x9a86c57bU, 0xa5d33708U, 0xf2302887U, 0xb223bfa5U, 0xba02036aU, 0x5ced1682U, 0x2b8acf1cU, 0x92a779b4U, 0xf0f307f2U, 0xa14e69e2U, 0xcd65daf4U, 0xd50605beU, 0x1fd13462U, 0x8ac4a6feU, 0x9d342e53U, 0xa0a2f355U, 0x32058ae1U, 0x75a4f6ebU, 0x390b83ecU, 0xaa4060efU, 0x065e719fU, 0x51bd6e10U, 0xf93e218aU, 0x3d96dd06U, 0xaedd3e05U, 0x464de6bdU, 0xb591548dU, 0x0571c45dU, 0x6f0406d4U, 0xff605015U, 0x241998fbU, 0x97d6bde9U, 0xcc894043U, 0x7767d99eU, 0xbdb0e842U, 0x8807898bU, 0x38e7195bU, 0xdb79c8eeU, 0x47a17c0aU, 0xe97c420fU, 0xc9f8841eU, 0x00000000U, 0x83098086U, 0x48322bedU, 0xac1e1170U, 0x4e6c5a72U, 0xfbfd0effU, 0x560f8538U, 0x1e3daed5U, 0x27362d39U, 0x640a0fd9U, 0x21685ca6U, 0xd19b5b54U, 0x3a24362eU, 0xb10c0a67U, 0x0f9357e7U, 0xd2b4ee96U, 0x9e1b9b91U, 0x4f80c0c5U, 0xa261dc20U, 0x695a774bU, 0x161c121aU, 0x0ae293baU, 0xe5c0a02aU, 0x433c22e0U, 0x1d121b17U, 0x0b0e090dU, 0xadf28bc7U, 0xb92db6a8U, 0xc8141ea9U, 0x8557f119U, 0x4caf7507U, 0xbbee99ddU, 0xfda37f60U, 0x9ff70126U, 0xbc5c72f5U, 0xc544663bU, 0x345bfb7eU, 0x768b4329U, 0xdccb23c6U, 0x68b6edfcU, 0x63b8e4f1U, 0xcad731dcU, 0x10426385U, 0x40139722U, 0x2084c611U, 0x7d854a24U, 0xf8d2bb3dU, 0x11aef932U, 0x6dc729a1U, 0x4b1d9e2fU, 0xf3dcb230U, 0xec0d8652U, 0xd077c1e3U, 0x6c2bb316U, 0x99a970b9U, 0xfa119448U, 0x2247e964U, 0xc4a8fc8cU, 0x1aa0f03fU, 0xd8567d2cU, 0xef223390U, 0xc787494eU, 0xc1d938d1U, 0xfe8ccaa2U, 0x3698d40bU, 0xcfa6f581U, 0x28a57adeU, 0x26dab78eU, 0xa43fadbfU, 0xe42c3a9dU, 0x0d507892U, 0x9b6a5fccU, 0x62547e46U, 0xc2f68d13U, 0xe890d8b8U, 0x5e2e39f7U, 0xf582c3afU, 0xbe9f5d80U, 0x7c69d093U, 0xa96fd52dU, 0xb3cf2512U, 0x3bc8ac99U, 0xa710187dU, 0x6ee89c63U, 0x7bdb3bbbU, 0x09cd2678U, 0xf46e5918U, 0x01ec9ab7U, 0xa8834f9aU, 0x65e6956eU, 0x7eaaffe6U, 0x0821bccfU, 0xe6ef15e8U, 0xd9bae79bU, 0xce4a6f36U, 0xd4ea9f09U, 0xd629b07cU, 0xaf31a4b2U, 0x312a3f23U, 0x30c6a594U, 0xc035a266U, 0x37744ebcU, 0xa6fc82caU, 0xb0e090d0U, 0x1533a7d8U, 0x4af10498U, 0xf741ecdaU, 0x0e7fcd50U, 0x2f1791f6U, 0x8d764dd6U, 0x4d43efb0U, 0x54ccaa4dU, 0xdfe49604U, 0xe39ed1b5U, 0x1b4c6a88U, 0xb8c12c1fU, 0x7f466551U, 0x049d5eeaU, 0x5d018c35U, 0x73fa8774U, 0x2efb0b41U, 0x5ab3671dU, 0x5292dbd2U, 0x33e91056U, 0x136dd647U, 0x8c9ad761U, 0x7a37a10cU, 0x8e59f814U, 0x89eb133cU, 0xeecea927U, 0x35b761c9U, 0xede11ce5U, 0x3c7a47b1U, 0x599cd2dfU, 0x3f55f273U, 0x791814ceU, 0xbf73c737U, 0xea53f7cdU, 0x5b5ffdaaU, 0x14df3d6fU, 0x867844dbU, 0x81caaff3U, 0x3eb968c4U, 0x2c382434U, 0x5fc2a340U, 0x72161dc3U, 0x0cbce225U, 0x8b283c49U, 0x41ff0d95U, 0x7139a801U, 0xde080cb3U, 0x9cd8b4e4U, 0x906456c1U, 0x617bcb84U, 0x70d532b6U, 0x74486c5cU, 0x42d0b857U, }; static const u32 Td2[256] = { 0xa75051f4U, 0x65537e41U, 0xa4c31a17U, 0x5e963a27U, 0x6bcb3babU, 0x45f11f9dU, 0x58abacfaU, 0x03934be3U, 0xfa552030U, 0x6df6ad76U, 0x769188ccU, 0x4c25f502U, 0xd7fc4fe5U, 0xcbd7c52aU, 0x44802635U, 0xa38fb562U, 0x5a49deb1U, 0x1b6725baU, 0x0e9845eaU, 0xc0e15dfeU, 0x7502c32fU, 0xf012814cU, 0x97a38d46U, 0xf9c66bd3U, 0x5fe7038fU, 0x9c951592U, 0x7aebbf6dU, 0x59da9552U, 0x832dd4beU, 0x21d35874U, 0x692949e0U, 0xc8448ec9U, 0x896a75c2U, 0x7978f48eU, 0x3e6b9958U, 0x71dd27b9U, 0x4fb6bee1U, 0xad17f088U, 0xac66c920U, 0x3ab47dceU, 0x4a1863dfU, 0x3182e51aU, 0x33609751U, 0x7f456253U, 0x77e0b164U, 0xae84bb6bU, 0xa01cfe81U, 0x2b94f908U, 0x68587048U, 0xfd198f45U, 0x6c8794deU, 0xf8b7527bU, 0xd323ab73U, 0x02e2724bU, 0x8f57e31fU, 0xab2a6655U, 0x2807b2ebU, 0xc2032fb5U, 0x7b9a86c5U, 0x08a5d337U, 0x87f23028U, 0xa5b223bfU, 0x6aba0203U, 0x825ced16U, 0x1c2b8acfU, 0xb492a779U, 0xf2f0f307U, 0xe2a14e69U, 0xf4cd65daU, 0xbed50605U, 0x621fd134U, 0xfe8ac4a6U, 0x539d342eU, 0x55a0a2f3U, 0xe132058aU, 0xeb75a4f6U, 0xec390b83U, 0xefaa4060U, 0x9f065e71U, 0x1051bd6eU, 0x8af93e21U, 0x063d96ddU, 0x05aedd3eU, 0xbd464de6U, 0x8db59154U, 0x5d0571c4U, 0xd46f0406U, 0x15ff6050U, 0xfb241998U, 0xe997d6bdU, 0x43cc8940U, 0x9e7767d9U, 0x42bdb0e8U, 0x8b880789U, 0x5b38e719U, 0xeedb79c8U, 0x0a47a17cU, 0x0fe97c42U, 0x1ec9f884U, 0x00000000U, 0x86830980U, 0xed48322bU, 0x70ac1e11U, 0x724e6c5aU, 0xfffbfd0eU, 0x38560f85U, 0xd51e3daeU, 0x3927362dU, 0xd9640a0fU, 0xa621685cU, 0x54d19b5bU, 0x2e3a2436U, 0x67b10c0aU, 0xe70f9357U, 0x96d2b4eeU, 0x919e1b9bU, 0xc54f80c0U, 0x20a261dcU, 0x4b695a77U, 0x1a161c12U, 0xba0ae293U, 0x2ae5c0a0U, 0xe0433c22U, 0x171d121bU, 0x0d0b0e09U, 0xc7adf28bU, 0xa8b92db6U, 0xa9c8141eU, 0x198557f1U, 0x074caf75U, 0xddbbee99U, 0x60fda37fU, 0x269ff701U, 0xf5bc5c72U, 0x3bc54466U, 0x7e345bfbU, 0x29768b43U, 0xc6dccb23U, 0xfc68b6edU, 0xf163b8e4U, 0xdccad731U, 0x85104263U, 0x22401397U, 0x112084c6U, 0x247d854aU, 0x3df8d2bbU, 0x3211aef9U, 0xa16dc729U, 0x2f4b1d9eU, 0x30f3dcb2U, 0x52ec0d86U, 0xe3d077c1U, 0x166c2bb3U, 0xb999a970U, 0x48fa1194U, 0x642247e9U, 0x8cc4a8fcU, 0x3f1aa0f0U, 0x2cd8567dU, 0x90ef2233U, 0x4ec78749U, 0xd1c1d938U, 0xa2fe8ccaU, 0x0b3698d4U, 0x81cfa6f5U, 0xde28a57aU, 0x8e26dab7U, 0xbfa43fadU, 0x9de42c3aU, 0x920d5078U, 0xcc9b6a5fU, 0x4662547eU, 0x13c2f68dU, 0xb8e890d8U, 0xf75e2e39U, 0xaff582c3U, 0x80be9f5dU, 0x937c69d0U, 0x2da96fd5U, 0x12b3cf25U, 0x993bc8acU, 0x7da71018U, 0x636ee89cU, 0xbb7bdb3bU, 0x7809cd26U, 0x18f46e59U, 0xb701ec9aU, 0x9aa8834fU, 0x6e65e695U, 0xe67eaaffU, 0xcf0821bcU, 0xe8e6ef15U, 0x9bd9bae7U, 0x36ce4a6fU, 0x09d4ea9fU, 0x7cd629b0U, 0xb2af31a4U, 0x23312a3fU, 0x9430c6a5U, 0x66c035a2U, 0xbc37744eU, 0xcaa6fc82U, 0xd0b0e090U, 0xd81533a7U, 0x984af104U, 0xdaf741ecU, 0x500e7fcdU, 0xf62f1791U, 0xd68d764dU, 0xb04d43efU, 0x4d54ccaaU, 0x04dfe496U, 0xb5e39ed1U, 0x881b4c6aU, 0x1fb8c12cU, 0x517f4665U, 0xea049d5eU, 0x355d018cU, 0x7473fa87U, 0x412efb0bU, 0x1d5ab367U, 0xd25292dbU, 0x5633e910U, 0x47136dd6U, 0x618c9ad7U, 0x0c7a37a1U, 0x148e59f8U, 0x3c89eb13U, 0x27eecea9U, 0xc935b761U, 0xe5ede11cU, 0xb13c7a47U, 0xdf599cd2U, 0x733f55f2U, 0xce791814U, 0x37bf73c7U, 0xcdea53f7U, 0xaa5b5ffdU, 0x6f14df3dU, 0xdb867844U, 0xf381caafU, 0xc43eb968U, 0x342c3824U, 0x405fc2a3U, 0xc372161dU, 0x250cbce2U, 0x498b283cU, 0x9541ff0dU, 0x017139a8U, 0xb3de080cU, 0xe49cd8b4U, 0xc1906456U, 0x84617bcbU, 0xb670d532U, 0x5c74486cU, 0x5742d0b8U, }; static const u32 Td3[256] = { 0xf4a75051U, 0x4165537eU, 0x17a4c31aU, 0x275e963aU, 0xab6bcb3bU, 0x9d45f11fU, 0xfa58abacU, 0xe303934bU, 0x30fa5520U, 0x766df6adU, 0xcc769188U, 0x024c25f5U, 0xe5d7fc4fU, 0x2acbd7c5U, 0x35448026U, 0x62a38fb5U, 0xb15a49deU, 0xba1b6725U, 0xea0e9845U, 0xfec0e15dU, 0x2f7502c3U, 0x4cf01281U, 0x4697a38dU, 0xd3f9c66bU, 0x8f5fe703U, 0x929c9515U, 0x6d7aebbfU, 0x5259da95U, 0xbe832dd4U, 0x7421d358U, 0xe0692949U, 0xc9c8448eU, 0xc2896a75U, 0x8e7978f4U, 0x583e6b99U, 0xb971dd27U, 0xe14fb6beU, 0x88ad17f0U, 0x20ac66c9U, 0xce3ab47dU, 0xdf4a1863U, 0x1a3182e5U, 0x51336097U, 0x537f4562U, 0x6477e0b1U, 0x6bae84bbU, 0x81a01cfeU, 0x082b94f9U, 0x48685870U, 0x45fd198fU, 0xde6c8794U, 0x7bf8b752U, 0x73d323abU, 0x4b02e272U, 0x1f8f57e3U, 0x55ab2a66U, 0xeb2807b2U, 0xb5c2032fU, 0xc57b9a86U, 0x3708a5d3U, 0x2887f230U, 0xbfa5b223U, 0x036aba02U, 0x16825cedU, 0xcf1c2b8aU, 0x79b492a7U, 0x07f2f0f3U, 0x69e2a14eU, 0xdaf4cd65U, 0x05bed506U, 0x34621fd1U, 0xa6fe8ac4U, 0x2e539d34U, 0xf355a0a2U, 0x8ae13205U, 0xf6eb75a4U, 0x83ec390bU, 0x60efaa40U, 0x719f065eU, 0x6e1051bdU, 0x218af93eU, 0xdd063d96U, 0x3e05aeddU, 0xe6bd464dU, 0x548db591U, 0xc45d0571U, 0x06d46f04U, 0x5015ff60U, 0x98fb2419U, 0xbde997d6U, 0x4043cc89U, 0xd99e7767U, 0xe842bdb0U, 0x898b8807U, 0x195b38e7U, 0xc8eedb79U, 0x7c0a47a1U, 0x420fe97cU, 0x841ec9f8U, 0x00000000U, 0x80868309U, 0x2bed4832U, 0x1170ac1eU, 0x5a724e6cU, 0x0efffbfdU, 0x8538560fU, 0xaed51e3dU, 0x2d392736U, 0x0fd9640aU, 0x5ca62168U, 0x5b54d19bU, 0x362e3a24U, 0x0a67b10cU, 0x57e70f93U, 0xee96d2b4U, 0x9b919e1bU, 0xc0c54f80U, 0xdc20a261U, 0x774b695aU, 0x121a161cU, 0x93ba0ae2U, 0xa02ae5c0U, 0x22e0433cU, 0x1b171d12U, 0x090d0b0eU, 0x8bc7adf2U, 0xb6a8b92dU, 0x1ea9c814U, 0xf1198557U, 0x75074cafU, 0x99ddbbeeU, 0x7f60fda3U, 0x01269ff7U, 0x72f5bc5cU, 0x663bc544U, 0xfb7e345bU, 0x4329768bU, 0x23c6dccbU, 0xedfc68b6U, 0xe4f163b8U, 0x31dccad7U, 0x63851042U, 0x97224013U, 0xc6112084U, 0x4a247d85U, 0xbb3df8d2U, 0xf93211aeU, 0x29a16dc7U, 0x9e2f4b1dU, 0xb230f3dcU, 0x8652ec0dU, 0xc1e3d077U, 0xb3166c2bU, 0x70b999a9U, 0x9448fa11U, 0xe9642247U, 0xfc8cc4a8U, 0xf03f1aa0U, 0x7d2cd856U, 0x3390ef22U, 0x494ec787U, 0x38d1c1d9U, 0xcaa2fe8cU, 0xd40b3698U, 0xf581cfa6U, 0x7ade28a5U, 0xb78e26daU, 0xadbfa43fU, 0x3a9de42cU, 0x78920d50U, 0x5fcc9b6aU, 0x7e466254U, 0x8d13c2f6U, 0xd8b8e890U, 0x39f75e2eU, 0xc3aff582U, 0x5d80be9fU, 0xd0937c69U, 0xd52da96fU, 0x2512b3cfU, 0xac993bc8U, 0x187da710U, 0x9c636ee8U, 0x3bbb7bdbU, 0x267809cdU, 0x5918f46eU, 0x9ab701ecU, 0x4f9aa883U, 0x956e65e6U, 0xffe67eaaU, 0xbccf0821U, 0x15e8e6efU, 0xe79bd9baU, 0x6f36ce4aU, 0x9f09d4eaU, 0xb07cd629U, 0xa4b2af31U, 0x3f23312aU, 0xa59430c6U, 0xa266c035U, 0x4ebc3774U, 0x82caa6fcU, 0x90d0b0e0U, 0xa7d81533U, 0x04984af1U, 0xecdaf741U, 0xcd500e7fU, 0x91f62f17U, 0x4dd68d76U, 0xefb04d43U, 0xaa4d54ccU, 0x9604dfe4U, 0xd1b5e39eU, 0x6a881b4cU, 0x2c1fb8c1U, 0x65517f46U, 0x5eea049dU, 0x8c355d01U, 0x877473faU, 0x0b412efbU, 0x671d5ab3U, 0xdbd25292U, 0x105633e9U, 0xd647136dU, 0xd7618c9aU, 0xa10c7a37U, 0xf8148e59U, 0x133c89ebU, 0xa927eeceU, 0x61c935b7U, 0x1ce5ede1U, 0x47b13c7aU, 0xd2df599cU, 0xf2733f55U, 0x14ce7918U, 0xc737bf73U, 0xf7cdea53U, 0xfdaa5b5fU, 0x3d6f14dfU, 0x44db8678U, 0xaff381caU, 0x68c43eb9U, 0x24342c38U, 0xa3405fc2U, 0x1dc37216U, 0xe2250cbcU, 0x3c498b28U, 0x0d9541ffU, 0xa8017139U, 0x0cb3de08U, 0xb4e49cd8U, 0x56c19064U, 0xcb84617bU, 0x32b670d5U, 0x6c5c7448U, 0xb85742d0U, }; static const u32 Td4[256] = { 0x52525252U, 0x09090909U, 0x6a6a6a6aU, 0xd5d5d5d5U, 0x30303030U, 0x36363636U, 0xa5a5a5a5U, 0x38383838U, 0xbfbfbfbfU, 0x40404040U, 0xa3a3a3a3U, 0x9e9e9e9eU, 0x81818181U, 0xf3f3f3f3U, 0xd7d7d7d7U, 0xfbfbfbfbU, 0x7c7c7c7cU, 0xe3e3e3e3U, 0x39393939U, 0x82828282U, 0x9b9b9b9bU, 0x2f2f2f2fU, 0xffffffffU, 0x87878787U, 0x34343434U, 0x8e8e8e8eU, 0x43434343U, 0x44444444U, 0xc4c4c4c4U, 0xdedededeU, 0xe9e9e9e9U, 0xcbcbcbcbU, 0x54545454U, 0x7b7b7b7bU, 0x94949494U, 0x32323232U, 0xa6a6a6a6U, 0xc2c2c2c2U, 0x23232323U, 0x3d3d3d3dU, 0xeeeeeeeeU, 0x4c4c4c4cU, 0x95959595U, 0x0b0b0b0bU, 0x42424242U, 0xfafafafaU, 0xc3c3c3c3U, 0x4e4e4e4eU, 0x08080808U, 0x2e2e2e2eU, 0xa1a1a1a1U, 0x66666666U, 0x28282828U, 0xd9d9d9d9U, 0x24242424U, 0xb2b2b2b2U, 0x76767676U, 0x5b5b5b5bU, 0xa2a2a2a2U, 0x49494949U, 0x6d6d6d6dU, 0x8b8b8b8bU, 0xd1d1d1d1U, 0x25252525U, 0x72727272U, 0xf8f8f8f8U, 0xf6f6f6f6U, 0x64646464U, 0x86868686U, 0x68686868U, 0x98989898U, 0x16161616U, 0xd4d4d4d4U, 0xa4a4a4a4U, 0x5c5c5c5cU, 0xccccccccU, 0x5d5d5d5dU, 0x65656565U, 0xb6b6b6b6U, 0x92929292U, 0x6c6c6c6cU, 0x70707070U, 0x48484848U, 0x50505050U, 0xfdfdfdfdU, 0xededededU, 0xb9b9b9b9U, 0xdadadadaU, 0x5e5e5e5eU, 0x15151515U, 0x46464646U, 0x57575757U, 0xa7a7a7a7U, 0x8d8d8d8dU, 0x9d9d9d9dU, 0x84848484U, 0x90909090U, 0xd8d8d8d8U, 0xababababU, 0x00000000U, 0x8c8c8c8cU, 0xbcbcbcbcU, 0xd3d3d3d3U, 0x0a0a0a0aU, 0xf7f7f7f7U, 0xe4e4e4e4U, 0x58585858U, 0x05050505U, 0xb8b8b8b8U, 0xb3b3b3b3U, 0x45454545U, 0x06060606U, 0xd0d0d0d0U, 0x2c2c2c2cU, 0x1e1e1e1eU, 0x8f8f8f8fU, 0xcacacacaU, 0x3f3f3f3fU, 0x0f0f0f0fU, 0x02020202U, 0xc1c1c1c1U, 0xafafafafU, 0xbdbdbdbdU, 0x03030303U, 0x01010101U, 0x13131313U, 0x8a8a8a8aU, 0x6b6b6b6bU, 0x3a3a3a3aU, 0x91919191U, 0x11111111U, 0x41414141U, 0x4f4f4f4fU, 0x67676767U, 0xdcdcdcdcU, 0xeaeaeaeaU, 0x97979797U, 0xf2f2f2f2U, 0xcfcfcfcfU, 0xcecececeU, 0xf0f0f0f0U, 0xb4b4b4b4U, 0xe6e6e6e6U, 0x73737373U, 0x96969696U, 0xacacacacU, 0x74747474U, 0x22222222U, 0xe7e7e7e7U, 0xadadadadU, 0x35353535U, 0x85858585U, 0xe2e2e2e2U, 0xf9f9f9f9U, 0x37373737U, 0xe8e8e8e8U, 0x1c1c1c1cU, 0x75757575U, 0xdfdfdfdfU, 0x6e6e6e6eU, 0x47474747U, 0xf1f1f1f1U, 0x1a1a1a1aU, 0x71717171U, 0x1d1d1d1dU, 0x29292929U, 0xc5c5c5c5U, 0x89898989U, 0x6f6f6f6fU, 0xb7b7b7b7U, 0x62626262U, 0x0e0e0e0eU, 0xaaaaaaaaU, 0x18181818U, 0xbebebebeU, 0x1b1b1b1bU, 0xfcfcfcfcU, 0x56565656U, 0x3e3e3e3eU, 0x4b4b4b4bU, 0xc6c6c6c6U, 0xd2d2d2d2U, 0x79797979U, 0x20202020U, 0x9a9a9a9aU, 0xdbdbdbdbU, 0xc0c0c0c0U, 0xfefefefeU, 0x78787878U, 0xcdcdcdcdU, 0x5a5a5a5aU, 0xf4f4f4f4U, 0x1f1f1f1fU, 0xddddddddU, 0xa8a8a8a8U, 0x33333333U, 0x88888888U, 0x07070707U, 0xc7c7c7c7U, 0x31313131U, 0xb1b1b1b1U, 0x12121212U, 0x10101010U, 0x59595959U, 0x27272727U, 0x80808080U, 0xececececU, 0x5f5f5f5fU, 0x60606060U, 0x51515151U, 0x7f7f7f7fU, 0xa9a9a9a9U, 0x19191919U, 0xb5b5b5b5U, 0x4a4a4a4aU, 0x0d0d0d0dU, 0x2d2d2d2dU, 0xe5e5e5e5U, 0x7a7a7a7aU, 0x9f9f9f9fU, 0x93939393U, 0xc9c9c9c9U, 0x9c9c9c9cU, 0xefefefefU, 0xa0a0a0a0U, 0xe0e0e0e0U, 0x3b3b3b3bU, 0x4d4d4d4dU, 0xaeaeaeaeU, 0x2a2a2a2aU, 0xf5f5f5f5U, 0xb0b0b0b0U, 0xc8c8c8c8U, 0xebebebebU, 0xbbbbbbbbU, 0x3c3c3c3cU, 0x83838383U, 0x53535353U, 0x99999999U, 0x61616161U, 0x17171717U, 0x2b2b2b2bU, 0x04040404U, 0x7e7e7e7eU, 0xbabababaU, 0x77777777U, 0xd6d6d6d6U, 0x26262626U, 0xe1e1e1e1U, 0x69696969U, 0x14141414U, 0x63636363U, 0x55555555U, 0x21212121U, 0x0c0c0c0cU, 0x7d7d7d7dU, }; static const u32 rcon[] = { 0x01000000, 0x02000000, 0x04000000, 0x08000000, 0x10000000, 0x20000000, 0x40000000, 0x80000000, 0x1B000000, 0x36000000, /* for 128-bit blocks, Rijndael never uses more than 10 rcon values */ }; #define SWAP(x) (_lrotl(x, 8) & 0x00ff00ff | _lrotr(x, 8) & 0xff00ff00) #ifdef _MSC_VER #define GETU32(p) SWAP(*((u32 *)(p))) #define PUTU32(ct, st) { *((u32 *)(ct)) = SWAP((st)); } #else #define GETU32(pt) (((u32)(pt)[0] << 24) ^ ((u32)(pt)[1] << 16) ^ ((u32)(pt)[2] << 8) ^ ((u32)(pt)[3])) #define PUTU32(ct, st) { (ct)[0] = (u8)((st) >> 24); (ct)[1] = (u8)((st) >> 16); (ct)[2] = (u8)((st) >> 8); (ct)[3] = (u8)(st); } #endif /** * Expand the cipher key into the encryption key schedule. * * @return the number of rounds for the given cipher key size. */ int rijndaelKeySetupEnc(u32 rk[/*4*(Nr + 1)*/], const u8 cipherKey[], int keyBits) { int i = 0; u32 temp; rk[0] = GETU32(cipherKey ); rk[1] = GETU32(cipherKey + 4); rk[2] = GETU32(cipherKey + 8); rk[3] = GETU32(cipherKey + 12); if (keyBits == 128) { for (;;) { temp = rk[3]; rk[4] = rk[0] ^ (Te4[(temp >> 16) & 0xff] & 0xff000000) ^ (Te4[(temp >> 8) & 0xff] & 0x00ff0000) ^ (Te4[(temp ) & 0xff] & 0x0000ff00) ^ (Te4[(temp >> 24) ] & 0x000000ff) ^ rcon[i]; rk[5] = rk[1] ^ rk[4]; rk[6] = rk[2] ^ rk[5]; rk[7] = rk[3] ^ rk[6]; if (++i == 10) { return 10; } rk += 4; } } rk[4] = GETU32(cipherKey + 16); rk[5] = GETU32(cipherKey + 20); if (keyBits == 192) { for (;;) { temp = rk[ 5]; rk[ 6] = rk[ 0] ^ (Te4[(temp >> 16) & 0xff] & 0xff000000) ^ (Te4[(temp >> 8) & 0xff] & 0x00ff0000) ^ (Te4[(temp ) & 0xff] & 0x0000ff00) ^ (Te4[(temp >> 24) ] & 0x000000ff) ^ rcon[i]; rk[ 7] = rk[ 1] ^ rk[ 6]; rk[ 8] = rk[ 2] ^ rk[ 7]; rk[ 9] = rk[ 3] ^ rk[ 8]; if (++i == 8) { return 12; } rk[10] = rk[ 4] ^ rk[ 9]; rk[11] = rk[ 5] ^ rk[10]; rk += 6; } } rk[6] = GETU32(cipherKey + 24); rk[7] = GETU32(cipherKey + 28); if (keyBits == 256) { for (;;) { temp = rk[ 7]; rk[ 8] = rk[ 0] ^ (Te4[(temp >> 16) & 0xff] & 0xff000000) ^ (Te4[(temp >> 8) & 0xff] & 0x00ff0000) ^ (Te4[(temp ) & 0xff] & 0x0000ff00) ^ (Te4[(temp >> 24) ] & 0x000000ff) ^ rcon[i]; rk[ 9] = rk[ 1] ^ rk[ 8]; rk[10] = rk[ 2] ^ rk[ 9]; rk[11] = rk[ 3] ^ rk[10]; if (++i == 7) { return 14; } temp = rk[11]; rk[12] = rk[ 4] ^ (Te4[(temp >> 24) ] & 0xff000000) ^ (Te4[(temp >> 16) & 0xff] & 0x00ff0000) ^ (Te4[(temp >> 8) & 0xff] & 0x0000ff00) ^ (Te4[(temp ) & 0xff] & 0x000000ff); rk[13] = rk[ 5] ^ rk[12]; rk[14] = rk[ 6] ^ rk[13]; rk[15] = rk[ 7] ^ rk[14]; rk += 8; } } return 0; } /** * Expand the cipher key into the decryption key schedule. * * @return the number of rounds for the given cipher key size. */ int rijndaelKeySetupDec(u32 rk[/*4*(Nr + 1)*/], const u8 cipherKey[], int keyBits) { int Nr, i, j; u32 temp; /* expand the cipher key: */ Nr = rijndaelKeySetupEnc(rk, cipherKey, keyBits); /* invert the order of the round keys: */ for (i = 0, j = 4*Nr; i < j; i += 4, j -= 4) { temp = rk[i ]; rk[i ] = rk[j ]; rk[j ] = temp; temp = rk[i + 1]; rk[i + 1] = rk[j + 1]; rk[j + 1] = temp; temp = rk[i + 2]; rk[i + 2] = rk[j + 2]; rk[j + 2] = temp; temp = rk[i + 3]; rk[i + 3] = rk[j + 3]; rk[j + 3] = temp; } /* apply the inverse MixColumn transform to all round keys but the first and the last: */ for (i = 1; i < Nr; i++) { rk += 4; rk[0] = Td0[Te4[(rk[0] >> 24) ] & 0xff] ^ Td1[Te4[(rk[0] >> 16) & 0xff] & 0xff] ^ Td2[Te4[(rk[0] >> 8) & 0xff] & 0xff] ^ Td3[Te4[(rk[0] ) & 0xff] & 0xff]; rk[1] = Td0[Te4[(rk[1] >> 24) ] & 0xff] ^ Td1[Te4[(rk[1] >> 16) & 0xff] & 0xff] ^ Td2[Te4[(rk[1] >> 8) & 0xff] & 0xff] ^ Td3[Te4[(rk[1] ) & 0xff] & 0xff]; rk[2] = Td0[Te4[(rk[2] >> 24) ] & 0xff] ^ Td1[Te4[(rk[2] >> 16) & 0xff] & 0xff] ^ Td2[Te4[(rk[2] >> 8) & 0xff] & 0xff] ^ Td3[Te4[(rk[2] ) & 0xff] & 0xff]; rk[3] = Td0[Te4[(rk[3] >> 24) ] & 0xff] ^ Td1[Te4[(rk[3] >> 16) & 0xff] & 0xff] ^ Td2[Te4[(rk[3] >> 8) & 0xff] & 0xff] ^ Td3[Te4[(rk[3] ) & 0xff] & 0xff]; } return Nr; } void rijndaelEncrypt(const u32 rk[/*4*(Nr + 1)*/], int Nr, const u8 pt[16], u8 ct[16]) { u32 s0, s1, s2, s3, t0, t1, t2, t3; #ifndef FULL_UNROLL int r; #endif /* ?FULL_UNROLL */ /* * map byte array block to cipher state * and add initial round key: */ s0 = GETU32(pt ) ^ rk[0]; s1 = GETU32(pt + 4) ^ rk[1]; s2 = GETU32(pt + 8) ^ rk[2]; s3 = GETU32(pt + 12) ^ rk[3]; #ifdef FULL_UNROLL /* round 1: */ t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[ 4]; t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[ 5]; t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[ 6]; t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[ 7]; /* round 2: */ s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[ 8]; s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[ 9]; s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[10]; s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[11]; /* round 3: */ t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[12]; t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[13]; t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[14]; t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[15]; /* round 4: */ s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[16]; s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[17]; s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[18]; s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[19]; /* round 5: */ t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[20]; t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[21]; t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[22]; t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[23]; /* round 6: */ s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[24]; s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[25]; s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[26]; s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[27]; /* round 7: */ t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[28]; t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[29]; t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[30]; t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[31]; /* round 8: */ s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[32]; s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[33]; s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[34]; s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[35]; /* round 9: */ t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[36]; t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[37]; t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[38]; t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[39]; if (Nr > 10) { /* round 10: */ s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[40]; s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[41]; s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[42]; s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[43]; /* round 11: */ t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[44]; t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[45]; t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[46]; t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[47]; if (Nr > 12) { /* round 12: */ s0 = Te0[t0 >> 24] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[t3 & 0xff] ^ rk[48]; s1 = Te0[t1 >> 24] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[t0 & 0xff] ^ rk[49]; s2 = Te0[t2 >> 24] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[t1 & 0xff] ^ rk[50]; s3 = Te0[t3 >> 24] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[t2 & 0xff] ^ rk[51]; /* round 13: */ t0 = Te0[s0 >> 24] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[s3 & 0xff] ^ rk[52]; t1 = Te0[s1 >> 24] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[s0 & 0xff] ^ rk[53]; t2 = Te0[s2 >> 24] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[s1 & 0xff] ^ rk[54]; t3 = Te0[s3 >> 24] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[s2 & 0xff] ^ rk[55]; } } rk += Nr << 2; #else /* !FULL_UNROLL */ /* * Nr - 1 full rounds: */ r = Nr >> 1; for (;;) { t0 = Te0[(s0 >> 24) ] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[(s3 ) & 0xff] ^ rk[4]; t1 = Te0[(s1 >> 24) ] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[(s0 ) & 0xff] ^ rk[5]; t2 = Te0[(s2 >> 24) ] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[(s1 ) & 0xff] ^ rk[6]; t3 = Te0[(s3 >> 24) ] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[(s2 ) & 0xff] ^ rk[7]; rk += 8; if (--r == 0) { break; } s0 = Te0[(t0 >> 24) ] ^ Te1[(t1 >> 16) & 0xff] ^ Te2[(t2 >> 8) & 0xff] ^ Te3[(t3 ) & 0xff] ^ rk[0]; s1 = Te0[(t1 >> 24) ] ^ Te1[(t2 >> 16) & 0xff] ^ Te2[(t3 >> 8) & 0xff] ^ Te3[(t0 ) & 0xff] ^ rk[1]; s2 = Te0[(t2 >> 24) ] ^ Te1[(t3 >> 16) & 0xff] ^ Te2[(t0 >> 8) & 0xff] ^ Te3[(t1 ) & 0xff] ^ rk[2]; s3 = Te0[(t3 >> 24) ] ^ Te1[(t0 >> 16) & 0xff] ^ Te2[(t1 >> 8) & 0xff] ^ Te3[(t2 ) & 0xff] ^ rk[3]; } #endif /* ?FULL_UNROLL */ /* * apply last round and * map cipher state to byte array block: */ s0 = (Te4[(t0 >> 24) ] & 0xff000000) ^ (Te4[(t1 >> 16) & 0xff] & 0x00ff0000) ^ (Te4[(t2 >> 8) & 0xff] & 0x0000ff00) ^ (Te4[(t3 ) & 0xff] & 0x000000ff) ^ rk[0]; PUTU32(ct , s0); s1 = (Te4[(t1 >> 24) ] & 0xff000000) ^ (Te4[(t2 >> 16) & 0xff] & 0x00ff0000) ^ (Te4[(t3 >> 8) & 0xff] & 0x0000ff00) ^ (Te4[(t0 ) & 0xff] & 0x000000ff) ^ rk[1]; PUTU32(ct + 4, s1); s2 = (Te4[(t2 >> 24) ] & 0xff000000) ^ (Te4[(t3 >> 16) & 0xff] & 0x00ff0000) ^ (Te4[(t0 >> 8) & 0xff] & 0x0000ff00) ^ (Te4[(t1 ) & 0xff] & 0x000000ff) ^ rk[2]; PUTU32(ct + 8, s2); s3 = (Te4[(t3 >> 24) ] & 0xff000000) ^ (Te4[(t0 >> 16) & 0xff] & 0x00ff0000) ^ (Te4[(t1 >> 8) & 0xff] & 0x0000ff00) ^ (Te4[(t2 ) & 0xff] & 0x000000ff) ^ rk[3]; PUTU32(ct + 12, s3); } void rijndaelDecrypt(const u32 rk[/*4*(Nr + 1)*/], int Nr, const u8 ct[16], u8 pt[16]) { u32 s0, s1, s2, s3, t0, t1, t2, t3; #ifndef FULL_UNROLL int r; #endif /* ?FULL_UNROLL */ /* * map byte array block to cipher state * and add initial round key: */ s0 = GETU32(ct ) ^ rk[0]; s1 = GETU32(ct + 4) ^ rk[1]; s2 = GETU32(ct + 8) ^ rk[2]; s3 = GETU32(ct + 12) ^ rk[3]; #ifdef FULL_UNROLL /* round 1: */ t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[ 4]; t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[ 5]; t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[ 6]; t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[ 7]; /* round 2: */ s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[ 8]; s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[ 9]; s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[10]; s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[11]; /* round 3: */ t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[12]; t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[13]; t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[14]; t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[15]; /* round 4: */ s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[16]; s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[17]; s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[18]; s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[19]; /* round 5: */ t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[20]; t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[21]; t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[22]; t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[23]; /* round 6: */ s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[24]; s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[25]; s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[26]; s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[27]; /* round 7: */ t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[28]; t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[29]; t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[30]; t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[31]; /* round 8: */ s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[32]; s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[33]; s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[34]; s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[35]; /* round 9: */ t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[36]; t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[37]; t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[38]; t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[39]; if (Nr > 10) { /* round 10: */ s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[40]; s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[41]; s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[42]; s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[43]; /* round 11: */ t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[44]; t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[45]; t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[46]; t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[47]; if (Nr > 12) { /* round 12: */ s0 = Td0[t0 >> 24] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[t1 & 0xff] ^ rk[48]; s1 = Td0[t1 >> 24] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[t2 & 0xff] ^ rk[49]; s2 = Td0[t2 >> 24] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[t3 & 0xff] ^ rk[50]; s3 = Td0[t3 >> 24] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[t0 & 0xff] ^ rk[51]; /* round 13: */ t0 = Td0[s0 >> 24] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[s1 & 0xff] ^ rk[52]; t1 = Td0[s1 >> 24] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[s2 & 0xff] ^ rk[53]; t2 = Td0[s2 >> 24] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[s3 & 0xff] ^ rk[54]; t3 = Td0[s3 >> 24] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[s0 & 0xff] ^ rk[55]; } } rk += Nr << 2; #else /* !FULL_UNROLL */ /* * Nr - 1 full rounds: */ r = Nr >> 1; for (;;) { t0 = Td0[(s0 >> 24) ] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[(s1 ) & 0xff] ^ rk[4]; t1 = Td0[(s1 >> 24) ] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[(s2 ) & 0xff] ^ rk[5]; t2 = Td0[(s2 >> 24) ] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[(s3 ) & 0xff] ^ rk[6]; t3 = Td0[(s3 >> 24) ] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[(s0 ) & 0xff] ^ rk[7]; rk += 8; if (--r == 0) { break; } s0 = Td0[(t0 >> 24) ] ^ Td1[(t3 >> 16) & 0xff] ^ Td2[(t2 >> 8) & 0xff] ^ Td3[(t1 ) & 0xff] ^ rk[0]; s1 = Td0[(t1 >> 24) ] ^ Td1[(t0 >> 16) & 0xff] ^ Td2[(t3 >> 8) & 0xff] ^ Td3[(t2 ) & 0xff] ^ rk[1]; s2 = Td0[(t2 >> 24) ] ^ Td1[(t1 >> 16) & 0xff] ^ Td2[(t0 >> 8) & 0xff] ^ Td3[(t3 ) & 0xff] ^ rk[2]; s3 = Td0[(t3 >> 24) ] ^ Td1[(t2 >> 16) & 0xff] ^ Td2[(t1 >> 8) & 0xff] ^ Td3[(t0 ) & 0xff] ^ rk[3]; } #endif /* ?FULL_UNROLL */ /* * apply last round and * map cipher state to byte array block: */ s0 = (Td4[(t0 >> 24) ] & 0xff000000) ^ (Td4[(t3 >> 16) & 0xff] & 0x00ff0000) ^ (Td4[(t2 >> 8) & 0xff] & 0x0000ff00) ^ (Td4[(t1 ) & 0xff] & 0x000000ff) ^ rk[0]; PUTU32(pt , s0); s1 = (Td4[(t1 >> 24) ] & 0xff000000) ^ (Td4[(t0 >> 16) & 0xff] & 0x00ff0000) ^ (Td4[(t3 >> 8) & 0xff] & 0x0000ff00) ^ (Td4[(t2 ) & 0xff] & 0x000000ff) ^ rk[1]; PUTU32(pt + 4, s1); s2 = (Td4[(t2 >> 24) ] & 0xff000000) ^ (Td4[(t1 >> 16) & 0xff] & 0x00ff0000) ^ (Td4[(t0 >> 8) & 0xff] & 0x0000ff00) ^ (Td4[(t3 ) & 0xff] & 0x000000ff) ^ rk[2]; PUTU32(pt + 8, s2); s3 = (Td4[(t3 >> 24) ] & 0xff000000) ^ (Td4[(t2 >> 16) & 0xff] & 0x00ff0000) ^ (Td4[(t1 >> 8) & 0xff] & 0x0000ff00) ^ (Td4[(t0 ) & 0xff] & 0x000000ff) ^ rk[3]; PUTU32(pt + 12, s3); } #ifdef INTERMEDIATE_VALUE_KAT void rijndaelEncryptRound(const u32 rk[/*4*(Nr + 1)*/], int Nr, u8 block[16], int rounds) { int r; u32 s0, s1, s2, s3, t0, t1, t2, t3; /* * map byte array block to cipher state * and add initial round key: */ s0 = GETU32(block ) ^ rk[0]; s1 = GETU32(block + 4) ^ rk[1]; s2 = GETU32(block + 8) ^ rk[2]; s3 = GETU32(block + 12) ^ rk[3]; rk += 4; /* * Nr - 1 full rounds: */ for (r = (rounds < Nr ? rounds : Nr - 1); r > 0; r--) { t0 = Te0[(s0 >> 24) ] ^ Te1[(s1 >> 16) & 0xff] ^ Te2[(s2 >> 8) & 0xff] ^ Te3[(s3 ) & 0xff] ^ rk[0]; t1 = Te0[(s1 >> 24) ] ^ Te1[(s2 >> 16) & 0xff] ^ Te2[(s3 >> 8) & 0xff] ^ Te3[(s0 ) & 0xff] ^ rk[1]; t2 = Te0[(s2 >> 24) ] ^ Te1[(s3 >> 16) & 0xff] ^ Te2[(s0 >> 8) & 0xff] ^ Te3[(s1 ) & 0xff] ^ rk[2]; t3 = Te0[(s3 >> 24) ] ^ Te1[(s0 >> 16) & 0xff] ^ Te2[(s1 >> 8) & 0xff] ^ Te3[(s2 ) & 0xff] ^ rk[3]; s0 = t0; s1 = t1; s2 = t2; s3 = t3; rk += 4; } /* * apply last round and * map cipher state to byte array block: */ if (rounds == Nr) { t0 = (Te4[(s0 >> 24) ] & 0xff000000) ^ (Te4[(s1 >> 16) & 0xff] & 0x00ff0000) ^ (Te4[(s2 >> 8) & 0xff] & 0x0000ff00) ^ (Te4[(s3 ) & 0xff] & 0x000000ff) ^ rk[0]; t1 = (Te4[(s1 >> 24) ] & 0xff000000) ^ (Te4[(s2 >> 16) & 0xff] & 0x00ff0000) ^ (Te4[(s3 >> 8) & 0xff] & 0x0000ff00) ^ (Te4[(s0 ) & 0xff] & 0x000000ff) ^ rk[1]; t2 = (Te4[(s2 >> 24) ] & 0xff000000) ^ (Te4[(s3 >> 16) & 0xff] & 0x00ff0000) ^ (Te4[(s0 >> 8) & 0xff] & 0x0000ff00) ^ (Te4[(s1 ) & 0xff] & 0x000000ff) ^ rk[2]; t3 = (Te4[(s3 >> 24) ] & 0xff000000) ^ (Te4[(s0 >> 16) & 0xff] & 0x00ff0000) ^ (Te4[(s1 >> 8) & 0xff] & 0x0000ff00) ^ (Te4[(s2 ) & 0xff] & 0x000000ff) ^ rk[3]; s0 = t0; s1 = t1; s2 = t2; s3 = t3; } PUTU32(block , s0); PUTU32(block + 4, s1); PUTU32(block + 8, s2); PUTU32(block + 12, s3); } void rijndaelDecryptRound(const u32 rk[/*4*(Nr + 1)*/], int Nr, u8 block[16], int rounds) { int r; u32 s0, s1, s2, s3, t0, t1, t2, t3; /* * map byte array block to cipher state * and add initial round key: */ s0 = GETU32(block ) ^ rk[0]; s1 = GETU32(block + 4) ^ rk[1]; s2 = GETU32(block + 8) ^ rk[2]; s3 = GETU32(block + 12) ^ rk[3]; rk += 4; /* * Nr - 1 full rounds: */ for (r = (rounds < Nr ? rounds : Nr) - 1; r > 0; r--) { t0 = Td0[(s0 >> 24) ] ^ Td1[(s3 >> 16) & 0xff] ^ Td2[(s2 >> 8) & 0xff] ^ Td3[(s1 ) & 0xff] ^ rk[0]; t1 = Td0[(s1 >> 24) ] ^ Td1[(s0 >> 16) & 0xff] ^ Td2[(s3 >> 8) & 0xff] ^ Td3[(s2 ) & 0xff] ^ rk[1]; t2 = Td0[(s2 >> 24) ] ^ Td1[(s1 >> 16) & 0xff] ^ Td2[(s0 >> 8) & 0xff] ^ Td3[(s3 ) & 0xff] ^ rk[2]; t3 = Td0[(s3 >> 24) ] ^ Td1[(s2 >> 16) & 0xff] ^ Td2[(s1 >> 8) & 0xff] ^ Td3[(s0 ) & 0xff] ^ rk[3]; s0 = t0; s1 = t1; s2 = t2; s3 = t3; rk += 4; } /* * complete the last round and * map cipher state to byte array block: */ t0 = (Td4[(s0 >> 24) ] & 0xff000000) ^ (Td4[(s3 >> 16) & 0xff] & 0x00ff0000) ^ (Td4[(s2 >> 8) & 0xff] & 0x0000ff00) ^ (Td4[(s1 ) & 0xff] & 0x000000ff); t1 = (Td4[(s1 >> 24) ] & 0xff000000) ^ (Td4[(s0 >> 16) & 0xff] & 0x00ff0000) ^ (Td4[(s3 >> 8) & 0xff] & 0x0000ff00) ^ (Td4[(s2 ) & 0xff] & 0x000000ff); t2 = (Td4[(s2 >> 24) ] & 0xff000000) ^ (Td4[(s1 >> 16) & 0xff] & 0x00ff0000) ^ (Td4[(s0 >> 8) & 0xff] & 0x0000ff00) ^ (Td4[(s3 ) & 0xff] & 0x000000ff); t3 = (Td4[(s3 >> 24) ] & 0xff000000) ^ (Td4[(s2 >> 16) & 0xff] & 0x00ff0000) ^ (Td4[(s1 >> 8) & 0xff] & 0x0000ff00) ^ (Td4[(s0 ) & 0xff] & 0x000000ff); if (rounds == Nr) { t0 ^= rk[0]; t1 ^= rk[1]; t2 ^= rk[2]; t3 ^= rk[3]; } PUTU32(block , t0); PUTU32(block + 4, t1); PUTU32(block + 8, t2); PUTU32(block + 12, t3); } #endif /* INTERMEDIATE_VALUE_KAT */ cryptokit-1.9/src/rijndael-alg-fst.h0000644000175000017500000000365311436706614017037 0ustar gildorgildor/** * rijndael-alg-fst.h * * @version 3.0 (December 2000) * * Optimised ANSI C code for the Rijndael cipher (now AES) * * @author Vincent Rijmen * @author Antoon Bosselaers * @author Paulo Barreto * * This code is hereby placed in the public domain. * * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifndef __RIJNDAEL_ALG_FST_H #define __RIJNDAEL_ALG_FST_H #define MAXKC (256/32) #define MAXKB (256/8) #define MAXNR 14 typedef unsigned char u8; typedef unsigned short u16; typedef unsigned int u32; int rijndaelKeySetupEnc(u32 rk[/*4*(Nr + 1)*/], const u8 cipherKey[], int keyBits); int rijndaelKeySetupDec(u32 rk[/*4*(Nr + 1)*/], const u8 cipherKey[], int keyBits); void rijndaelEncrypt(const u32 rk[/*4*(Nr + 1)*/], int Nr, const u8 pt[16], u8 ct[16]); void rijndaelDecrypt(const u32 rk[/*4*(Nr + 1)*/], int Nr, const u8 ct[16], u8 pt[16]); #ifdef INTERMEDIATE_VALUE_KAT void rijndaelEncryptRound(const u32 rk[/*4*(Nr + 1)*/], int Nr, u8 block[16], int rounds); void rijndaelDecryptRound(const u32 rk[/*4*(Nr + 1)*/], int Nr, u8 block[16], int rounds); #endif /* INTERMEDIATE_VALUE_KAT */ #endif /* __RIJNDAEL_ALG_FST_H */ cryptokit-1.9/src/stubs-misc.c0000644000175000017500000000327711436706614016002 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-misc.c 53 2010-08-30 10:53:00Z gildor-admin $ */ #include #define ALIGNMENT_OF(x) ((long)(x) & (sizeof(long) - 1)) CAMLprim value caml_xor_string(value src, value src_ofs, value dst, value dst_ofs, value len) { char * s = &Byte(src, Long_val(src_ofs)); char * d = &Byte(dst, Long_val(dst_ofs)); long l = Long_val(len); if (l >= 64 && ALIGNMENT_OF(s) == ALIGNMENT_OF(d)) { while (ALIGNMENT_OF(s) != 0 && l > 0) { *d ^= *s; s += 1; d += 1; l -= 1; } while (l >= sizeof(long)) { *((long *) d) ^= *((long *) s); s += sizeof(long); d += sizeof(long); l -= sizeof(long); } } while (l > 0) { *d ^= *s; s += 1; d += 1; l -= 1; } return Val_unit; } cryptokit-1.9/src/stubs-sha1.c0000644000175000017500000000312311436706614015671 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-sha1.c 53 2010-08-30 10:53:00Z gildor-admin $ */ #include "sha1.h" #include #include #include #define Context_val(v) ((struct SHA1Context *) String_val(v)) CAMLprim value caml_sha1_init(value unit) { value ctx = alloc_string(sizeof(struct SHA1Context)); SHA1_init(Context_val(ctx)); return ctx; } CAMLprim value caml_sha1_update(value ctx, value src, value ofs, value len) { SHA1_add_data(Context_val(ctx), &Byte_u(src, Long_val(ofs)), Long_val(len)); return Val_unit; } CAMLprim value caml_sha1_final(value ctx) { CAMLparam1(ctx); CAMLlocal1(res); res = alloc_string(20); SHA1_finish(Context_val(ctx), &Byte_u(res, 0)); CAMLreturn(res); } cryptokit-1.9/src/sha1.c0000644000175000017500000001151411436706614014536 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: sha1.c 53 2010-08-30 10:53:00Z gildor-admin $ */ /* SHA-1 hashing */ #include #include #include "sha1.h" /* Ref: Handbook of Applied Cryptography, section 9.4.2, algorithm 9.53 */ #define rol1(x) (((x) << 1) | ((x) >> 31)) #define rol5(x) (((x) << 5) | ((x) >> 27)) #define rol30(x) (((x) << 30) | ((x) >> 2)) static void SHA1_copy_and_swap(void * src, void * dst, int numwords) { #ifdef ARCH_BIG_ENDIAN memcpy(dst, src, numwords * sizeof(u32)); #else unsigned char * s, * d; unsigned char a, b; for (s = src, d = dst; numwords > 0; s += 4, d += 4, numwords--) { a = s[0]; b = s[1]; d[0] = s[3]; d[1] = s[2]; d[2] = b; d[3] = a; } #endif } #define F(x,y,z) ( z ^ (x & (y ^ z) ) ) #define G(x,y,z) ( (x & y) | (z & (x | y) ) ) #define H(x,y,z) ( x ^ y ^ z ) #define Y1 0x5A827999U #define Y2 0x6ED9EBA1U #define Y3 0x8F1BBCDCU #define Y4 0xCA62C1D6U static void SHA1_transform(struct SHA1Context * ctx) { int i; register u32 a, b, c, d, e, t; u32 data[80]; /* Convert buffer data to 16 big-endian integers */ SHA1_copy_and_swap(ctx->buffer, data, 16); /* Expand into 80 integers */ for (i = 16; i < 80; i++) { t = data[i-3] ^ data[i-8] ^ data[i-14] ^ data[i-16]; data[i] = rol1(t); } /* Initialize working variables */ a = ctx->state[0]; b = ctx->state[1]; c = ctx->state[2]; d = ctx->state[3]; e = ctx->state[4]; /* Perform rounds */ for (i = 0; i < 20; i++) { t = F(b, c, d) + Y1 + rol5(a) + e + data[i]; e = d; d = c; c = rol30(b); b = a; a = t; } for (/*nothing*/; i < 40; i++) { t = H(b, c, d) + Y2 + rol5(a) + e + data[i]; e = d; d = c; c = rol30(b); b = a; a = t; } for (/*nothing*/; i < 60; i++) { t = G(b, c, d) + Y3 + rol5(a) + e + data[i]; e = d; d = c; c = rol30(b); b = a; a = t; } for (/*nothing*/; i < 80; i++) { t = H(b, c, d) + Y4 + rol5(a) + e + data[i]; e = d; d = c; c = rol30(b); b = a; a = t; } /* Update chaining values */ ctx->state[0] += a; ctx->state[1] += b; ctx->state[2] += c; ctx->state[3] += d; ctx->state[4] += e; } void SHA1_init(struct SHA1Context * ctx) { ctx->state[0] = 0x67452301U; ctx->state[1] = 0xEFCDAB89U; ctx->state[2] = 0x98BADCFEU; ctx->state[3] = 0x10325476U; ctx->state[4] = 0xC3D2E1F0U; ctx->numbytes = 0; ctx->length[0] = 0; ctx->length[1] = 0; } void SHA1_add_data(struct SHA1Context * ctx, unsigned char * data, unsigned long len) { u32 t; /* Update length */ t = ctx->length[1]; if ((ctx->length[1] = t + (u32) (len << 3)) < t) ctx->length[0]++; /* carry from low 32 bits to high 32 bits */ ctx->length[0] += (u32) (len >> 29); /* If data was left in buffer, pad it with fresh data and munge block */ if (ctx->numbytes != 0) { t = 64 - ctx->numbytes; if (len < t) { memcpy(ctx->buffer + ctx->numbytes, data, len); ctx->numbytes += len; return; } memcpy(ctx->buffer + ctx->numbytes, data, t); SHA1_transform(ctx); data += t; len -= t; } /* Munge data in 64-byte chunks */ while (len >= 64) { memcpy(ctx->buffer, data, 64); SHA1_transform(ctx); data += 64; len -= 64; } /* Save remaining data */ memcpy(ctx->buffer, data, len); ctx->numbytes = len; } void SHA1_finish(struct SHA1Context * ctx, unsigned char output[20]) { int i = ctx->numbytes; /* Set first char of padding to 0x80. There is always room. */ ctx->buffer[i++] = 0x80; /* If we do not have room for the length (8 bytes), pad to 64 bytes with zeroes and munge the data block */ if (i > 56) { memset(ctx->buffer + i, 0, 64 - i); SHA1_transform(ctx); i = 0; } /* Pad to byte 56 with zeroes */ memset(ctx->buffer + i, 0, 56 - i); /* Add length in big-endian */ SHA1_copy_and_swap(ctx->length, ctx->buffer + 56, 2); /* Munge the final block */ SHA1_transform(ctx); /* Final hash value is in ctx->state modulo big-endian conversion */ SHA1_copy_and_swap(ctx->state, output, 5); } cryptokit-1.9/src/stubs-sha3.c0000644000175000017500000000473412135543724015702 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Gallium, INRIA Rocquencourt */ /* */ /* Copyright 2013 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: stubs-sha1.c 53 2010-08-30 10:53:00Z gildor-admin $ */ #include #include "keccak.h" #include #include #include #include #define Context_val(v) (*((struct SHA3Context **) Data_custom_val(v))) static void caml_sha3_finalize(value ctx) { if (Context_val(ctx) != NULL) { caml_stat_free(Context_val(ctx)); Context_val(ctx) = NULL; } } static struct custom_operations SHA3_context_ops = { "fr.inria.caml.cryptokit.SHA3_context", caml_sha3_finalize, custom_compare_default, custom_hash_default, custom_deserialize_default, custom_compare_ext_default }; CAMLprim value caml_sha3_init(value vsize) { struct SHA3Context * ctx = caml_stat_alloc(sizeof(struct SHA3Context)); value res = caml_alloc_custom(&SHA3_context_ops, sizeof(struct SHA3Context *), 0, 1); SHA3_init(ctx, Int_val(vsize)); Context_val(res) = ctx; return res; } CAMLprim value caml_sha3_absorb(value ctx, value src, value ofs, value len) { SHA3_absorb(Context_val(ctx), &Byte_u(src, Long_val(ofs)), Long_val(len)); return Val_unit; } CAMLprim value caml_sha3_extract(value ctx) { CAMLparam1(ctx); CAMLlocal1(res); res = alloc_string(Context_val(ctx)->hsiz); SHA3_extract(Context_val(ctx), &Byte_u(res, 0)); CAMLreturn(res); } CAMLprim value caml_sha3_wipe(value ctx) { if (Context_val(ctx) != NULL) { memset(Context_val(ctx), 0, sizeof(struct SHA3Context)); caml_stat_free(Context_val(ctx)); Context_val(ctx) = NULL; } return Val_unit; } cryptokit-1.9/src/sha1.h0000644000175000017500000000247711436706614014553 0ustar gildorgildor/***********************************************************************/ /* */ /* The Cryptokit library */ /* */ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 2002 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file LICENSE. */ /* */ /***********************************************************************/ /* $Id: sha1.h 53 2010-08-30 10:53:00Z gildor-admin $ */ /* SHA-1 hashing */ typedef unsigned int u32; struct SHA1Context { u32 state[5]; u32 length[2]; int numbytes; unsigned char buffer[64]; }; extern void SHA1_init(struct SHA1Context * ctx); extern void SHA1_add_data(struct SHA1Context * ctx, unsigned char * data, unsigned long len); extern void SHA1_finish(struct SHA1Context * ctx, unsigned char output[20]); cryptokit-1.9/ardivink.lua0000644000175000017500000000065312160414527015255 0ustar gildorgildorci = require("ci") oasis = require("oasis") dist = require("dist") ci.init() oasis.init() ci.prependenv("PATH", "/usr/opt/godi/bin") ci.prependenv("PATH", "/usr/opt/godi/sbin") ci.putenv("OUNIT_OUTPUT_HTML_DIR", dist.make_filename("ounit-log.html")) ci.putenv("OUNIT_OUTPUT_JUNIT_FILE", dist.make_filename("junit.xml")) ci.putenv("OUNIT_OUTPUT_FILE", dist.make_filename("ounit-log.txt")) oasis.std_process("--enable-tests") cryptokit-1.9/setup.ml0000644000175000017500000055215712204237263014447 0ustar gildorgildor(* setup.ml generated for the first time by OASIS v0.1.0 *) (* OASIS_START *) (* DO NOT EDIT (digest: 9bf18d66068e558957599858f22a0bd2) *) (* Regenerated by OASIS v0.3.1 Visit http://oasis.forge.ocamlcore.org for more information and documentation about functions used in this file. *) module OASISGettext = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISGettext.ml" let ns_ str = str let s_ str = str let f_ (str : ('a, 'b, 'c, 'd) format4) = str let fn_ fmt1 fmt2 n = if n = 1 then fmt1^^"" else fmt2^^"" let init = [] end module OASISContext = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISContext.ml" open OASISGettext type level = [ `Debug | `Info | `Warning | `Error] type t = { quiet: bool; info: bool; debug: bool; ignore_plugins: bool; ignore_unknown_fields: bool; printf: level -> string -> unit; } let printf lvl str = let beg = match lvl with | `Error -> s_ "E: " | `Warning -> s_ "W: " | `Info -> s_ "I: " | `Debug -> s_ "D: " in prerr_endline (beg^str) let default = ref { quiet = false; info = false; debug = false; ignore_plugins = false; ignore_unknown_fields = false; printf = printf; } let quiet = {!default with quiet = true} let args () = ["-quiet", Arg.Unit (fun () -> default := {!default with quiet = true}), (s_ " Run quietly"); "-info", Arg.Unit (fun () -> default := {!default with info = true}), (s_ " Display information message"); "-debug", Arg.Unit (fun () -> default := {!default with debug = true}), (s_ " Output debug message")] end module OASISString = struct # 1 "/home/gildor/programmation/oasis/src/oasis/OASISString.ml" (** Various string utilities. Mostly inspired by extlib and batteries ExtString and BatString libraries. @author Sylvain Le Gall *) let nsplitf str f = if str = "" then [] else let buf = Buffer.create 13 in let lst = ref [] in let push () = lst := Buffer.contents buf :: !lst; Buffer.clear buf in let str_len = String.length str in for i = 0 to str_len - 1 do if f str.[i] then push () else Buffer.add_char buf str.[i] done; push (); List.rev !lst (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the separator. *) let nsplit str c = nsplitf str ((=) c) let find ~what ?(offset=0) str = let what_idx = ref 0 in let str_idx = ref offset in while !str_idx < String.length str && !what_idx < String.length what do if str.[!str_idx] = what.[!what_idx] then incr what_idx else what_idx := 0; incr str_idx done; if !what_idx <> String.length what then raise Not_found else !str_idx - !what_idx let sub_start str len = let str_len = String.length str in if len >= str_len then "" else String.sub str len (str_len - len) let sub_end ?(offset=0) str len = let str_len = String.length str in if len >= str_len then "" else String.sub str 0 (str_len - len) let starts_with ~what ?(offset=0) str = let what_idx = ref 0 in let str_idx = ref offset in let ok = ref true in while !ok && !str_idx < String.length str && !what_idx < String.length what do if str.[!str_idx] = what.[!what_idx] then incr what_idx else ok := false; incr str_idx done; if !what_idx = String.length what then true else false let strip_starts_with ~what str = if starts_with ~what str then sub_start str (String.length what) else raise Not_found let ends_with ~what ?(offset=0) str = let what_idx = ref ((String.length what) - 1) in let str_idx = ref ((String.length str) - 1) in let ok = ref true in while !ok && offset <= !str_idx && 0 <= !what_idx do if str.[!str_idx] = what.[!what_idx] then decr what_idx else ok := false; decr str_idx done; if !what_idx = -1 then true else false let strip_ends_with ~what str = if ends_with ~what str then sub_end str (String.length what) else raise Not_found let replace_chars f s = let buf = String.make (String.length s) 'X' in for i = 0 to String.length s - 1 do buf.[i] <- f s.[i] done; buf end module OASISUtils = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISUtils.ml" open OASISGettext module MapString = Map.Make(String) let map_string_of_assoc assoc = List.fold_left (fun acc (k, v) -> MapString.add k v acc) MapString.empty assoc module SetString = Set.Make(String) let set_string_add_list st lst = List.fold_left (fun acc e -> SetString.add e acc) st lst let set_string_of_list = set_string_add_list SetString.empty let compare_csl s1 s2 = String.compare (String.lowercase s1) (String.lowercase s2) module HashStringCsl = Hashtbl.Make (struct type t = string let equal s1 s2 = (String.lowercase s1) = (String.lowercase s2) let hash s = Hashtbl.hash (String.lowercase s) end) let varname_of_string ?(hyphen='_') s = if String.length s = 0 then begin invalid_arg "varname_of_string" end else begin let buf = OASISString.replace_chars (fun c -> if ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') || ('0' <= c && c <= '9') then c else hyphen) s; in let buf = (* Start with a _ if digit *) if '0' <= s.[0] && s.[0] <= '9' then "_"^buf else buf in String.lowercase buf end let varname_concat ?(hyphen='_') p s = let what = String.make 1 hyphen in let p = try OASISString.strip_ends_with ~what p with Not_found -> p in let s = try OASISString.strip_starts_with ~what s with Not_found -> s in p^what^s let is_varname str = str = varname_of_string str let failwithf fmt = Printf.ksprintf failwith fmt end module PropList = struct # 21 "/home/gildor/programmation/oasis/src/oasis/PropList.ml" open OASISGettext type name = string exception Not_set of name * string option exception No_printer of name exception Unknown_field of name * name let () = Printexc.register_printer (function | Not_set (nm, Some rsn) -> Some (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn) | Not_set (nm, None) -> Some (Printf.sprintf (f_ "Field '%s' is not set") nm) | No_printer nm -> Some (Printf.sprintf (f_ "No default printer for value %s") nm) | Unknown_field (nm, schm) -> Some (Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm) | _ -> None) module Data = struct type t = (name, unit -> unit) Hashtbl.t let create () = Hashtbl.create 13 let clear t = Hashtbl.clear t # 71 "/home/gildor/programmation/oasis/src/oasis/PropList.ml" end module Schema = struct type ('ctxt, 'extra) value = { get: Data.t -> string; set: Data.t -> ?context:'ctxt -> string -> unit; help: (unit -> string) option; extra: 'extra; } type ('ctxt, 'extra) t = { name: name; fields: (name, ('ctxt, 'extra) value) Hashtbl.t; order: name Queue.t; name_norm: string -> string; } let create ?(case_insensitive=false) nm = { name = nm; fields = Hashtbl.create 13; order = Queue.create (); name_norm = (if case_insensitive then String.lowercase else fun s -> s); } let add t nm set get extra help = let key = t.name_norm nm in if Hashtbl.mem t.fields key then failwith (Printf.sprintf (f_ "Field '%s' is already defined in schema '%s'") nm t.name); Hashtbl.add t.fields key { set = set; get = get; help = help; extra = extra; }; Queue.add nm t.order let mem t nm = Hashtbl.mem t.fields nm let find t nm = try Hashtbl.find t.fields (t.name_norm nm) with Not_found -> raise (Unknown_field (nm, t.name)) let get t data nm = (find t nm).get data let set t data nm ?context x = (find t nm).set data ?context x let fold f acc t = Queue.fold (fun acc k -> let v = find t k in f acc k v.extra v.help) acc t.order let iter f t = fold (fun () -> f) () t let name t = t.name end module Field = struct type ('ctxt, 'value, 'extra) t = { set: Data.t -> ?context:'ctxt -> 'value -> unit; get: Data.t -> 'value; sets: Data.t -> ?context:'ctxt -> string -> unit; gets: Data.t -> string; help: (unit -> string) option; extra: 'extra; } let new_id = let last_id = ref 0 in fun () -> incr last_id; !last_id let create ?schema ?name ?parse ?print ?default ?update ?help extra = (* Default value container *) let v = ref None in (* If name is not given, create unique one *) let nm = match name with | Some s -> s | None -> Printf.sprintf "_anon_%d" (new_id ()) in (* Last chance to get a value: the default *) let default () = match default with | Some d -> d | None -> raise (Not_set (nm, Some (s_ "no default value"))) in (* Get data *) let get data = (* Get value *) try (Hashtbl.find data nm) (); match !v with | Some x -> x | None -> default () with Not_found -> default () in (* Set data *) let set data ?context x = let x = match update with | Some f -> begin try f ?context (get data) x with Not_set _ -> x end | None -> x in Hashtbl.replace data nm (fun () -> v := Some x) in (* Parse string value, if possible *) let parse = match parse with | Some f -> f | None -> fun ?context s -> failwith (Printf.sprintf (f_ "Cannot parse field '%s' when setting value %S") nm s) in (* Set data, from string *) let sets data ?context s = set ?context data (parse ?context s) in (* Output value as string, if possible *) let print = match print with | Some f -> f | None -> fun _ -> raise (No_printer nm) in (* Get data, as a string *) let gets data = print (get data) in begin match schema with | Some t -> Schema.add t nm sets gets extra help | None -> () end; { set = set; get = get; sets = sets; gets = gets; help = help; extra = extra; } let fset data t ?context x = t.set data ?context x let fget data t = t.get data let fsets data t ?context s = t.sets data ?context s let fgets data t = t.gets data end module FieldRO = struct let create ?schema ?name ?parse ?print ?default ?update ?help extra = let fld = Field.create ?schema ?name ?parse ?print ?default ?update ?help extra in fun data -> Field.fget data fld end end module OASISMessage = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISMessage.ml" open OASISGettext open OASISContext let generic_message ~ctxt lvl fmt = let cond = if ctxt.quiet then false else match lvl with | `Debug -> ctxt.debug | `Info -> ctxt.info | _ -> true in Printf.ksprintf (fun str -> if cond then begin ctxt.printf lvl str end) fmt let debug ~ctxt fmt = generic_message ~ctxt `Debug fmt let info ~ctxt fmt = generic_message ~ctxt `Info fmt let warning ~ctxt fmt = generic_message ~ctxt `Warning fmt let error ~ctxt fmt = generic_message ~ctxt `Error fmt end module OASISVersion = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISVersion.ml" open OASISGettext type s = string type t = string type comparator = | VGreater of t | VGreaterEqual of t | VEqual of t | VLesser of t | VLesserEqual of t | VOr of comparator * comparator | VAnd of comparator * comparator (* Range of allowed characters *) let is_digit c = '0' <= c && c <= '9' let is_alpha c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') let is_special = function | '.' | '+' | '-' | '~' -> true | _ -> false let rec version_compare v1 v2 = if v1 <> "" || v2 <> "" then begin (* Compare ascii string, using special meaning for version * related char *) let val_ascii c = if c = '~' then -1 else if is_digit c then 0 else if c = '\000' then 0 else if is_alpha c then Char.code c else (Char.code c) + 256 in let len1 = String.length v1 in let len2 = String.length v2 in let p = ref 0 in (** Compare ascii part *) let compare_vascii () = let cmp = ref 0 in while !cmp = 0 && !p < len1 && !p < len2 && not (is_digit v1.[!p] && is_digit v2.[!p]) do cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]); incr p done; if !cmp = 0 && !p < len1 && !p = len2 then val_ascii v1.[!p] else if !cmp = 0 && !p = len1 && !p < len2 then - (val_ascii v2.[!p]) else !cmp in (** Compare digit part *) let compare_digit () = let extract_int v p = let start_p = !p in while !p < String.length v && is_digit v.[!p] do incr p done; let substr = String.sub v !p ((String.length v) - !p) in let res = match String.sub v start_p (!p - start_p) with | "" -> 0 | s -> int_of_string s in res, substr in let i1, tl1 = extract_int v1 (ref !p) in let i2, tl2 = extract_int v2 (ref !p) in i1 - i2, tl1, tl2 in match compare_vascii () with | 0 -> begin match compare_digit () with | 0, tl1, tl2 -> if tl1 <> "" && is_digit tl1.[0] then 1 else if tl2 <> "" && is_digit tl2.[0] then -1 else version_compare tl1 tl2 | n, _, _ -> n end | n -> n end else begin 0 end let version_of_string str = str let string_of_version t = t let chop t = try let pos = String.rindex t '.' in String.sub t 0 pos with Not_found -> t let rec comparator_apply v op = match op with | VGreater cv -> (version_compare v cv) > 0 | VGreaterEqual cv -> (version_compare v cv) >= 0 | VLesser cv -> (version_compare v cv) < 0 | VLesserEqual cv -> (version_compare v cv) <= 0 | VEqual cv -> (version_compare v cv) = 0 | VOr (op1, op2) -> (comparator_apply v op1) || (comparator_apply v op2) | VAnd (op1, op2) -> (comparator_apply v op1) && (comparator_apply v op2) let rec string_of_comparator = function | VGreater v -> "> "^(string_of_version v) | VEqual v -> "= "^(string_of_version v) | VLesser v -> "< "^(string_of_version v) | VGreaterEqual v -> ">= "^(string_of_version v) | VLesserEqual v -> "<= "^(string_of_version v) | VOr (c1, c2) -> (string_of_comparator c1)^" || "^(string_of_comparator c2) | VAnd (c1, c2) -> (string_of_comparator c1)^" && "^(string_of_comparator c2) let rec varname_of_comparator = let concat p v = OASISUtils.varname_concat p (OASISUtils.varname_of_string (string_of_version v)) in function | VGreater v -> concat "gt" v | VLesser v -> concat "lt" v | VEqual v -> concat "eq" v | VGreaterEqual v -> concat "ge" v | VLesserEqual v -> concat "le" v | VOr (c1, c2) -> (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2) | VAnd (c1, c2) -> (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2) let version_0_3_or_after t = comparator_apply t (VGreaterEqual (string_of_version "0.3")) end module OASISLicense = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISLicense.ml" (** License for _oasis fields @author Sylvain Le Gall *) type license = string type license_exception = string type license_version = | Version of OASISVersion.t | VersionOrLater of OASISVersion.t | NoVersion type license_dep_5_unit = { license: license; excption: license_exception option; version: license_version; } type license_dep_5 = | DEP5Unit of license_dep_5_unit | DEP5Or of license_dep_5 list | DEP5And of license_dep_5 list type t = | DEP5License of license_dep_5 | OtherLicense of string (* URL *) end module OASISExpr = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISExpr.ml" open OASISGettext type test = string type flag = string type t = | EBool of bool | ENot of t | EAnd of t * t | EOr of t * t | EFlag of flag | ETest of test * string type 'a choices = (t * 'a) list let eval var_get t = let rec eval' = function | EBool b -> b | ENot e -> not (eval' e) | EAnd (e1, e2) -> (eval' e1) && (eval' e2) | EOr (e1, e2) -> (eval' e1) || (eval' e2) | EFlag nm -> let v = var_get nm in assert(v = "true" || v = "false"); (v = "true") | ETest (nm, vl) -> let v = var_get nm in (v = vl) in eval' t let choose ?printer ?name var_get lst = let rec choose_aux = function | (cond, vl) :: tl -> if eval var_get cond then vl else choose_aux tl | [] -> let str_lst = if lst = [] then s_ "" else String.concat (s_ ", ") (List.map (fun (cond, vl) -> match printer with | Some p -> p vl | None -> s_ "") lst) in match name with | Some nm -> failwith (Printf.sprintf (f_ "No result for the choice list '%s': %s") nm str_lst) | None -> failwith (Printf.sprintf (f_ "No result for a choice list: %s") str_lst) in choose_aux (List.rev lst) end module OASISTypes = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISTypes.ml" type name = string type package_name = string type url = string type unix_dirname = string type unix_filename = string type host_dirname = string type host_filename = string type prog = string type arg = string type args = string list type command_line = (prog * arg list) type findlib_name = string type findlib_full = string type compiled_object = | Byte | Native | Best type dependency = | FindlibPackage of findlib_full * OASISVersion.comparator option | InternalLibrary of name type tool = | ExternalTool of name | InternalExecutable of name type vcs = | Darcs | Git | Svn | Cvs | Hg | Bzr | Arch | Monotone | OtherVCS of url type plugin_kind = [ `Configure | `Build | `Doc | `Test | `Install | `Extra ] type plugin_data_purpose = [ `Configure | `Build | `Install | `Clean | `Distclean | `Install | `Uninstall | `Test | `Doc | `Extra | `Other of string ] type 'a plugin = 'a * name * OASISVersion.t option type all_plugin = plugin_kind plugin type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list # 102 "/home/gildor/programmation/oasis/src/oasis/OASISTypes.ml" type 'a conditional = 'a OASISExpr.choices type custom = { pre_command: (command_line option) conditional; post_command: (command_line option) conditional; } type common_section = { cs_name: name; cs_data: PropList.Data.t; cs_plugin_data: plugin_data; } type build_section = { bs_build: bool conditional; bs_install: bool conditional; bs_path: unix_dirname; bs_compiled_object: compiled_object; bs_build_depends: dependency list; bs_build_tools: tool list; bs_c_sources: unix_filename list; bs_data_files: (unix_filename * unix_filename option) list; bs_ccopt: args conditional; bs_cclib: args conditional; bs_dlllib: args conditional; bs_dllpath: args conditional; bs_byteopt: args conditional; bs_nativeopt: args conditional; } type library = { lib_modules: string list; lib_pack: bool; lib_internal_modules: string list; lib_findlib_parent: findlib_name option; lib_findlib_name: findlib_name option; lib_findlib_containers: findlib_name list; } type object_ = { obj_modules: string list; obj_findlib_fullname: findlib_name list option; } type executable = { exec_custom: bool; exec_main_is: unix_filename; } type flag = { flag_description: string option; flag_default: bool conditional; } type source_repository = { src_repo_type: vcs; src_repo_location: url; src_repo_browser: url option; src_repo_module: string option; src_repo_branch: string option; src_repo_tag: string option; src_repo_subdir: unix_filename option; } type test = { test_type: [`Test] plugin; test_command: command_line conditional; test_custom: custom; test_working_directory: unix_filename option; test_run: bool conditional; test_tools: tool list; } type doc_format = | HTML of unix_filename | DocText | PDF | PostScript | Info of unix_filename | DVI | OtherDoc type doc = { doc_type: [`Doc] plugin; doc_custom: custom; doc_build: bool conditional; doc_install: bool conditional; doc_install_dir: unix_filename; doc_title: string; doc_authors: string list; doc_abstract: string option; doc_format: doc_format; doc_data_files: (unix_filename * unix_filename option) list; doc_build_tools: tool list; } type section = | Library of common_section * build_section * library | Object of common_section * build_section * object_ | Executable of common_section * build_section * executable | Flag of common_section * flag | SrcRepo of common_section * source_repository | Test of common_section * test | Doc of common_section * doc type section_kind = [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ] type package = { oasis_version: OASISVersion.t; ocaml_version: OASISVersion.comparator option; findlib_version: OASISVersion.comparator option; name: package_name; version: OASISVersion.t; license: OASISLicense.t; license_file: unix_filename option; copyrights: string list; maintainers: string list; authors: string list; homepage: url option; synopsis: string; description: string option; categories: url list; conf_type: [`Configure] plugin; conf_custom: custom; build_type: [`Build] plugin; build_custom: custom; install_type: [`Install] plugin; install_custom: custom; uninstall_custom: custom; clean_custom: custom; distclean_custom: custom; files_ab: unix_filename list; sections: section list; plugins: [`Extra] plugin list; schema_data: PropList.Data.t; plugin_data: plugin_data; } end module OASISUnixPath = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISUnixPath.ml" type unix_filename = string type unix_dirname = string type host_filename = string type host_dirname = string let current_dir_name = "." let parent_dir_name = ".." let is_current_dir fn = fn = current_dir_name || fn = "" let concat f1 f2 = if is_current_dir f1 then f2 else let f1' = try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1 in f1'^"/"^f2 let make = function | hd :: tl -> List.fold_left (fun f p -> concat f p) hd tl | [] -> invalid_arg "OASISUnixPath.make" let dirname f = try String.sub f 0 (String.rindex f '/') with Not_found -> current_dir_name let basename f = try let pos_start = (String.rindex f '/') + 1 in String.sub f pos_start ((String.length f) - pos_start) with Not_found -> f let chop_extension f = try let last_dot = String.rindex f '.' in let sub = String.sub f 0 last_dot in try let last_slash = String.rindex f '/' in if last_slash < last_dot then sub else f with Not_found -> sub with Not_found -> f let capitalize_file f = let dir = dirname f in let base = basename f in concat dir (String.capitalize base) let uncapitalize_file f = let dir = dirname f in let base = basename f in concat dir (String.uncapitalize base) end module OASISHostPath = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISHostPath.ml" open Filename module Unix = OASISUnixPath let make = function | [] -> invalid_arg "OASISHostPath.make" | hd :: tl -> List.fold_left Filename.concat hd tl let of_unix ufn = if Sys.os_type = "Unix" then ufn else make (List.map (fun p -> if p = Unix.current_dir_name then current_dir_name else if p = Unix.parent_dir_name then parent_dir_name else p) (OASISString.nsplit ufn '/')) end module OASISSection = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISSection.ml" open OASISTypes let section_kind_common = function | Library (cs, _, _) -> `Library, cs | Object (cs, _, _) -> `Object, cs | Executable (cs, _, _) -> `Executable, cs | Flag (cs, _) -> `Flag, cs | SrcRepo (cs, _) -> `SrcRepo, cs | Test (cs, _) -> `Test, cs | Doc (cs, _) -> `Doc, cs let section_common sct = snd (section_kind_common sct) let section_common_set cs = function | Library (_, bs, lib) -> Library (cs, bs, lib) | Object (_, bs, obj) -> Object (cs, bs, obj) | Executable (_, bs, exec) -> Executable (cs, bs, exec) | Flag (_, flg) -> Flag (cs, flg) | SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo) | Test (_, tst) -> Test (cs, tst) | Doc (_, doc) -> Doc (cs, doc) (** Key used to identify section *) let section_id sct = let k, cs = section_kind_common sct in k, cs.cs_name let string_of_section sct = let k, nm = section_id sct in (match k with | `Library -> "library" | `Object -> "object" | `Executable -> "executable" | `Flag -> "flag" | `SrcRepo -> "src repository" | `Test -> "test" | `Doc -> "doc") ^" "^nm let section_find id scts = List.find (fun sct -> id = section_id sct) scts module CSection = struct type t = section let id = section_id let compare t1 t2 = compare (id t1) (id t2) let equal t1 t2 = (id t1) = (id t2) let hash t = Hashtbl.hash (id t) end module MapSection = Map.Make(CSection) module SetSection = Set.Make(CSection) end module OASISBuildSection = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISBuildSection.ml" end module OASISExecutable = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISExecutable.ml" open OASISTypes let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = let dir = OASISUnixPath.concat bs.bs_path (OASISUnixPath.dirname exec.exec_main_is) in let is_native_exec = match bs.bs_compiled_object with | Native -> true | Best -> is_native () | Byte -> false in OASISUnixPath.concat dir (cs.cs_name^(suffix_program ())), if not is_native_exec && not exec.exec_custom && bs.bs_c_sources <> [] then Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ())) else None end module OASISLibrary = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISLibrary.ml" open OASISTypes open OASISUtils open OASISGettext open OASISSection (* Look for a module file, considering capitalization or not. *) let find_module source_file_exists bs modul = let possible_base_fn = List.map (OASISUnixPath.concat bs.bs_path) [modul; OASISUnixPath.uncapitalize_file modul; OASISUnixPath.capitalize_file modul] in (* TODO: we should be able to be able to determine the source for every * files. Hence we should introduce a Module(source: fn) for the fields * Modules and InternalModules *) List.fold_left (fun acc base_fn -> match acc with | `No_sources _ -> begin let file_found = List.fold_left (fun acc ext -> if source_file_exists (base_fn^ext) then (base_fn^ext) :: acc else acc) [] [".ml"; ".mli"; ".mll"; ".mly"] in match file_found with | [] -> acc | lst -> `Sources (base_fn, lst) end | `Sources _ -> acc) (`No_sources possible_base_fn) possible_base_fn let source_unix_files ~ctxt (cs, bs, lib) source_file_exists = List.fold_left (fun acc modul -> match find_module source_file_exists bs modul with | `Sources (base_fn, lst) -> (base_fn, lst) :: acc | `No_sources _ -> OASISMessage.warning ~ctxt (f_ "Cannot find source file matching \ module '%s' in library %s") modul cs.cs_name; acc) [] (lib.lib_modules @ lib.lib_internal_modules) let generated_unix_files ~ctxt ~is_native ~has_native_dynlink ~ext_lib ~ext_dll ~source_file_exists (cs, bs, lib) = let find_modules lst ext = let find_module modul = match find_module source_file_exists bs modul with | `Sources (base_fn, _) -> [base_fn] | `No_sources lst -> OASISMessage.warning ~ctxt (f_ "Cannot find source file matching \ module '%s' in library %s") modul cs.cs_name; lst in List.map (fun nm -> List.map (fun base_fn -> base_fn ^"."^ext) (find_module nm)) lst in (* The headers that should be compiled along *) let headers = if lib.lib_pack then [] else find_modules lib.lib_modules "cmi" in (* The .cmx that be compiled along *) let cmxs = let should_be_built = (not lib.lib_pack) && (* Do not install .cmx packed submodules *) match bs.bs_compiled_object with | Native -> true | Best -> is_native | Byte -> false in if should_be_built then find_modules (lib.lib_modules @ lib.lib_internal_modules) "cmx" else [] in let acc_nopath = [] in (* Compute what libraries should be built *) let acc_nopath = (* Add the packed header file if required *) let add_pack_header acc = if lib.lib_pack then [cs.cs_name^".cmi"] :: acc else acc in let byte acc = add_pack_header ([cs.cs_name^".cma"] :: acc) in let native acc = let acc = add_pack_header (if has_native_dynlink then [cs.cs_name^".cmxs"] :: acc else acc) in [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc in match bs.bs_compiled_object with | Native -> byte (native acc_nopath) | Best when is_native -> byte (native acc_nopath) | Byte | Best -> byte acc_nopath in (* Add C library to be built *) let acc_nopath = if bs.bs_c_sources <> [] then begin ["lib"^cs.cs_name^"_stubs"^ext_lib] :: ["dll"^cs.cs_name^"_stubs"^ext_dll] :: acc_nopath end else acc_nopath in (* All the files generated *) List.rev_append (List.rev_map (List.rev_map (OASISUnixPath.concat bs.bs_path)) acc_nopath) (headers @ cmxs) end module OASISObject = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISObject.ml" open OASISTypes open OASISGettext let source_unix_files ~ctxt (cs, bs, obj) source_file_exists = List.fold_left (fun acc modul -> match OASISLibrary.find_module source_file_exists bs modul with | `Sources (base_fn, lst) -> (base_fn, lst) :: acc | `No_sources _ -> OASISMessage.warning ~ctxt (f_ "Cannot find source file matching \ module '%s' in object %s") modul cs.cs_name; acc) [] obj.obj_modules let generated_unix_files ~ctxt ~is_native ~source_file_exists (cs, bs, obj) = let find_module ext modul = match OASISLibrary.find_module source_file_exists bs modul with | `Sources (base_fn, _) -> [base_fn ^ ext] | `No_sources lst -> OASISMessage.warning ~ctxt (f_ "Cannot find source file matching \ module '%s' in object %s") modul cs.cs_name ; lst in let header, byte, native, c_object, f = match obj.obj_modules with | [ m ] -> (find_module ".cmi" m, find_module ".cmo" m, find_module ".cmx" m, find_module ".o" m, fun x -> x) | _ -> ([cs.cs_name ^ ".cmi"], [cs.cs_name ^ ".cmo"], [cs.cs_name ^ ".cmx"], [cs.cs_name ^ ".o"], OASISUnixPath.concat bs.bs_path) in List.map (List.map f) ( match bs.bs_compiled_object with | Native -> native :: c_object :: byte :: header :: [] | Best when is_native -> native :: c_object :: byte :: header :: [] | Byte | Best -> byte :: header :: []) end module OASISFindlib = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISFindlib.ml" open OASISTypes open OASISUtils open OASISGettext open OASISSection type library_name = name type findlib_part_name = name type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t exception InternalLibraryNotFound of library_name exception FindlibPackageNotFound of findlib_name type group_t = | Container of findlib_name * group_t list | Package of (findlib_name * common_section * build_section * [`Library of library | `Object of object_] * group_t list) type data = common_section * build_section * [`Library of library | `Object of object_] type tree = | Node of (data option) * (tree MapString.t) | Leaf of data let findlib_mapping pkg = (* Map from library name to either full findlib name or parts + parent. *) let fndlb_parts_of_lib_name = let fndlb_parts cs lib = let name = match lib.lib_findlib_name with | Some nm -> nm | None -> cs.cs_name in let name = String.concat "." (lib.lib_findlib_containers @ [name]) in name in List.fold_left (fun mp -> function | Library (cs, _, lib) -> begin let lib_name = cs.cs_name in let fndlb_parts = fndlb_parts cs lib in if MapString.mem lib_name mp then failwithf (f_ "The library name '%s' is used more than once.") lib_name; match lib.lib_findlib_parent with | Some lib_name_parent -> MapString.add lib_name (`Unsolved (lib_name_parent, fndlb_parts)) mp | None -> MapString.add lib_name (`Solved fndlb_parts) mp end | Object (cs, _, obj) -> begin let obj_name = cs.cs_name in if MapString.mem obj_name mp then failwithf (f_ "The object name '%s' is used more than once.") obj_name; let findlib_full_name = match obj.obj_findlib_fullname with | Some ns -> String.concat "." ns | None -> obj_name in MapString.add obj_name (`Solved findlib_full_name) mp end | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ -> mp) MapString.empty pkg.sections in (* Solve the above graph to be only library name to full findlib name. *) let fndlb_name_of_lib_name = let rec solve visited mp lib_name lib_name_child = if SetString.mem lib_name visited then failwithf (f_ "Library '%s' is involved in a cycle \ with regard to findlib naming.") lib_name; let visited = SetString.add lib_name visited in try match MapString.find lib_name mp with | `Solved fndlb_nm -> fndlb_nm, mp | `Unsolved (lib_nm_parent, post_fndlb_nm) -> let pre_fndlb_nm, mp = solve visited mp lib_nm_parent lib_name in let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp with Not_found -> failwithf (f_ "Library '%s', which is defined as the findlib parent of \ library '%s', doesn't exist.") lib_name lib_name_child in let mp = MapString.fold (fun lib_name status mp -> match status with | `Solved _ -> (* Solved initialy, no need to go further *) mp | `Unsolved _ -> let _, mp = solve SetString.empty mp lib_name "" in mp) fndlb_parts_of_lib_name fndlb_parts_of_lib_name in MapString.map (function | `Solved fndlb_nm -> fndlb_nm | `Unsolved _ -> assert false) mp in (* Convert an internal library name to a findlib name. *) let findlib_name_of_library_name lib_nm = try MapString.find lib_nm fndlb_name_of_lib_name with Not_found -> raise (InternalLibraryNotFound lib_nm) in (* Add a library to the tree. *) let add sct mp = let fndlb_fullname = let cs, _, _ = sct in let lib_name = cs.cs_name in findlib_name_of_library_name lib_name in let rec add_children nm_lst (children : tree MapString.t) = match nm_lst with | (hd :: tl) -> begin let node = try add_node tl (MapString.find hd children) with Not_found -> (* New node *) new_node tl in MapString.add hd node children end | [] -> (* Should not have a nameless library. *) assert false and add_node tl node = if tl = [] then begin match node with | Node (None, children) -> Node (Some sct, children) | Leaf (cs', _, _) | Node (Some (cs', _, _), _) -> (* TODO: allow to merge Package, i.e. * archive(byte) = "foo.cma foo_init.cmo" *) let cs, _, _ = sct in failwithf (f_ "Library '%s' and '%s' have the same findlib name '%s'") cs.cs_name cs'.cs_name fndlb_fullname end else begin match node with | Leaf data -> Node (Some data, add_children tl MapString.empty) | Node (data_opt, children) -> Node (data_opt, add_children tl children) end and new_node = function | [] -> Leaf sct | hd :: tl -> Node (None, MapString.add hd (new_node tl) MapString.empty) in add_children (OASISString.nsplit fndlb_fullname '.') mp in let rec group_of_tree mp = MapString.fold (fun nm node acc -> let cur = match node with | Node (Some (cs, bs, lib), children) -> Package (nm, cs, bs, lib, group_of_tree children) | Node (None, children) -> Container (nm, group_of_tree children) | Leaf (cs, bs, lib) -> Package (nm, cs, bs, lib, []) in cur :: acc) mp [] in let group_mp = List.fold_left (fun mp -> function | Library (cs, bs, lib) -> add (cs, bs, `Library lib) mp | Object (cs, bs, obj) -> add (cs, bs, `Object obj) mp | _ -> mp) MapString.empty pkg.sections in let groups = group_of_tree group_mp in let library_name_of_findlib_name = Lazy.lazy_from_fun (fun () -> (* Revert findlib_name_of_library_name. *) MapString.fold (fun k v mp -> MapString.add v k mp) fndlb_name_of_lib_name MapString.empty) in let library_name_of_findlib_name fndlb_nm = try MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name) with Not_found -> raise (FindlibPackageNotFound fndlb_nm) in groups, findlib_name_of_library_name, library_name_of_findlib_name let findlib_of_group = function | Container (fndlb_nm, _) | Package (fndlb_nm, _, _, _, _) -> fndlb_nm let root_of_group grp = let rec root_lib_aux = (* We do a DFS in the group. *) function | Container (_, children) -> List.fold_left (fun res grp -> if res = None then root_lib_aux grp else res) None children | Package (_, cs, bs, lib, _) -> Some (cs, bs, lib) in match root_lib_aux grp with | Some res -> res | None -> failwithf (f_ "Unable to determine root library of findlib library '%s'") (findlib_of_group grp) end module OASISFlag = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISFlag.ml" end module OASISPackage = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISPackage.ml" end module OASISSourceRepository = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISSourceRepository.ml" end module OASISTest = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISTest.ml" end module OASISDocument = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISDocument.ml" end module OASISExec = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISExec.ml" open OASISGettext open OASISUtils open OASISMessage (* TODO: I don't like this quote, it is there because $(rm) foo expands to * 'rm -f' foo... *) let run ~ctxt ?f_exit_code ?(quote=true) cmd args = let cmd = if quote then if Sys.os_type = "Win32" then if String.contains cmd ' ' then (* Double the 1st double quote... win32... sigh *) "\""^(Filename.quote cmd) else cmd else Filename.quote cmd else cmd in let cmdline = String.concat " " (cmd :: args) in info ~ctxt (f_ "Running command '%s'") cmdline; match f_exit_code, Sys.command cmdline with | None, 0 -> () | None, i -> failwithf (f_ "Command '%s' terminated with error code %d") cmdline i | Some f, i -> f i let run_read_output ~ctxt ?f_exit_code cmd args = let fn = Filename.temp_file "oasis-" ".txt" in try begin let () = run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn]) in let chn = open_in fn in let routput = ref [] in begin try while true do routput := (input_line chn) :: !routput done with End_of_file -> () end; close_in chn; Sys.remove fn; List.rev !routput end with e -> (try Sys.remove fn with _ -> ()); raise e let run_read_one_line ~ctxt ?f_exit_code cmd args = match run_read_output ~ctxt ?f_exit_code cmd args with | [fst] -> fst | lst -> failwithf (f_ "Command return unexpected output %S") (String.concat "\n" lst) end module OASISFileUtil = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISFileUtil.ml" open OASISGettext let file_exists_case fn = let dirname = Filename.dirname fn in let basename = Filename.basename fn in if Sys.file_exists dirname then if basename = Filename.current_dir_name then true else List.mem basename (Array.to_list (Sys.readdir dirname)) else false let find_file ?(case_sensitive=true) paths exts = (* Cardinal product of two list *) let ( * ) lst1 lst2 = List.flatten (List.map (fun a -> List.map (fun b -> a,b) lst2) lst1) in let rec combined_paths lst = match lst with | p1 :: p2 :: tl -> let acc = (List.map (fun (a,b) -> Filename.concat a b) (p1 * p2)) in combined_paths (acc :: tl) | [e] -> e | [] -> [] in let alternatives = List.map (fun (p,e) -> if String.length e > 0 && e.[0] <> '.' then p ^ "." ^ e else p ^ e) ((combined_paths paths) * exts) in List.find (if case_sensitive then file_exists_case else Sys.file_exists) alternatives let which ~ctxt prg = let path_sep = match Sys.os_type with | "Win32" -> ';' | _ -> ':' in let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in let exec_ext = match Sys.os_type with | "Win32" -> "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep) | _ -> [""] in find_file ~case_sensitive:false [path_lst; [prg]] exec_ext (**/**) let rec fix_dir dn = (* Windows hack because Sys.file_exists "src\\" = false when * Sys.file_exists "src" = true *) let ln = String.length dn in if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then fix_dir (String.sub dn 0 (ln - 1)) else dn let q = Filename.quote (**/**) let cp ~ctxt ?(recurse=false) src tgt = if recurse then match Sys.os_type with | "Win32" -> OASISExec.run ~ctxt "xcopy" [q src; q tgt; "/E"] | _ -> OASISExec.run ~ctxt "cp" ["-r"; q src; q tgt] else OASISExec.run ~ctxt (match Sys.os_type with | "Win32" -> "copy" | _ -> "cp") [q src; q tgt] let mkdir ~ctxt tgt = OASISExec.run ~ctxt (match Sys.os_type with | "Win32" -> "md" | _ -> "mkdir") [q tgt] let rec mkdir_parent ~ctxt f tgt = let tgt = fix_dir tgt in if Sys.file_exists tgt then begin if not (Sys.is_directory tgt) then OASISUtils.failwithf (f_ "Cannot create directory '%s', a file of the same name already \ exists") tgt end else begin mkdir_parent ~ctxt f (Filename.dirname tgt); if not (Sys.file_exists tgt) then begin f tgt; mkdir ~ctxt tgt end end let rmdir ~ctxt tgt = if Sys.readdir tgt = [||] then begin match Sys.os_type with | "Win32" -> OASISExec.run ~ctxt "rd" [q tgt] | _ -> OASISExec.run ~ctxt "rm" ["-r"; q tgt] end let glob ~ctxt fn = let basename = Filename.basename fn in if String.length basename >= 2 && basename.[0] = '*' && basename.[1] = '.' then begin let ext_len = (String.length basename) - 2 in let ext = String.sub basename 2 ext_len in let dirname = Filename.dirname fn in Array.fold_left (fun acc fn -> try let fn_ext = String.sub fn ((String.length fn) - ext_len) ext_len in if fn_ext = ext then (Filename.concat dirname fn) :: acc else acc with Invalid_argument _ -> acc) [] (Sys.readdir dirname) end else begin if file_exists_case fn then [fn] else [] end end # 2251 "setup.ml" module BaseEnvLight = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseEnvLight.ml" module MapString = Map.Make(String) type t = string MapString.t let default_filename = Filename.concat (Sys.getcwd ()) "setup.data" let load ?(allow_empty=false) ?(filename=default_filename) () = if Sys.file_exists filename then begin let chn = open_in_bin filename in let st = Stream.of_channel chn in let line = ref 1 in let st_line = Stream.from (fun _ -> try match Stream.next st with | '\n' -> incr line; Some '\n' | c -> Some c with Stream.Failure -> None) in let lexer = Genlex.make_lexer ["="] st_line in let rec read_file mp = match Stream.npeek 3 lexer with | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> Stream.junk lexer; Stream.junk lexer; Stream.junk lexer; read_file (MapString.add nm value mp) | [] -> mp | _ -> failwith (Printf.sprintf "Malformed data file '%s' line %d" filename !line) in let mp = read_file MapString.empty in close_in chn; mp end else if allow_empty then begin MapString.empty end else begin failwith (Printf.sprintf "Unable to load environment, the file '%s' doesn't exist." filename) end let var_get name env = let rec var_expand str = let buff = Buffer.create ((String.length str) * 2) in Buffer.add_substitute buff (fun var -> try var_expand (MapString.find var env) with Not_found -> failwith (Printf.sprintf "No variable %s defined when trying to expand %S." var str)) str; Buffer.contents buff in var_expand (MapString.find name env) let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst end # 2349 "setup.ml" module BaseContext = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseContext.ml" open OASISContext let args = args let default = default end module BaseMessage = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseMessage.ml" (** Message to user, overrid for Base @author Sylvain Le Gall *) open OASISMessage open BaseContext let debug fmt = debug ~ctxt:!default fmt let info fmt = info ~ctxt:!default fmt let warning fmt = warning ~ctxt:!default fmt let error fmt = error ~ctxt:!default fmt end module BaseEnv = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseEnv.ml" open OASISGettext open OASISUtils open PropList module MapString = BaseEnvLight.MapString type origin_t = | ODefault | OGetEnv | OFileLoad | OCommandLine type cli_handle_t = | CLINone | CLIAuto | CLIWith | CLIEnable | CLIUser of (Arg.key * Arg.spec * Arg.doc) list type definition_t = { hide: bool; dump: bool; cli: cli_handle_t; arg_help: string option; group: string option; } let schema = Schema.create "environment" (* Environment data *) let env = Data.create () (* Environment data from file *) let env_from_file = ref MapString.empty (* Lexer for var *) let var_lxr = Genlex.make_lexer [] let rec var_expand str = let buff = Buffer.create ((String.length str) * 2) in Buffer.add_substitute buff (fun var -> try (* TODO: this is a quick hack to allow calling Test.Command * without defining executable name really. I.e. if there is * an exec Executable toto, then $(toto) should be replace * by its real name. It is however useful to have this function * for other variable that depend on the host and should be * written better than that. *) let st = var_lxr (Stream.of_string var) in match Stream.npeek 3 st with | [Genlex.Ident "utoh"; Genlex.Ident nm] -> OASISHostPath.of_unix (var_get nm) | [Genlex.Ident "utoh"; Genlex.String s] -> OASISHostPath.of_unix s | [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] -> String.escaped (var_get nm) | [Genlex.Ident "ocaml_escaped"; Genlex.String s] -> String.escaped s | [Genlex.Ident nm] -> var_get nm | _ -> failwithf (f_ "Unknown expression '%s' in variable expansion of %s.") var str with | Unknown_field (_, _) -> failwithf (f_ "No variable %s defined when trying to expand %S.") var str | Stream.Error e -> failwithf (f_ "Syntax error when parsing '%s' when trying to \ expand %S: %s") var str e) str; Buffer.contents buff and var_get name = let vl = try Schema.get schema env name with Unknown_field _ as e -> begin try MapString.find name !env_from_file with Not_found -> raise e end in var_expand vl let var_choose ?printer ?name lst = OASISExpr.choose ?printer ?name var_get lst let var_protect vl = let buff = Buffer.create (String.length vl) in String.iter (function | '$' -> Buffer.add_string buff "\\$" | c -> Buffer.add_char buff c) vl; Buffer.contents buff let var_define ?(hide=false) ?(dump=true) ?short_desc ?(cli=CLINone) ?arg_help ?group name (* TODO: type constraint on the fact that name must be a valid OCaml id *) dflt = let default = [ OFileLoad, (fun () -> MapString.find name !env_from_file); ODefault, dflt; OGetEnv, (fun () -> Sys.getenv name); ] in let extra = { hide = hide; dump = dump; cli = cli; arg_help = arg_help; group = group; } in (* Try to find a value that can be defined *) let var_get_low lst = let errors, res = List.fold_left (fun (errors, res) (o, v) -> if res = None then begin try errors, Some (v ()) with | Not_found -> errors, res | Failure rsn -> (rsn :: errors), res | e -> (Printexc.to_string e) :: errors, res end else errors, res) ([], None) (List.sort (fun (o1, _) (o2, _) -> Pervasives.compare o2 o1) lst) in match res, errors with | Some v, _ -> v | None, [] -> raise (Not_set (name, None)) | None, lst -> raise (Not_set (name, Some (String.concat (s_ ", ") lst))) in let help = match short_desc with | Some fs -> Some fs | None -> None in let var_get_lst = FieldRO.create ~schema ~name ~parse:(fun ?(context=ODefault) s -> [context, fun () -> s]) ~print:var_get_low ~default ~update:(fun ?context x old_x -> x @ old_x) ?help extra in fun () -> var_expand (var_get_low (var_get_lst env)) let var_redefine ?hide ?dump ?short_desc ?cli ?arg_help ?group name dflt = if Schema.mem schema name then begin (* TODO: look suspsicious, we want to memorize dflt not dflt () *) Schema.set schema env ~context:ODefault name (dflt ()); fun () -> var_get name end else begin var_define ?hide ?dump ?short_desc ?cli ?arg_help ?group name dflt end let var_ignore (e : unit -> string) = () let print_hidden = var_define ~hide:true ~dump:false ~cli:CLIAuto ~arg_help:"Print even non-printable variable. (debug)" "print_hidden" (fun () -> "false") let var_all () = List.rev (Schema.fold (fun acc nm def _ -> if not def.hide || bool_of_string (print_hidden ()) then nm :: acc else acc) [] schema) let default_filename = BaseEnvLight.default_filename let load ?allow_empty ?filename () = env_from_file := BaseEnvLight.load ?allow_empty ?filename () let unload () = env_from_file := MapString.empty; Data.clear env let dump ?(filename=default_filename) () = let chn = open_out_bin filename in let output nm value = Printf.fprintf chn "%s=%S\n" nm value in let mp_todo = (* Dump data from schema *) Schema.fold (fun mp_todo nm def _ -> if def.dump then begin try let value = Schema.get schema env nm in output nm value with Not_set _ -> () end; MapString.remove nm mp_todo) !env_from_file schema in (* Dump data defined outside of schema *) MapString.iter output mp_todo; (* End of the dump *) close_out chn let print () = let printable_vars = Schema.fold (fun acc nm def short_descr_opt -> if not def.hide || bool_of_string (print_hidden ()) then begin try let value = Schema.get schema env nm in let txt = match short_descr_opt with | Some s -> s () | None -> nm in (txt, value) :: acc with Not_set _ -> acc end else acc) [] schema in let max_length = List.fold_left max 0 (List.rev_map String.length (List.rev_map fst printable_vars)) in let dot_pad str = String.make ((max_length - (String.length str)) + 3) '.' in Printf.printf "\nConfiguration: \n"; List.iter (fun (name,value) -> Printf.printf "%s: %s %s\n" name (dot_pad name) value) (List.rev printable_vars); Printf.printf "\n%!" let args () = let arg_concat = OASISUtils.varname_concat ~hyphen:'-' in [ "--override", Arg.Tuple ( let rvr = ref "" in let rvl = ref "" in [ Arg.Set_string rvr; Arg.Set_string rvl; Arg.Unit (fun () -> Schema.set schema env ~context:OCommandLine !rvr !rvl) ] ), "var+val Override any configuration variable."; ] @ List.flatten (Schema.fold (fun acc name def short_descr_opt -> let var_set s = Schema.set schema env ~context:OCommandLine name s in let arg_name = OASISUtils.varname_of_string ~hyphen:'-' name in let hlp = match short_descr_opt with | Some txt -> txt () | None -> "" in let arg_hlp = match def.arg_help with | Some s -> s | None -> "str" in let default_value = try Printf.sprintf (f_ " [%s]") (Schema.get schema env name) with Not_set _ -> "" in let args = match def.cli with | CLINone -> [] | CLIAuto -> [ arg_concat "--" arg_name, Arg.String var_set, Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value ] | CLIWith -> [ arg_concat "--with-" arg_name, Arg.String var_set, Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value ] | CLIEnable -> let dflt = if default_value = " [true]" then s_ " [default: enabled]" else s_ " [default: disabled]" in [ arg_concat "--enable-" arg_name, Arg.Unit (fun () -> var_set "true"), Printf.sprintf (f_ " %s%s") hlp dflt; arg_concat "--disable-" arg_name, Arg.Unit (fun () -> var_set "false"), Printf.sprintf (f_ " %s%s") hlp dflt ] | CLIUser lst -> lst in args :: acc) [] schema) end module BaseArgExt = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseArgExt.ml" open OASISUtils open OASISGettext let parse argv args = (* Simulate command line for Arg *) let current = ref 0 in try Arg.parse_argv ~current:current (Array.concat [[|"none"|]; argv]) (Arg.align args) (failwithf (f_ "Don't know what to do with arguments: '%s'")) (s_ "configure options:") with | Arg.Help txt -> print_endline txt; exit 0 | Arg.Bad txt -> prerr_endline txt; exit 1 end module BaseCheck = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseCheck.ml" open BaseEnv open BaseMessage open OASISUtils open OASISGettext let prog_best prg prg_lst = var_redefine prg (fun () -> let alternate = List.fold_left (fun res e -> match res with | Some _ -> res | None -> try Some (OASISFileUtil.which ~ctxt:!BaseContext.default e) with Not_found -> None) None prg_lst in match alternate with | Some prg -> prg | None -> raise Not_found) let prog prg = prog_best prg [prg] let prog_opt prg = prog_best prg [prg^".opt"; prg] let ocamlfind = prog "ocamlfind" let version var_prefix cmp fversion () = (* Really compare version provided *) let var = var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp) in var_redefine ~hide:true var (fun () -> let version_str = match fversion () with | "[Distributed with OCaml]" -> begin try (var_get "ocaml_version") with Not_found -> warning (f_ "Variable ocaml_version not defined, fallback \ to default"); Sys.ocaml_version end | res -> res in let version = OASISVersion.version_of_string version_str in if OASISVersion.comparator_apply version cmp then version_str else failwithf (f_ "Cannot satisfy version constraint on %s: %s (version: %s)") var_prefix (OASISVersion.string_of_comparator cmp) version_str) () let package_version pkg = OASISExec.run_read_one_line ~ctxt:!BaseContext.default (ocamlfind ()) ["query"; "-format"; "%v"; pkg] let package ?version_comparator pkg () = let var = OASISUtils.varname_concat "pkg_" (OASISUtils.varname_of_string pkg) in let findlib_dir pkg = let dir = OASISExec.run_read_one_line ~ctxt:!BaseContext.default (ocamlfind ()) ["query"; "-format"; "%d"; pkg] in if Sys.file_exists dir && Sys.is_directory dir then dir else failwithf (f_ "When looking for findlib package %s, \ directory %s return doesn't exist") pkg dir in let vl = var_redefine var (fun () -> findlib_dir pkg) () in ( match version_comparator with | Some ver_cmp -> ignore (version var ver_cmp (fun _ -> package_version pkg) ()) | None -> () ); vl end module BaseOCamlcConfig = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseOCamlcConfig.ml" open BaseEnv open OASISUtils open OASISGettext module SMap = Map.Make(String) let ocamlc = BaseCheck.prog_opt "ocamlc" let ocamlc_config_map = (* Map name to value for ocamlc -config output (name ^": "^value) *) let rec split_field mp lst = match lst with | line :: tl -> let mp = try let pos_semicolon = String.index line ':' in if pos_semicolon > 1 then ( let name = String.sub line 0 pos_semicolon in let linelen = String.length line in let value = if linelen > pos_semicolon + 2 then String.sub line (pos_semicolon + 2) (linelen - pos_semicolon - 2) else "" in SMap.add name value mp ) else ( mp ) with Not_found -> ( mp ) in split_field mp tl | [] -> mp in let cache = lazy (var_protect (Marshal.to_string (split_field SMap.empty (OASISExec.run_read_output ~ctxt:!BaseContext.default (ocamlc ()) ["-config"])) [])) in var_redefine "ocamlc_config_map" ~hide:true ~dump:false (fun () -> (* TODO: update if ocamlc change !!! *) Lazy.force cache) let var_define nm = (* Extract data from ocamlc -config *) let avlbl_config_get () = Marshal.from_string (ocamlc_config_map ()) 0 in let chop_version_suffix s = try String.sub s 0 (String.index s '+') with _ -> s in let nm_config, value_config = match nm with | "ocaml_version" -> "version", chop_version_suffix | _ -> nm, (fun x -> x) in var_redefine nm (fun () -> try let map = avlbl_config_get () in let value = SMap.find nm_config map in value_config value with Not_found -> failwithf (f_ "Cannot find field '%s' in '%s -config' output") nm (ocamlc ())) end module BaseStandardVar = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseStandardVar.ml" open OASISGettext open OASISTypes open OASISExpr open BaseCheck open BaseEnv let ocamlfind = BaseCheck.ocamlfind let ocamlc = BaseOCamlcConfig.ocamlc let ocamlopt = prog_opt "ocamlopt" let ocamlbuild = prog "ocamlbuild" (**/**) let rpkg = ref None let pkg_get () = match !rpkg with | Some pkg -> pkg | None -> failwith (s_ "OASIS Package is not set") let var_cond = ref [] let var_define_cond ~since_version f dflt = let holder = ref (fun () -> dflt) in let since_version = OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version) in var_cond := (fun ver -> if OASISVersion.comparator_apply ver since_version then holder := f ()) :: !var_cond; fun () -> !holder () (**/**) let pkg_name = var_define ~short_desc:(fun () -> s_ "Package name") "pkg_name" (fun () -> (pkg_get ()).name) let pkg_version = var_define ~short_desc:(fun () -> s_ "Package version") "pkg_version" (fun () -> (OASISVersion.string_of_version (pkg_get ()).version)) let c = BaseOCamlcConfig.var_define let os_type = c "os_type" let system = c "system" let architecture = c "architecture" let ccomp_type = c "ccomp_type" let ocaml_version = c "ocaml_version" (* TODO: Check standard variable presence at runtime *) let standard_library_default = c "standard_library_default" let standard_library = c "standard_library" let standard_runtime = c "standard_runtime" let bytecomp_c_compiler = c "bytecomp_c_compiler" let native_c_compiler = c "native_c_compiler" let model = c "model" let ext_obj = c "ext_obj" let ext_asm = c "ext_asm" let ext_lib = c "ext_lib" let ext_dll = c "ext_dll" let default_executable_name = c "default_executable_name" let systhread_supported = c "systhread_supported" let flexlink = BaseCheck.prog "flexlink" let flexdll_version = var_define ~short_desc:(fun () -> "FlexDLL version (Win32)") "flexdll_version" (fun () -> let lst = OASISExec.run_read_output ~ctxt:!BaseContext.default (flexlink ()) ["-help"] in match lst with | line :: _ -> Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver) | [] -> raise Not_found) (**/**) let p name hlp dflt = var_define ~short_desc:hlp ~cli:CLIAuto ~arg_help:"dir" name dflt let (/) a b = if os_type () = Sys.os_type then Filename.concat a b else if os_type () = "Unix" then OASISUnixPath.concat a b else OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat") (os_type ()) (**/**) let prefix = p "prefix" (fun () -> s_ "Install architecture-independent files dir") (fun () -> match os_type () with | "Win32" -> let program_files = Sys.getenv "PROGRAMFILES" in program_files/(pkg_name ()) | _ -> "/usr/local") let exec_prefix = p "exec_prefix" (fun () -> s_ "Install architecture-dependent files in dir") (fun () -> "$prefix") let bindir = p "bindir" (fun () -> s_ "User executables") (fun () -> "$exec_prefix"/"bin") let sbindir = p "sbindir" (fun () -> s_ "System admin executables") (fun () -> "$exec_prefix"/"sbin") let libexecdir = p "libexecdir" (fun () -> s_ "Program executables") (fun () -> "$exec_prefix"/"libexec") let sysconfdir = p "sysconfdir" (fun () -> s_ "Read-only single-machine data") (fun () -> "$prefix"/"etc") let sharedstatedir = p "sharedstatedir" (fun () -> s_ "Modifiable architecture-independent data") (fun () -> "$prefix"/"com") let localstatedir = p "localstatedir" (fun () -> s_ "Modifiable single-machine data") (fun () -> "$prefix"/"var") let libdir = p "libdir" (fun () -> s_ "Object code libraries") (fun () -> "$exec_prefix"/"lib") let datarootdir = p "datarootdir" (fun () -> s_ "Read-only arch-independent data root") (fun () -> "$prefix"/"share") let datadir = p "datadir" (fun () -> s_ "Read-only architecture-independent data") (fun () -> "$datarootdir") let infodir = p "infodir" (fun () -> s_ "Info documentation") (fun () -> "$datarootdir"/"info") let localedir = p "localedir" (fun () -> s_ "Locale-dependent data") (fun () -> "$datarootdir"/"locale") let mandir = p "mandir" (fun () -> s_ "Man documentation") (fun () -> "$datarootdir"/"man") let docdir = p "docdir" (fun () -> s_ "Documentation root") (fun () -> "$datarootdir"/"doc"/"$pkg_name") let htmldir = p "htmldir" (fun () -> s_ "HTML documentation") (fun () -> "$docdir") let dvidir = p "dvidir" (fun () -> s_ "DVI documentation") (fun () -> "$docdir") let pdfdir = p "pdfdir" (fun () -> s_ "PDF documentation") (fun () -> "$docdir") let psdir = p "psdir" (fun () -> s_ "PS documentation") (fun () -> "$docdir") let destdir = p "destdir" (fun () -> s_ "Prepend a path when installing package") (fun () -> raise (PropList.Not_set ("destdir", Some (s_ "undefined by construct")))) let findlib_version = var_define "findlib_version" (fun () -> BaseCheck.package_version "findlib") let is_native = var_define "is_native" (fun () -> try let _s : string = ocamlopt () in "true" with PropList.Not_set _ -> let _s : string = ocamlc () in "false") let ext_program = var_define "suffix_program" (fun () -> match os_type () with | "Win32" -> ".exe" | _ -> "") let rm = var_define ~short_desc:(fun () -> s_ "Remove a file.") "rm" (fun () -> match os_type () with | "Win32" -> "del" | _ -> "rm -f") let rmdir = var_define ~short_desc:(fun () -> s_ "Remove a directory.") "rmdir" (fun () -> match os_type () with | "Win32" -> "rd" | _ -> "rm -rf") let debug = var_define ~short_desc:(fun () -> s_ "Turn ocaml debug flag on") ~cli:CLIEnable "debug" (fun () -> "true") let profile = var_define ~short_desc:(fun () -> s_ "Turn ocaml profile flag on") ~cli:CLIEnable "profile" (fun () -> "false") let tests = var_define_cond ~since_version:"0.3" (fun () -> var_define ~short_desc:(fun () -> s_ "Compile tests executable and library and run them") ~cli:CLIEnable "tests" (fun () -> "false")) "true" let docs = var_define_cond ~since_version:"0.3" (fun () -> var_define ~short_desc:(fun () -> s_ "Create documentations") ~cli:CLIEnable "docs" (fun () -> "true")) "true" let native_dynlink = var_define ~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.") ~cli:CLINone "native_dynlink" (fun () -> let res = let ocaml_lt_312 () = OASISVersion.comparator_apply (OASISVersion.version_of_string (ocaml_version ())) (OASISVersion.VLesser (OASISVersion.version_of_string "3.12.0")) in let flexdll_lt_030 () = OASISVersion.comparator_apply (OASISVersion.version_of_string (flexdll_version ())) (OASISVersion.VLesser (OASISVersion.version_of_string "0.30")) in let has_native_dynlink = let ocamlfind = ocamlfind () in try let fn = OASISExec.run_read_one_line ~ctxt:!BaseContext.default ocamlfind ["query"; "-predicates"; "native"; "dynlink"; "-format"; "%d/%a"] in Sys.file_exists fn with _ -> false in if not has_native_dynlink then false else if ocaml_lt_312 () then false else if (os_type () = "Win32" || os_type () = "Cygwin") && flexdll_lt_030 () then begin BaseMessage.warning (f_ ".cmxs generation disabled because FlexDLL needs to be \ at least 0.30. Please upgrade FlexDLL from %s to 0.30.") (flexdll_version ()); false end else true in string_of_bool res) let init pkg = rpkg := Some pkg; List.iter (fun f -> f pkg.oasis_version) !var_cond end module BaseFileAB = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseFileAB.ml" open BaseEnv open OASISGettext open BaseMessage let to_filename fn = let fn = OASISHostPath.of_unix fn in if not (Filename.check_suffix fn ".ab") then warning (f_ "File '%s' doesn't have '.ab' extension") fn; Filename.chop_extension fn let replace fn_lst = let buff = Buffer.create 13 in List.iter (fun fn -> let fn = OASISHostPath.of_unix fn in let chn_in = open_in fn in let chn_out = open_out (to_filename fn) in ( try while true do Buffer.add_string buff (var_expand (input_line chn_in)); Buffer.add_char buff '\n' done with End_of_file -> () ); Buffer.output_buffer chn_out buff; Buffer.clear buff; close_in chn_in; close_out chn_out) fn_lst end module BaseLog = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseLog.ml" open OASISUtils let default_filename = Filename.concat (Filename.dirname BaseEnv.default_filename) "setup.log" module SetTupleString = Set.Make (struct type t = string * string let compare (s11, s12) (s21, s22) = match String.compare s11 s21 with | 0 -> String.compare s12 s22 | n -> n end) let load () = if Sys.file_exists default_filename then begin let chn = open_in default_filename in let scbuf = Scanf.Scanning.from_file default_filename in let rec read_aux (st, lst) = if not (Scanf.Scanning.end_of_input scbuf) then begin let acc = try Scanf.bscanf scbuf "%S %S\n" (fun e d -> let t = e, d in if SetTupleString.mem t st then st, lst else SetTupleString.add t st, t :: lst) with Scanf.Scan_failure _ -> failwith (Scanf.bscanf scbuf "%l" (fun line -> Printf.sprintf "Malformed log file '%s' at line %d" default_filename line)) in read_aux acc end else begin close_in chn; List.rev lst end in read_aux (SetTupleString.empty, []) end else begin [] end let register event data = let chn_out = open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename in Printf.fprintf chn_out "%S %S\n" event data; close_out chn_out let unregister event data = if Sys.file_exists default_filename then begin let lst = load () in let chn_out = open_out default_filename in let write_something = ref false in List.iter (fun (e, d) -> if e <> event || d <> data then begin write_something := true; Printf.fprintf chn_out "%S %S\n" e d end) lst; close_out chn_out; if not !write_something then Sys.remove default_filename end let filter events = let st_events = List.fold_left (fun st e -> SetString.add e st) SetString.empty events in List.filter (fun (e, _) -> SetString.mem e st_events) (load ()) let exists event data = List.exists (fun v -> (event, data) = v) (load ()) end module BaseBuilt = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseBuilt.ml" open OASISTypes open OASISGettext open BaseStandardVar open BaseMessage type t = | BExec (* Executable *) | BExecLib (* Library coming with executable *) | BLib (* Library *) | BObj (* Library *) | BDoc (* Document *) let to_log_event_file t nm = "built_"^ (match t with | BExec -> "exec" | BExecLib -> "exec_lib" | BLib -> "lib" | BObj -> "obj" | BDoc -> "doc")^ "_"^nm let to_log_event_done t nm = "is_"^(to_log_event_file t nm) let register t nm lst = BaseLog.register (to_log_event_done t nm) "true"; List.iter (fun alt -> let registered = List.fold_left (fun registered fn -> if OASISFileUtil.file_exists_case fn then begin BaseLog.register (to_log_event_file t nm) (if Filename.is_relative fn then Filename.concat (Sys.getcwd ()) fn else fn); true end else registered) false alt in if not registered then warning (f_ "Cannot find an existing alternative files among: %s") (String.concat (s_ ", ") alt)) lst let unregister t nm = List.iter (fun (e, d) -> BaseLog.unregister e d) (BaseLog.filter [to_log_event_file t nm; to_log_event_done t nm]) let fold t nm f acc = List.fold_left (fun acc (_, fn) -> if OASISFileUtil.file_exists_case fn then begin f acc fn end else begin warning (f_ "File '%s' has been marked as built \ for %s but doesn't exist") fn (Printf.sprintf (match t with | BExec | BExecLib -> (f_ "executable %s") | BLib -> (f_ "library %s") | BObj -> (f_ "object %s") | BDoc -> (f_ "documentation %s")) nm); acc end) acc (BaseLog.filter [to_log_event_file t nm]) let is_built t nm = List.fold_left (fun is_built (_, d) -> (try bool_of_string d with _ -> false)) false (BaseLog.filter [to_log_event_done t nm]) let of_executable ffn (cs, bs, exec) = let unix_exec_is, unix_dll_opt = OASISExecutable.unix_exec_is (cs, bs, exec) (fun () -> bool_of_string (is_native ())) ext_dll ext_program in let evs = (BExec, cs.cs_name, [[ffn unix_exec_is]]) :: (match unix_dll_opt with | Some fn -> [BExecLib, cs.cs_name, [[ffn fn]]] | None -> []) in evs, unix_exec_is, unix_dll_opt let of_library ffn (cs, bs, lib) = let unix_lst = OASISLibrary.generated_unix_files ~ctxt:!BaseContext.default ~source_file_exists:(fun fn -> OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn)) ~is_native:(bool_of_string (is_native ())) ~has_native_dynlink:(bool_of_string (native_dynlink ())) ~ext_lib:(ext_lib ()) ~ext_dll:(ext_dll ()) (cs, bs, lib) in let evs = [BLib, cs.cs_name, List.map (List.map ffn) unix_lst] in evs, unix_lst let of_object ffn (cs, bs, obj) = let unix_lst = OASISObject.generated_unix_files ~ctxt:!BaseContext.default ~source_file_exists:(fun fn -> OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn)) ~is_native:(bool_of_string (is_native ())) (cs, bs, obj) in let evs = [BObj, cs.cs_name, List.map (List.map ffn) unix_lst] in evs, unix_lst end module BaseCustom = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseCustom.ml" open BaseEnv open BaseMessage open OASISTypes open OASISGettext let run cmd args extra_args = OASISExec.run ~ctxt:!BaseContext.default ~quote:false (var_expand cmd) (List.map var_expand (args @ (Array.to_list extra_args))) let hook ?(failsafe=false) cstm f e = let optional_command lst = let printer = function | Some (cmd, args) -> String.concat " " (cmd :: args) | None -> s_ "No command" in match var_choose ~name:(s_ "Pre/Post Command") ~printer lst with | Some (cmd, args) -> begin try run cmd args [||] with e when failsafe -> warning (f_ "Command '%s' fail with error: %s") (String.concat " " (cmd :: args)) (match e with | Failure msg -> msg | e -> Printexc.to_string e) end | None -> () in let res = optional_command cstm.pre_command; f e in optional_command cstm.post_command; res end module BaseDynVar = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseDynVar.ml" open OASISTypes open OASISGettext open BaseEnv open BaseBuilt let init pkg = (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *) (* TODO: provide compile option for library libary_byte_args_VARNAME... *) List.iter (function | Executable (cs, bs, exec) -> if var_choose bs.bs_build then var_ignore (var_redefine (* We don't save this variable *) ~dump:false ~short_desc:(fun () -> Printf.sprintf (f_ "Filename of executable '%s'") cs.cs_name) (OASISUtils.varname_of_string cs.cs_name) (fun () -> let fn_opt = fold BExec cs.cs_name (fun _ fn -> Some fn) None in match fn_opt with | Some fn -> fn | None -> raise (PropList.Not_set (cs.cs_name, Some (Printf.sprintf (f_ "Executable '%s' not yet built.") cs.cs_name))))) | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ -> ()) pkg.sections end module BaseTest = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseTest.ml" open BaseEnv open BaseMessage open OASISTypes open OASISExpr open OASISGettext let test lst pkg extra_args = let one_test (failure, n) (test_plugin, cs, test) = if var_choose ~name:(Printf.sprintf (f_ "test %s run") cs.cs_name) ~printer:string_of_bool test.test_run then begin let () = info (f_ "Running test '%s'") cs.cs_name in let back_cwd = match test.test_working_directory with | Some dir -> let cwd = Sys.getcwd () in let chdir d = info (f_ "Changing directory to '%s'") d; Sys.chdir d in chdir dir; fun () -> chdir cwd | None -> fun () -> () in try let failure_percent = BaseCustom.hook test.test_custom (test_plugin pkg (cs, test)) extra_args in back_cwd (); (failure_percent +. failure, n + 1) with e -> begin back_cwd (); raise e end end else begin info (f_ "Skipping test '%s'") cs.cs_name; (failure, n) end in let (failed, n) = List.fold_left one_test (0.0, 0) lst in let failure_percent = if n = 0 then 0.0 else failed /. (float_of_int n) in let msg = Printf.sprintf (f_ "Tests had a %.2f%% failure rate") (100. *. failure_percent) in if failure_percent > 0.0 then failwith msg else info "%s" msg; (* Possible explanation why the tests where not run. *) if OASISVersion.version_0_3_or_after pkg.oasis_version && not (bool_of_string (BaseStandardVar.tests ())) && lst <> [] then BaseMessage.warning "Tests are turned off, consider enabling with \ 'ocaml setup.ml -configure --enable-tests'" end module BaseDoc = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseDoc.ml" open BaseEnv open BaseMessage open OASISTypes open OASISGettext let doc lst pkg extra_args = let one_doc (doc_plugin, cs, doc) = if var_choose ~name:(Printf.sprintf (f_ "documentation %s build") cs.cs_name) ~printer:string_of_bool doc.doc_build then begin info (f_ "Building documentation '%s'") cs.cs_name; BaseCustom.hook doc.doc_custom (doc_plugin pkg (cs, doc)) extra_args end in List.iter one_doc lst; if OASISVersion.version_0_3_or_after pkg.oasis_version && not (bool_of_string (BaseStandardVar.docs ())) && lst <> [] then BaseMessage.warning "Docs are turned off, consider enabling with \ 'ocaml setup.ml -configure --enable-docs'" end module BaseSetup = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseSetup.ml" open BaseEnv open BaseMessage open OASISTypes open OASISSection open OASISGettext open OASISUtils type std_args_fun = package -> string array -> unit type ('a, 'b) section_args_fun = name * (package -> (common_section * 'a) -> string array -> 'b) type t = { configure: std_args_fun; build: std_args_fun; doc: ((doc, unit) section_args_fun) list; test: ((test, float) section_args_fun) list; install: std_args_fun; uninstall: std_args_fun; clean: std_args_fun list; clean_doc: (doc, unit) section_args_fun list; clean_test: (test, unit) section_args_fun list; distclean: std_args_fun list; distclean_doc: (doc, unit) section_args_fun list; distclean_test: (test, unit) section_args_fun list; package: package; oasis_fn: string option; oasis_version: string; oasis_digest: Digest.t option; oasis_exec: string option; oasis_setup_args: string list; setup_update: bool; } (* Associate a plugin function with data from package *) let join_plugin_sections filter_map lst = List.rev (List.fold_left (fun acc sct -> match filter_map sct with | Some e -> e :: acc | None -> acc) [] lst) (* Search for plugin data associated with a section name *) let lookup_plugin_section plugin action nm lst = try List.assoc nm lst with Not_found -> failwithf (f_ "Cannot find plugin %s matching section %s for %s action") plugin nm action let configure t args = (* Run configure *) BaseCustom.hook t.package.conf_custom (fun () -> (* Reload if preconf has changed it *) begin try unload (); load (); with _ -> () end; (* Run plugin's configure *) t.configure t.package args; (* Dump to allow postconf to change it *) dump ()) (); (* Reload environment *) unload (); load (); (* Save environment *) print (); (* Replace data in file *) BaseFileAB.replace t.package.files_ab let build t args = BaseCustom.hook t.package.build_custom (t.build t.package) args let doc t args = BaseDoc.doc (join_plugin_sections (function | Doc (cs, e) -> Some (lookup_plugin_section "documentation" (s_ "build") cs.cs_name t.doc, cs, e) | _ -> None) t.package.sections) t.package args let test t args = BaseTest.test (join_plugin_sections (function | Test (cs, e) -> Some (lookup_plugin_section "test" (s_ "run") cs.cs_name t.test, cs, e) | _ -> None) t.package.sections) t.package args let all t args = let rno_doc = ref false in let rno_test = ref false in Arg.parse_argv ~current:(ref 0) (Array.of_list ((Sys.executable_name^" all") :: (Array.to_list args))) [ "-no-doc", Arg.Set rno_doc, s_ "Don't run doc target"; "-no-test", Arg.Set rno_test, s_ "Don't run test target"; ] (failwithf (f_ "Don't know what to do with '%s'")) ""; info "Running configure step"; configure t [||]; info "Running build step"; build t [||]; (* Load setup.log dynamic variables *) BaseDynVar.init t.package; if not !rno_doc then begin info "Running doc step"; doc t [||]; end else begin info "Skipping doc step" end; if not !rno_test then begin info "Running test step"; test t [||] end else begin info "Skipping test step" end let install t args = BaseCustom.hook t.package.install_custom (t.install t.package) args let uninstall t args = BaseCustom.hook t.package.uninstall_custom (t.uninstall t.package) args let reinstall t args = uninstall t args; install t args let clean, distclean = let failsafe f a = try f a with e -> warning (f_ "Action fail with error: %s") (match e with | Failure msg -> msg | e -> Printexc.to_string e) in let generic_clean t cstm mains docs tests args = BaseCustom.hook ~failsafe:true cstm (fun () -> (* Clean section *) List.iter (function | Test (cs, test) -> let f = try List.assoc cs.cs_name tests with Not_found -> fun _ _ _ -> () in failsafe (f t.package (cs, test)) args | Doc (cs, doc) -> let f = try List.assoc cs.cs_name docs with Not_found -> fun _ _ _ -> () in failsafe (f t.package (cs, doc)) args | Library _ | Object _ | Executable _ | Flag _ | SrcRepo _ -> ()) t.package.sections; (* Clean whole package *) List.iter (fun f -> failsafe (f t.package) args) mains) () in let clean t args = generic_clean t t.package.clean_custom t.clean t.clean_doc t.clean_test args in let distclean t args = (* Call clean *) clean t args; (* Call distclean code *) generic_clean t t.package.distclean_custom t.distclean t.distclean_doc t.distclean_test args; (* Remove generated file *) List.iter (fun fn -> if Sys.file_exists fn then begin info (f_ "Remove '%s'") fn; Sys.remove fn end) (BaseEnv.default_filename :: BaseLog.default_filename :: (List.rev_map BaseFileAB.to_filename t.package.files_ab)) in clean, distclean let version t _ = print_endline t.oasis_version let update_setup_ml, no_update_setup_ml_cli = let b = ref true in b, ("-no-update-setup-ml", Arg.Clear b, s_ " Don't try to update setup.ml, even if _oasis has changed.") let update_setup_ml t = let oasis_fn = match t.oasis_fn with | Some fn -> fn | None -> "_oasis" in let oasis_exec = match t.oasis_exec with | Some fn -> fn | None -> "oasis" in let ocaml = Sys.executable_name in let setup_ml, args = match Array.to_list Sys.argv with | setup_ml :: args -> setup_ml, args | [] -> failwith (s_ "Expecting non-empty command line arguments.") in let ocaml, setup_ml = if Sys.executable_name = Sys.argv.(0) then (* We are not running in standard mode, probably the script * is precompiled. *) "ocaml", "setup.ml" else ocaml, setup_ml in let no_update_setup_ml_cli, _, _ = no_update_setup_ml_cli in let do_update () = let oasis_exec_version = OASISExec.run_read_one_line ~ctxt:!BaseContext.default ~f_exit_code: (function | 0 -> () | 1 -> failwithf (f_ "Executable '%s' is probably an old version \ of oasis (< 0.3.0), please update to version \ v%s.") oasis_exec t.oasis_version | 127 -> failwithf (f_ "Cannot find executable '%s', please install \ oasis v%s.") oasis_exec t.oasis_version | n -> failwithf (f_ "Command '%s version' exited with code %d.") oasis_exec n) oasis_exec ["version"] in if OASISVersion.comparator_apply (OASISVersion.version_of_string oasis_exec_version) (OASISVersion.VGreaterEqual (OASISVersion.version_of_string t.oasis_version)) then begin (* We have a version >= for the executable oasis, proceed with * update. *) (* TODO: delegate this check to 'oasis setup'. *) if Sys.os_type = "Win32" then failwithf (f_ "It is not possible to update the running script \ setup.ml on Windows. Please update setup.ml by \ running '%s'.") (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args)) else begin OASISExec.run ~ctxt:!BaseContext.default ~f_exit_code: (function | 0 -> () | n -> failwithf (f_ "Unable to update setup.ml using '%s', \ please fix the problem and retry.") oasis_exec) oasis_exec ("setup" :: t.oasis_setup_args); OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args) end end else failwithf (f_ "The version of '%s' (v%s) doesn't match the version of \ oasis used to generate the %s file. Please install at \ least oasis v%s.") oasis_exec oasis_exec_version setup_ml t.oasis_version in if !update_setup_ml then begin try match t.oasis_digest with | Some dgst -> if Sys.file_exists oasis_fn && dgst <> Digest.file "_oasis" then begin do_update (); true end else false | None -> false with e -> error (f_ "Error when updating setup.ml. If you want to avoid this error, \ you can bypass the update of %s by running '%s %s %s %s'") setup_ml ocaml setup_ml no_update_setup_ml_cli (String.concat " " args); raise e end else false let setup t = let catch_exn = ref true in try let act_ref = ref (fun _ -> failwithf (f_ "No action defined, run '%s %s -help'") Sys.executable_name Sys.argv.(0)) in let extra_args_ref = ref [] in let allow_empty_env_ref = ref false in let arg_handle ?(allow_empty_env=false) act = Arg.Tuple [ Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref); Arg.Unit (fun () -> allow_empty_env_ref := allow_empty_env; act_ref := act); ] in Arg.parse (Arg.align ([ "-configure", arg_handle ~allow_empty_env:true configure, s_ "[options*] Configure the whole build process."; "-build", arg_handle build, s_ "[options*] Build executables and libraries."; "-doc", arg_handle doc, s_ "[options*] Build documents."; "-test", arg_handle test, s_ "[options*] Run tests."; "-all", arg_handle ~allow_empty_env:true all, s_ "[options*] Run configure, build, doc and test targets."; "-install", arg_handle install, s_ "[options*] Install libraries, data, executables \ and documents."; "-uninstall", arg_handle uninstall, s_ "[options*] Uninstall libraries, data, executables \ and documents."; "-reinstall", arg_handle reinstall, s_ "[options*] Uninstall and install libraries, data, \ executables and documents."; "-clean", arg_handle ~allow_empty_env:true clean, s_ "[options*] Clean files generated by a build."; "-distclean", arg_handle ~allow_empty_env:true distclean, s_ "[options*] Clean files generated by a build and configure."; "-version", arg_handle ~allow_empty_env:true version, s_ " Display version of OASIS used to generate this setup.ml."; "-no-catch-exn", Arg.Clear catch_exn, s_ " Don't catch exception, useful for debugging."; ] @ (if t.setup_update then [no_update_setup_ml_cli] else []) @ (BaseContext.args ()))) (failwithf (f_ "Don't know what to do with '%s'")) (s_ "Setup and run build process current package\n"); (* Build initial environment *) load ~allow_empty:!allow_empty_env_ref (); (** Initialize flags *) List.iter (function | Flag (cs, {flag_description = hlp; flag_default = choices}) -> begin let apply ?short_desc () = var_ignore (var_define ~cli:CLIEnable ?short_desc (OASISUtils.varname_of_string cs.cs_name) (fun () -> string_of_bool (var_choose ~name:(Printf.sprintf (f_ "default value of flag %s") cs.cs_name) ~printer:string_of_bool choices))) in match hlp with | Some hlp -> apply ~short_desc:(fun () -> hlp) () | None -> apply () end | _ -> ()) t.package.sections; BaseStandardVar.init t.package; BaseDynVar.init t.package; if t.setup_update && update_setup_ml t then () else !act_ref t (Array.of_list (List.rev !extra_args_ref)) with e when !catch_exn -> error "%s" (Printexc.to_string e); exit 1 end # 4611 "setup.ml" module InternalConfigurePlugin = struct # 21 "/home/gildor/programmation/oasis/src/plugins/internal/InternalConfigurePlugin.ml" (** Configure using internal scheme @author Sylvain Le Gall *) open BaseEnv open OASISTypes open OASISUtils open OASISGettext open BaseMessage (** Configure build using provided series of check to be done * and then output corresponding file. *) let configure pkg argv = let var_ignore_eval var = let _s : string = var () in () in let errors = ref SetString.empty in let buff = Buffer.create 13 in let add_errors fmt = Printf.kbprintf (fun b -> errors := SetString.add (Buffer.contents b) !errors; Buffer.clear b) buff fmt in let warn_exception e = warning "%s" (Printexc.to_string e) in (* Check tools *) let check_tools lst = List.iter (function | ExternalTool tool -> begin try var_ignore_eval (BaseCheck.prog tool) with e -> warn_exception e; add_errors (f_ "Cannot find external tool '%s'") tool end | InternalExecutable nm1 -> (* Check that matching tool is built *) List.iter (function | Executable ({cs_name = nm2}, {bs_build = build}, _) when nm1 = nm2 -> if not (var_choose build) then add_errors (f_ "Cannot find buildable internal executable \ '%s' when checking build depends") nm1 | _ -> ()) pkg.sections) lst in let build_checks sct bs = if var_choose bs.bs_build then begin if bs.bs_compiled_object = Native then begin try var_ignore_eval BaseStandardVar.ocamlopt with e -> warn_exception e; add_errors (f_ "Section %s requires native compilation") (OASISSection.string_of_section sct) end; (* Check tools *) check_tools bs.bs_build_tools; (* Check depends *) List.iter (function | FindlibPackage (findlib_pkg, version_comparator) -> begin try var_ignore_eval (BaseCheck.package ?version_comparator findlib_pkg) with e -> warn_exception e; match version_comparator with | None -> add_errors (f_ "Cannot find findlib package %s") findlib_pkg | Some ver_cmp -> add_errors (f_ "Cannot find findlib package %s (%s)") findlib_pkg (OASISVersion.string_of_comparator ver_cmp) end | InternalLibrary nm1 -> (* Check that matching library is built *) List.iter (function | Library ({cs_name = nm2}, {bs_build = build}, _) when nm1 = nm2 -> if not (var_choose build) then add_errors (f_ "Cannot find buildable internal library \ '%s' when checking build depends") nm1 | _ -> ()) pkg.sections) bs.bs_build_depends end in (* Parse command line *) BaseArgExt.parse argv (BaseEnv.args ()); (* OCaml version *) begin match pkg.ocaml_version with | Some ver_cmp -> begin try var_ignore_eval (BaseCheck.version "ocaml" ver_cmp BaseStandardVar.ocaml_version) with e -> warn_exception e; add_errors (f_ "OCaml version %s doesn't match version constraint %s") (BaseStandardVar.ocaml_version ()) (OASISVersion.string_of_comparator ver_cmp) end | None -> () end; (* Findlib version *) begin match pkg.findlib_version with | Some ver_cmp -> begin try var_ignore_eval (BaseCheck.version "findlib" ver_cmp BaseStandardVar.findlib_version) with e -> warn_exception e; add_errors (f_ "Findlib version %s doesn't match version constraint %s") (BaseStandardVar.findlib_version ()) (OASISVersion.string_of_comparator ver_cmp) end | None -> () end; (* Make sure the findlib version is fine for the OCaml compiler. *) begin let ocaml_ge4 = OASISVersion.version_compare (OASISVersion.version_of_string (BaseStandardVar.ocaml_version())) (OASISVersion.version_of_string "4.0.0") >= 0 in if ocaml_ge4 then let findlib_lt132 = OASISVersion.version_compare (OASISVersion.version_of_string (BaseStandardVar.findlib_version())) (OASISVersion.version_of_string "1.3.2") < 0 in if findlib_lt132 then add_errors "OCaml >= 4.0.0 requires Findlib version >= 1.3.2" end; (* FlexDLL *) if BaseStandardVar.os_type () = "Win32" || BaseStandardVar.os_type () = "Cygwin" then begin try var_ignore_eval BaseStandardVar.flexlink with e -> warn_exception e; add_errors (f_ "Cannot find 'flexlink'") end; (* Check build depends *) List.iter (function | Executable (_, bs, _) | Library (_, bs, _) as sct -> build_checks sct bs | Doc (_, doc) -> if var_choose doc.doc_build then check_tools doc.doc_build_tools | Test (_, test) -> if var_choose test.test_run then check_tools test.test_tools | _ -> ()) pkg.sections; (* Check if we need native dynlink (presence of libraries that compile to * native) *) begin let has_cmxa = List.exists (function | Library (_, bs, _) -> var_choose bs.bs_build && (bs.bs_compiled_object = Native || (bs.bs_compiled_object = Best && bool_of_string (BaseStandardVar.is_native ()))) | _ -> false) pkg.sections in if has_cmxa then var_ignore_eval BaseStandardVar.native_dynlink end; (* Check errors *) if SetString.empty != !errors then begin List.iter (fun e -> error "%s" e) (SetString.elements !errors); failwithf (fn_ "%d configuration error" "%d configuration errors" (SetString.cardinal !errors)) (SetString.cardinal !errors) end end module InternalInstallPlugin = struct # 21 "/home/gildor/programmation/oasis/src/plugins/internal/InternalInstallPlugin.ml" (** Install using internal scheme @author Sylvain Le Gall *) open BaseEnv open BaseStandardVar open BaseMessage open OASISTypes open OASISFindlib open OASISGettext open OASISUtils let exec_hook = ref (fun (cs, bs, exec) -> cs, bs, exec) let lib_hook = ref (fun (cs, bs, lib) -> cs, bs, lib, []) let obj_hook = ref (fun (cs, bs, obj) -> cs, bs, obj, []) let doc_hook = ref (fun (cs, doc) -> cs, doc) let install_file_ev = "install-file" let install_dir_ev = "install-dir" let install_findlib_ev = "install-findlib" let win32_max_command_line_length = 8000 let split_install_command ocamlfind findlib_name meta files = if Sys.os_type = "Win32" then (* Arguments for the first command: *) let first_args = ["install"; findlib_name; meta] in (* Arguments for remaining commands: *) let other_args = ["install"; findlib_name; "-add"] in (* Extract as much files as possible from [files], [len] is the current command line length: *) let rec get_files len acc files = match files with | [] -> (List.rev acc, []) | file :: rest -> let len = len + 1 + String.length file in if len > win32_max_command_line_length then (List.rev acc, files) else get_files len (file :: acc) rest in (* Split the command into several commands. *) let rec split args files = match files with | [] -> [] | _ -> (* Length of "ocamlfind install [META|-add]" *) let len = List.fold_left (fun len arg -> len + 1 (* for the space *) + String.length arg) (String.length ocamlfind) args in match get_files len [] files with | ([], _) -> failwith (s_ "Command line too long.") | (firsts, others) -> let cmd = args @ firsts in (* Use -add for remaining commands: *) let () = let findlib_ge_132 = OASISVersion.comparator_apply (OASISVersion.version_of_string (BaseStandardVar.findlib_version ())) (OASISVersion.VGreaterEqual (OASISVersion.version_of_string "1.3.2")) in if not findlib_ge_132 then failwithf (f_ "Installing the library %s require to use the flag \ '-add' of ocamlfind because the command line is too \ long. This flag is only available for findlib 1.3.2. \ Please upgrade findlib from %s to 1.3.2") findlib_name (BaseStandardVar.findlib_version ()) in let cmds = split other_args others in cmd :: cmds in (* The first command does not use -add: *) split first_args files else ["install" :: findlib_name :: meta :: files] let install pkg argv = let in_destdir = try let destdir = destdir () in (* Practically speaking destdir is prepended * at the beginning of the target filename *) fun fn -> destdir^fn with PropList.Not_set _ -> fun fn -> fn in let install_file ?tgt_fn src_file envdir = let tgt_dir = in_destdir (envdir ()) in let tgt_file = Filename.concat tgt_dir (match tgt_fn with | Some fn -> fn | None -> Filename.basename src_file) in (* Create target directory if needed *) OASISFileUtil.mkdir_parent ~ctxt:!BaseContext.default (fun dn -> info (f_ "Creating directory '%s'") dn; BaseLog.register install_dir_ev dn) tgt_dir; (* Really install files *) info (f_ "Copying file '%s' to '%s'") src_file tgt_file; OASISFileUtil.cp ~ctxt:!BaseContext.default src_file tgt_file; BaseLog.register install_file_ev tgt_file in (* Install data into defined directory *) let install_data srcdir lst tgtdir = let tgtdir = OASISHostPath.of_unix (var_expand tgtdir) in List.iter (fun (src, tgt_opt) -> let real_srcs = OASISFileUtil.glob ~ctxt:!BaseContext.default (Filename.concat srcdir src) in if real_srcs = [] then failwithf (f_ "Wildcard '%s' doesn't match any files") src; List.iter (fun fn -> install_file fn (fun () -> match tgt_opt with | Some s -> OASISHostPath.of_unix (var_expand s) | None -> tgtdir)) real_srcs) lst in (** Install all libraries *) let install_libs pkg = let files_of_library (f_data, acc) data_lib = let cs, bs, lib, lib_extra = !lib_hook data_lib in if var_choose bs.bs_install && BaseBuilt.is_built BaseBuilt.BLib cs.cs_name then begin let acc = (* Start with acc + lib_extra *) List.rev_append lib_extra acc in let acc = (* Add uncompiled header from the source tree *) let path = OASISHostPath.of_unix bs.bs_path in List.fold_left (fun acc modul -> try List.find OASISFileUtil.file_exists_case (List.map (Filename.concat path) [modul^".mli"; modul^".ml"; String.uncapitalize modul^".mli"; String.capitalize modul^".mli"; String.uncapitalize modul^".ml"; String.capitalize modul^".ml"]) :: acc with Not_found -> begin warning (f_ "Cannot find source header for module %s \ in library %s") modul cs.cs_name; acc end) acc lib.lib_modules in let acc = (* Get generated files *) BaseBuilt.fold BaseBuilt.BLib cs.cs_name (fun acc fn -> fn :: acc) acc in let f_data () = (* Install data associated with the library *) install_data bs.bs_path bs.bs_data_files (Filename.concat (datarootdir ()) pkg.name); f_data () in (f_data, acc) end else begin (f_data, acc) end and files_of_object (f_data, acc) data_obj = let cs, bs, obj, obj_extra = !obj_hook data_obj in if var_choose bs.bs_install && BaseBuilt.is_built BaseBuilt.BObj cs.cs_name then begin let acc = (* Start with acc + obj_extra *) List.rev_append obj_extra acc in let acc = (* Add uncompiled header from the source tree *) let path = OASISHostPath.of_unix bs.bs_path in List.fold_left (fun acc modul -> try List.find OASISFileUtil.file_exists_case (List.map (Filename.concat path) [modul^".mli"; modul^".ml"; String.uncapitalize modul^".mli"; String.capitalize modul^".mli"; String.uncapitalize modul^".ml"; String.capitalize modul^".ml"]) :: acc with Not_found -> begin warning (f_ "Cannot find source header for module %s \ in object %s") modul cs.cs_name; acc end) acc obj.obj_modules in let acc = (* Get generated files *) BaseBuilt.fold BaseBuilt.BObj cs.cs_name (fun acc fn -> fn :: acc) acc in let f_data () = (* Install data associated with the object *) install_data bs.bs_path bs.bs_data_files (Filename.concat (datarootdir ()) pkg.name); f_data () in (f_data, acc) end else begin (f_data, acc) end in (* Install one group of library *) let install_group_lib grp = (* Iterate through all group nodes *) let rec install_group_lib_aux data_and_files grp = let data_and_files, children = match grp with | Container (_, children) -> data_and_files, children | Package (_, cs, bs, `Library lib, children) -> files_of_library data_and_files (cs, bs, lib), children | Package (_, cs, bs, `Object obj, children) -> files_of_object data_and_files (cs, bs, obj), children in List.fold_left install_group_lib_aux data_and_files children in (* Findlib name of the root library *) let findlib_name = findlib_of_group grp in (* Determine root library *) let root_lib = root_of_group grp in (* All files to install for this library *) let f_data, files = install_group_lib_aux (ignore, []) grp in (* Really install, if there is something to install *) if files = [] then begin warning (f_ "Nothing to install for findlib library '%s'") findlib_name end else begin let meta = (* Search META file *) let (_, bs, _) = root_lib in let res = Filename.concat bs.bs_path "META" in if not (OASISFileUtil.file_exists_case res) then failwithf (f_ "Cannot find file '%s' for findlib library %s") res findlib_name; res in let files = (* Make filename shorter to avoid hitting command max line length * too early, esp. on Windows. *) let remove_prefix p n = let plen = String.length p in let nlen = String.length n in if plen <= nlen && String.sub n 0 plen = p then begin let fn_sep = if Sys.os_type = "Win32" then '\\' else '/' in let cutpoint = plen + (if plen < nlen && n.[plen] = fn_sep then 1 else 0) in String.sub n cutpoint (nlen - cutpoint) end else n in List.map (remove_prefix (Sys.getcwd ())) files in info (f_ "Installing findlib library '%s'") findlib_name; let ocamlfind = ocamlfind () in let commands = split_install_command ocamlfind findlib_name meta files in List.iter (OASISExec.run ~ctxt:!BaseContext.default ocamlfind) commands; BaseLog.register install_findlib_ev findlib_name end; (* Install data files *) f_data (); in let group_libs, _, _ = findlib_mapping pkg in (* We install libraries in groups *) List.iter install_group_lib group_libs in let install_execs pkg = let install_exec data_exec = let (cs, bs, exec) = !exec_hook data_exec in if var_choose bs.bs_install && BaseBuilt.is_built BaseBuilt.BExec cs.cs_name then begin let exec_libdir () = Filename.concat (libdir ()) pkg.name in BaseBuilt.fold BaseBuilt.BExec cs.cs_name (fun () fn -> install_file ~tgt_fn:(cs.cs_name ^ ext_program ()) fn bindir) (); BaseBuilt.fold BaseBuilt.BExecLib cs.cs_name (fun () fn -> install_file fn exec_libdir) (); install_data bs.bs_path bs.bs_data_files (Filename.concat (datarootdir ()) pkg.name) end in List.iter (function | Executable (cs, bs, exec)-> install_exec (cs, bs, exec) | _ -> ()) pkg.sections in let install_docs pkg = let install_doc data = let (cs, doc) = !doc_hook data in if var_choose doc.doc_install && BaseBuilt.is_built BaseBuilt.BDoc cs.cs_name then begin let tgt_dir = OASISHostPath.of_unix (var_expand doc.doc_install_dir) in BaseBuilt.fold BaseBuilt.BDoc cs.cs_name (fun () fn -> install_file fn (fun () -> tgt_dir)) (); install_data Filename.current_dir_name doc.doc_data_files doc.doc_install_dir end in List.iter (function | Doc (cs, doc) -> install_doc (cs, doc) | _ -> ()) pkg.sections in install_libs pkg; install_execs pkg; install_docs pkg (* Uninstall already installed data *) let uninstall _ argv = List.iter (fun (ev, data) -> if ev = install_file_ev then begin if OASISFileUtil.file_exists_case data then begin info (f_ "Removing file '%s'") data; Sys.remove data end else begin warning (f_ "File '%s' doesn't exist anymore") data end end else if ev = install_dir_ev then begin if Sys.file_exists data && Sys.is_directory data then begin if Sys.readdir data = [||] then begin info (f_ "Removing directory '%s'") data; OASISFileUtil.rmdir ~ctxt:!BaseContext.default data end else begin warning (f_ "Directory '%s' is not empty (%s)") data (String.concat ", " (Array.to_list (Sys.readdir data))) end end else begin warning (f_ "Directory '%s' doesn't exist anymore") data end end else if ev = install_findlib_ev then begin info (f_ "Removing findlib library '%s'") data; OASISExec.run ~ctxt:!BaseContext.default (ocamlfind ()) ["remove"; data] end else failwithf (f_ "Unknown log event '%s'") ev; BaseLog.unregister ev data) (* We process event in reverse order *) (List.rev (BaseLog.filter [install_file_ev; install_dir_ev; install_findlib_ev;])) end # 5452 "setup.ml" module OCamlbuildCommon = struct # 21 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/OCamlbuildCommon.ml" (** Functions common to OCamlbuild build and doc plugin *) open OASISGettext open BaseEnv open BaseStandardVar let ocamlbuild_clean_ev = "ocamlbuild-clean" let ocamlbuildflags = var_define ~short_desc:(fun () -> "OCamlbuild additional flags") "ocamlbuildflags" (fun () -> "") (** Fix special arguments depending on environment *) let fix_args args extra_argv = List.flatten [ if (os_type ()) = "Win32" then [ "-classic-display"; "-no-log"; "-no-links"; "-install-lib-dir"; (Filename.concat (standard_library ()) "ocamlbuild") ] else []; if not (bool_of_string (is_native ())) || (os_type ()) = "Win32" then [ "-byte-plugin" ] else []; args; if bool_of_string (debug ()) then ["-tag"; "debug"] else []; if bool_of_string (profile ()) then ["-tag"; "profile"] else []; OASISString.nsplit (ocamlbuildflags ()) ' '; Array.to_list extra_argv; ] (** Run 'ocamlbuild -clean' if not already done *) let run_clean extra_argv = let extra_cli = String.concat " " (Array.to_list extra_argv) in (* Run if never called with these args *) if not (BaseLog.exists ocamlbuild_clean_ev extra_cli) then begin OASISExec.run ~ctxt:!BaseContext.default (ocamlbuild ()) (fix_args ["-clean"] extra_argv); BaseLog.register ocamlbuild_clean_ev extra_cli; at_exit (fun () -> try BaseLog.unregister ocamlbuild_clean_ev extra_cli with _ -> ()) end (** Run ocamlbuild, unregister all clean events *) let run_ocamlbuild args extra_argv = (* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html *) OASISExec.run ~ctxt:!BaseContext.default (ocamlbuild ()) (fix_args args extra_argv); (* Remove any clean event, we must run it again *) List.iter (fun (e, d) -> BaseLog.unregister e d) (BaseLog.filter [ocamlbuild_clean_ev]) (** Determine real build directory *) let build_dir extra_argv = let rec search_args dir = function | "-build-dir" :: dir :: tl -> search_args dir tl | _ :: tl -> search_args dir tl | [] -> dir in search_args "_build" (fix_args [] extra_argv) end module OCamlbuildPlugin = struct # 21 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/OCamlbuildPlugin.ml" (** Build using ocamlbuild @author Sylvain Le Gall *) open OASISTypes open OASISGettext open OASISUtils open BaseEnv open OCamlbuildCommon open BaseStandardVar open BaseMessage let cond_targets_hook = ref (fun lst -> lst) let build pkg argv = (* Return the filename in build directory *) let in_build_dir fn = Filename.concat (build_dir argv) fn in (* Return the unix filename in host build directory *) let in_build_dir_of_unix fn = in_build_dir (OASISHostPath.of_unix fn) in (* Checks if the string [fn] ends with [nd] *) let ends_with nd fn = let nd_len = String.length nd in (String.length fn >= nd_len) && (String.sub fn (String.length fn - nd_len) nd_len) = nd in let cond_targets = List.fold_left (fun acc -> function | Library (cs, bs, lib) when var_choose bs.bs_build -> begin let evs, unix_files = BaseBuilt.of_library in_build_dir_of_unix (cs, bs, lib) in let tgts = List.flatten (List.filter (fun l -> l <> []) (List.map (List.filter (fun fn -> ends_with ".cma" fn || ends_with ".cmxs" fn || ends_with ".cmxa" fn || ends_with (ext_lib ()) fn || ends_with (ext_dll ()) fn)) unix_files)) in match tgts with | _ :: _ -> (evs, tgts) :: acc | [] -> failwithf (f_ "No possible ocamlbuild targets for library %s") cs.cs_name end | Object (cs, bs, obj) when var_choose bs.bs_build -> begin let evs, unix_files = BaseBuilt.of_object in_build_dir_of_unix (cs, bs, obj) in let tgts = List.flatten (List.filter (fun l -> l <> []) (List.map (List.filter (fun fn -> ends_with ".cmo" fn || ends_with ".cmx" fn)) unix_files)) in match tgts with | _ :: _ -> (evs, tgts) :: acc | [] -> failwithf (f_ "No possible ocamlbuild targets for object %s") cs.cs_name end | Executable (cs, bs, exec) when var_choose bs.bs_build -> begin let evs, unix_exec_is, unix_dll_opt = BaseBuilt.of_executable in_build_dir_of_unix (cs, bs, exec) in let target ext = let unix_tgt = (OASISUnixPath.concat bs.bs_path (OASISUnixPath.chop_extension exec.exec_main_is))^ext in let evs = (* Fix evs, we want to use the unix_tgt, without copying *) List.map (function | BaseBuilt.BExec, nm, lst when nm = cs.cs_name -> BaseBuilt.BExec, nm, [[in_build_dir_of_unix unix_tgt]] | ev -> ev) evs in evs, [unix_tgt] in (* Add executable *) let acc = match bs.bs_compiled_object with | Native -> (target ".native") :: acc | Best when bool_of_string (is_native ()) -> (target ".native") :: acc | Byte | Best -> (target ".byte") :: acc in acc end | Library _ | Object _ | Executable _ | Test _ | SrcRepo _ | Flag _ | Doc _ -> acc) [] (* Keep the pkg.sections ordered *) (List.rev pkg.sections); in (* Check and register built files *) let check_and_register (bt, bnm, lst) = List.iter (fun fns -> if not (List.exists OASISFileUtil.file_exists_case fns) then failwithf (f_ "No one of expected built files %s exists") (String.concat (s_ ", ") (List.map (Printf.sprintf "'%s'") fns))) lst; (BaseBuilt.register bt bnm lst) in let cond_targets = (* Run the hook *) !cond_targets_hook cond_targets in (* Run a list of target... *) run_ocamlbuild (List.flatten (List.map snd cond_targets)) argv; (* ... and register events *) List.iter check_and_register (List.flatten (List.map fst cond_targets)) let clean pkg extra_args = run_clean extra_args; List.iter (function | Library (cs, _, _) -> BaseBuilt.unregister BaseBuilt.BLib cs.cs_name | Executable (cs, _, _) -> BaseBuilt.unregister BaseBuilt.BExec cs.cs_name; BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name | _ -> ()) pkg.sections end module OCamlbuildDocPlugin = struct # 21 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" (* Create documentation using ocamlbuild .odocl files @author Sylvain Le Gall *) open OASISTypes open OASISGettext open OASISMessage open OCamlbuildCommon open BaseStandardVar let doc_build path pkg (cs, doc) argv = let index_html = OASISUnixPath.make [ path; cs.cs_name^".docdir"; "index.html"; ] in let tgt_dir = OASISHostPath.make [ build_dir argv; OASISHostPath.of_unix path; cs.cs_name^".docdir"; ] in run_ocamlbuild [index_html] argv; List.iter (fun glb -> BaseBuilt.register BaseBuilt.BDoc cs.cs_name [OASISFileUtil.glob ~ctxt:!BaseContext.default (Filename.concat tgt_dir glb)]) ["*.html"; "*.css"] let doc_clean t pkg (cs, doc) argv = run_clean argv; BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name end # 5807 "setup.ml" module CustomPlugin = struct # 21 "/home/gildor/programmation/oasis/src/plugins/custom/CustomPlugin.ml" (** Generate custom configure/build/doc/test/install system @author *) open BaseEnv open OASISGettext open OASISTypes type t = { cmd_main: command_line conditional; cmd_clean: (command_line option) conditional; cmd_distclean: (command_line option) conditional; } let run = BaseCustom.run let main t _ extra_args = let cmd, args = var_choose ~name:(s_ "main command") t.cmd_main in run cmd args extra_args let clean t pkg extra_args = match var_choose t.cmd_clean with | Some (cmd, args) -> run cmd args extra_args | _ -> () let distclean t pkg extra_args = match var_choose t.cmd_distclean with | Some (cmd, args) -> run cmd args extra_args | _ -> () module Build = struct let main t pkg extra_args = main t pkg extra_args; List.iter (fun sct -> let evs = match sct with | Library (cs, bs, lib) when var_choose bs.bs_build -> begin let evs, _ = BaseBuilt.of_library OASISHostPath.of_unix (cs, bs, lib) in evs end | Executable (cs, bs, exec) when var_choose bs.bs_build -> begin let evs, _, _ = BaseBuilt.of_executable OASISHostPath.of_unix (cs, bs, exec) in evs end | _ -> [] in List.iter (fun (bt, bnm, lst) -> BaseBuilt.register bt bnm lst) evs) pkg.sections let clean t pkg extra_args = clean t pkg extra_args; (* TODO: this seems to be pretty generic (at least wrt to ocamlbuild * considering moving this to BaseSetup? *) List.iter (function | Library (cs, _, _) -> BaseBuilt.unregister BaseBuilt.BLib cs.cs_name | Executable (cs, _, _) -> BaseBuilt.unregister BaseBuilt.BExec cs.cs_name; BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name | _ -> ()) pkg.sections let distclean t pkg extra_args = distclean t pkg extra_args end module Test = struct let main t pkg (cs, test) extra_args = try main t pkg extra_args; 0.0 with Failure s -> BaseMessage.warning (f_ "Test '%s' fails: %s") cs.cs_name s; 1.0 let clean t pkg (cs, test) extra_args = clean t pkg extra_args let distclean t pkg (cs, test) extra_args = distclean t pkg extra_args end module Doc = struct let main t pkg (cs, _) extra_args = main t pkg extra_args; BaseBuilt.register BaseBuilt.BDoc cs.cs_name [] let clean t pkg (cs, _) extra_args = clean t pkg extra_args; BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name let distclean t pkg (cs, _) extra_args = distclean t pkg extra_args end end # 5943 "setup.ml" open OASISTypes;; let setup_t = { BaseSetup.configure = InternalConfigurePlugin.configure; build = OCamlbuildPlugin.build; test = [ ("main", CustomPlugin.Test.main { CustomPlugin.cmd_main = [(OASISExpr.EBool true, ("$test", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)]; }); ("bench", CustomPlugin.Test.main { CustomPlugin.cmd_main = [(OASISExpr.EBool true, ("$speedtest", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)]; }) ]; doc = [("api-cryptokit", OCamlbuildDocPlugin.doc_build "src/")]; install = InternalInstallPlugin.install; uninstall = InternalInstallPlugin.uninstall; clean = [OCamlbuildPlugin.clean]; clean_test = [ ("main", CustomPlugin.Test.clean { CustomPlugin.cmd_main = [(OASISExpr.EBool true, ("$test", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)]; }); ("bench", CustomPlugin.Test.clean { CustomPlugin.cmd_main = [(OASISExpr.EBool true, ("$speedtest", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)]; }) ]; clean_doc = [("api-cryptokit", OCamlbuildDocPlugin.doc_clean "src/")]; distclean = []; distclean_test = [ ("main", CustomPlugin.Test.distclean { CustomPlugin.cmd_main = [(OASISExpr.EBool true, ("$test", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)]; }); ("bench", CustomPlugin.Test.distclean { CustomPlugin.cmd_main = [(OASISExpr.EBool true, ("$speedtest", []))]; cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)]; }) ]; distclean_doc = []; package = { oasis_version = "0.3"; ocaml_version = None; findlib_version = None; name = "cryptokit"; version = "1.9"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit { OASISLicense.license = "LGPL"; excption = Some "OCaml linking"; version = OASISLicense.Version "2"; }); license_file = None; copyrights = []; maintainers = []; authors = ["Xavier Leroy"]; homepage = None; synopsis = "Cryptographic primitives"; description = Some "This library provides a variety of cryptographic primitives that can be used\nto implement cryptographic protocols in security-sensitive applications. The\nprimitives provided include:\n\n- Symmetric-key ciphers: AES, DES, Triple-DES, ARCfour,\n in ECB, CBC, CFB and OFB modes.\n- Public-key cryptography: RSA encryption, Diffie-Hellman key agreement.\n- Hash functions and MACs: SHA-1, SHA-256, SHA-3, RIPEMD160, MD5,\n and MACs based on AES and DES.\n- Random number generation.\n- Encodings and compression: base 64, hexadecimal, Zlib compression.\n\nAdditional ciphers and hashes can easily be used in conjunction with\nthe library. In particular, basic mechanisms such as chaining modes,\noutput buffering, and padding are provided by generic classes that can\neasily be composed with user-provided ciphers. More generally, the library\npromotes a \"Lego\"-like style of constructing and composing\ntransformations over character streams."; categories = []; conf_type = (`Configure, "internal", Some "0.3"); conf_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)]; }; build_type = (`Build, "ocamlbuild", Some "0.3"); build_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)]; }; install_type = (`Install, "internal", Some "0.3"); install_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)]; }; uninstall_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)]; }; clean_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)]; }; distclean_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)]; }; files_ab = []; sections = [ Flag ({ cs_name = "zlib"; cs_data = PropList.Data.create (); cs_plugin_data = []; }, { flag_description = Some "Enable ZLib"; flag_default = [ (OASISExpr.EBool true, false); (OASISExpr.ENot (OASISExpr.ETest ("os_type", "Win32")), true) ]; }); Library ({ cs_name = "cryptokit"; cs_data = PropList.Data.create (); cs_plugin_data = []; }, { bs_build = [(OASISExpr.EBool true, true)]; bs_install = [(OASISExpr.EBool true, true)]; bs_path = "src"; bs_compiled_object = Best; bs_build_depends = [ FindlibPackage ("unix", None); FindlibPackage ("num", None) ]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = [ "arcfour.c"; "arcfour.h"; "stubs-arcfour.c"; "blowfish.c"; "blowfish.h"; "stubs-blowfish.c"; "d3des.c"; "d3des.h"; "stubs-des.c"; "rijndael-alg-fst.c"; "rijndael-alg-fst.h"; "ripemd160.c"; "ripemd160.h"; "stubs-ripemd160.c"; "sha1.c"; "sha1.h"; "stubs-sha1.c"; "sha256.c"; "sha256.h"; "stubs-sha256.c"; "stubs-aes.c"; "stubs-md5.c"; "stubs-misc.c"; "stubs-rng.c"; "stubs-zlib.c"; "keccak.h"; "keccak.c"; "stubs-sha3.c" ]; bs_data_files = []; bs_ccopt = [ (OASISExpr.EBool true, []); (OASISExpr.EFlag "zlib", ["-O"; "-DHAVE_ZLIB"]) ]; bs_cclib = [ (OASISExpr.EBool true, []); (OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64"))), ["-ladvapi32"]); (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")), ["advapi32.lib"]); (OASISExpr.EAnd (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), ["advapi32.lib"; "-ladvapi32"]); (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), ["zlib.lib"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), ["zlib.lib"; "-ladvapi32"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), ["zlib.lib"; "advapi32.lib"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), ["zlib.lib"; "advapi32.lib"; "-ladvapi32"]); (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), ["-lz"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), ["-lz"; "-ladvapi32"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), ["-lz"; "advapi32.lib"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), ["-lz"; "advapi32.lib"; "-ladvapi32"]) ]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])]; }, { lib_modules = ["Cryptokit"]; lib_pack = false; lib_internal_modules = []; lib_findlib_parent = None; lib_findlib_name = None; lib_findlib_containers = []; }); Executable ({ cs_name = "test"; cs_data = PropList.Data.create (); cs_plugin_data = []; }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "tests", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "test"; bs_compiled_object = Byte; bs_build_depends = [InternalLibrary "cryptokit"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])]; }, {exec_custom = true; exec_main_is = "test.ml"; }); Test ({ cs_name = "main"; cs_data = PropList.Data.create (); cs_plugin_data = []; }, { test_type = (`Test, "custom", Some "0.3"); test_command = [(OASISExpr.EBool true, ("$test", []))]; test_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)]; }; test_working_directory = None; test_run = [ (OASISExpr.ENot (OASISExpr.EFlag "tests"), false); (OASISExpr.EFlag "tests", true) ]; test_tools = [ ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"; InternalExecutable "test" ]; }); Flag ({ cs_name = "bench"; cs_data = PropList.Data.create (); cs_plugin_data = []; }, { flag_description = Some "Build and run benchmark"; flag_default = [(OASISExpr.EBool true, false)]; }); Executable ({ cs_name = "speedtest"; cs_data = PropList.Data.create (); cs_plugin_data = []; }, { bs_build = [ (OASISExpr.EBool true, false); (OASISExpr.EFlag "bench", true) ]; bs_install = [(OASISExpr.EBool true, false)]; bs_path = "test"; bs_compiled_object = Native; bs_build_depends = [InternalLibrary "cryptokit"]; bs_build_tools = [ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]; bs_c_sources = []; bs_data_files = []; bs_ccopt = [(OASISExpr.EBool true, [])]; bs_cclib = [(OASISExpr.EBool true, [])]; bs_dlllib = [(OASISExpr.EBool true, [])]; bs_dllpath = [(OASISExpr.EBool true, [])]; bs_byteopt = [(OASISExpr.EBool true, [])]; bs_nativeopt = [(OASISExpr.EBool true, [])]; }, {exec_custom = false; exec_main_is = "speedtest.ml"; }); Test ({ cs_name = "bench"; cs_data = PropList.Data.create (); cs_plugin_data = []; }, { test_type = (`Test, "custom", Some "0.3"); test_command = [(OASISExpr.EBool true, ("$speedtest", []))]; test_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)]; }; test_working_directory = None; test_run = [ (OASISExpr.ENot (OASISExpr.EFlag "tests"), false); (OASISExpr.EFlag "tests", false); (OASISExpr.EAnd (OASISExpr.EFlag "tests", OASISExpr.EFlag "bench"), true) ]; test_tools = [ ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"; InternalExecutable "speedtest" ]; }); Doc ({ cs_name = "api-cryptokit"; cs_data = PropList.Data.create (); cs_plugin_data = []; }, { doc_type = (`Doc, "ocamlbuild", Some "0.3"); doc_custom = { pre_command = [(OASISExpr.EBool true, None)]; post_command = [(OASISExpr.EBool true, None)]; }; doc_build = [ (OASISExpr.ENot (OASISExpr.EFlag "docs"), false); (OASISExpr.EFlag "docs", true) ]; doc_install = [(OASISExpr.EBool true, true)]; doc_install_dir = "$htmldir/cryptokit"; doc_title = "API reference for Cryptokit"; doc_authors = []; doc_abstract = None; doc_format = OtherDoc; doc_data_files = []; doc_build_tools = [ ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"; ExternalTool "ocamldoc" ]; }); SrcRepo ({ cs_name = "head"; cs_data = PropList.Data.create (); cs_plugin_data = []; }, { src_repo_type = Svn; src_repo_location = "http://scm.ocamlcore.org/svnroot/cryptokit/trunk"; src_repo_browser = Some "https://forge.ocamlcore.org/scm/browser.php?group_id=133"; src_repo_module = None; src_repo_branch = None; src_repo_tag = None; src_repo_subdir = None; }); SrcRepo ({ cs_name = "this"; cs_data = PropList.Data.create (); cs_plugin_data = []; }, { src_repo_type = Svn; src_repo_location = "http://scm.ocamlcore.org/svnroot/tags/release18"; src_repo_browser = Some "https://forge.ocamlcore.org/scm/browser.php?group_id=133"; src_repo_module = None; src_repo_branch = None; src_repo_tag = None; src_repo_subdir = None; }) ]; plugins = [ (`Extra, "META", Some "0.3"); (`Extra, "DevFiles", Some "0.3"); (`Extra, "StdFiles", Some "0.3") ]; schema_data = PropList.Data.create (); plugin_data = []; }; oasis_fn = Some "_oasis"; oasis_version = "0.3.1"; oasis_digest = Some "\018\255\254\014\171\000\029\187!\1783\153\023U{\029"; oasis_exec = None; oasis_setup_args = []; setup_update = false; };; let setup () = BaseSetup.setup setup_t;; # 6510 "setup.ml" (* OASIS_STOP *) let zlib_include = BaseEnv.var_define ~cli:BaseEnv.CLIAuto ~arg_help:"dir" ~short_desc:(fun () -> "Define include path for zlib.") "zlib_include" (fun () -> "") let zlib_libdir = BaseEnv.var_define ~cli:BaseEnv.CLIAuto ~arg_help:"dir" ~short_desc:(fun () -> "Define library path for zlib.") "zlib_libdir" (fun () -> "") let () = setup ();; cryptokit-1.9/Changes0000644000175000017500000000202612204467476014244 0ustar gildorgildorRelease 1.9: - More fixes to build in Windows with zlib (mingw and msvc). Release 1.8: - Build .cmxs with C bindings (Closes: #1303) - Use advapi32 on Windows (Close: #1055) - Allow to define --zlib-include and --zlib-libdir if zlib is not installed in the standard location. Release 1.7: - Added SHA-3 hash function. Release 1.6: - Regenerate setup.ml with oasis 0.3.0~rc6 version Release 1.5: - Fix bug check in buffered_output#ensure_capacity (Closes: #879) - Allow to have padding in Base64 (Closes: #897) Release 1.4: - Added Blowfish block cipher. - Added MAC functions based on HMAC construction applied to SHA-256 and RIPEMD-160. - Added OASIS and findlib support (Closes: #589) Release 1.3: - Added hash functions SHA-256 and RIPEMD-160. - Added "flush" method to transforms. - Fixed infinite loop in decompression of incorrect data. Release 1.2: - MS Windows port Release 1.1: - Added Diffie-Hellman key agreement - Exported raw modular arithmetic operations (mod_power, mod_mult) Release 1.0: - First public release cryptokit-1.9/myocamlbuild.ml0000644000175000017500000007225412204237263015763 0ustar gildorgildor(* OASIS_START *) (* DO NOT EDIT (digest: 057107233606b6ea9ab1878fbf84e419) *) module OASISGettext = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISGettext.ml" let ns_ str = str let s_ str = str let f_ (str : ('a, 'b, 'c, 'd) format4) = str let fn_ fmt1 fmt2 n = if n = 1 then fmt1^^"" else fmt2^^"" let init = [] end module OASISExpr = struct # 21 "/home/gildor/programmation/oasis/src/oasis/OASISExpr.ml" open OASISGettext type test = string type flag = string type t = | EBool of bool | ENot of t | EAnd of t * t | EOr of t * t | EFlag of flag | ETest of test * string type 'a choices = (t * 'a) list let eval var_get t = let rec eval' = function | EBool b -> b | ENot e -> not (eval' e) | EAnd (e1, e2) -> (eval' e1) && (eval' e2) | EOr (e1, e2) -> (eval' e1) || (eval' e2) | EFlag nm -> let v = var_get nm in assert(v = "true" || v = "false"); (v = "true") | ETest (nm, vl) -> let v = var_get nm in (v = vl) in eval' t let choose ?printer ?name var_get lst = let rec choose_aux = function | (cond, vl) :: tl -> if eval var_get cond then vl else choose_aux tl | [] -> let str_lst = if lst = [] then s_ "" else String.concat (s_ ", ") (List.map (fun (cond, vl) -> match printer with | Some p -> p vl | None -> s_ "") lst) in match name with | Some nm -> failwith (Printf.sprintf (f_ "No result for the choice list '%s': %s") nm str_lst) | None -> failwith (Printf.sprintf (f_ "No result for a choice list: %s") str_lst) in choose_aux (List.rev lst) end # 117 "myocamlbuild.ml" module BaseEnvLight = struct # 21 "/home/gildor/programmation/oasis/src/base/BaseEnvLight.ml" module MapString = Map.Make(String) type t = string MapString.t let default_filename = Filename.concat (Sys.getcwd ()) "setup.data" let load ?(allow_empty=false) ?(filename=default_filename) () = if Sys.file_exists filename then begin let chn = open_in_bin filename in let st = Stream.of_channel chn in let line = ref 1 in let st_line = Stream.from (fun _ -> try match Stream.next st with | '\n' -> incr line; Some '\n' | c -> Some c with Stream.Failure -> None) in let lexer = Genlex.make_lexer ["="] st_line in let rec read_file mp = match Stream.npeek 3 lexer with | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> Stream.junk lexer; Stream.junk lexer; Stream.junk lexer; read_file (MapString.add nm value mp) | [] -> mp | _ -> failwith (Printf.sprintf "Malformed data file '%s' line %d" filename !line) in let mp = read_file MapString.empty in close_in chn; mp end else if allow_empty then begin MapString.empty end else begin failwith (Printf.sprintf "Unable to load environment, the file '%s' doesn't exist." filename) end let var_get name env = let rec var_expand str = let buff = Buffer.create ((String.length str) * 2) in Buffer.add_substitute buff (fun var -> try var_expand (MapString.find var env) with Not_found -> failwith (Printf.sprintf "No variable %s defined when trying to expand %S." var str)) str; Buffer.contents buff in var_expand (MapString.find name env) let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst end # 215 "myocamlbuild.ml" module MyOCamlbuildFindlib = struct # 21 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" (** OCamlbuild extension, copied from * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild * by N. Pouillard and others * * Updated on 2009/02/28 * * Modified by Sylvain Le Gall *) open Ocamlbuild_plugin (* these functions are not really officially exported *) let run_and_read = Ocamlbuild_pack.My_unix.run_and_read let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings let split s ch = let buf = Buffer.create 13 in let x = ref [] in let flush () = x := (Buffer.contents buf) :: !x; Buffer.clear buf in String.iter (fun c -> if c = ch then flush () else Buffer.add_char buf c) s; flush (); List.rev !x let split_nl s = split s '\n' let before_space s = try String.before s (String.index s ' ') with Not_found -> s (* this lists all supported packages *) let find_packages () = List.map before_space (split_nl & run_and_read "ocamlfind list") (* this is supposed to list available syntaxes, but I don't know how to do it. *) let find_syntaxes () = ["camlp4o"; "camlp4r"] (* ocamlfind command *) let ocamlfind x = S[A"ocamlfind"; x] let dispatch = function | Before_options -> (* by using Before_options one let command line options have an higher priority *) (* on the contrary using After_options will guarantee to have the higher priority *) (* override default commands by ocamlfind ones *) Options.ocamlc := ocamlfind & A"ocamlc"; Options.ocamlopt := ocamlfind & A"ocamlopt"; Options.ocamldep := ocamlfind & A"ocamldep"; Options.ocamldoc := ocamlfind & A"ocamldoc"; Options.ocamlmktop := ocamlfind & A"ocamlmktop" | After_rules -> (* When one link an OCaml library/binary/package, one should use -linkpkg *) flag ["ocaml"; "link"; "program"] & A"-linkpkg"; (* For each ocamlfind package one inject the -package option when * compiling, computing dependencies, generating documentation and * linking. *) List.iter begin fun pkg -> flag ["ocaml"; "compile"; "pkg_"^pkg] & S[A"-package"; A pkg]; flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg]; flag ["ocaml"; "doc"; "pkg_"^pkg] & S[A"-package"; A pkg]; flag ["ocaml"; "link"; "pkg_"^pkg] & S[A"-package"; A pkg]; flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S[A"-package"; A pkg]; end (find_packages ()); (* Like -package but for extensions syntax. Morover -syntax is useless * when linking. *) List.iter begin fun syntax -> flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; end (find_syntaxes ()); (* The default "thread" tag is not compatible with ocamlfind. * Indeed, the default rules add the "threads.cma" or "threads.cmxa" * options when using this tag. When using the "-linkpkg" option with * ocamlfind, this module will then be added twice on the command line. * * To solve this, one approach is to add the "-thread" option when using * the "threads" package using the previous plugin. *) flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]); flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]) | _ -> () end module MyOCamlbuildBase = struct # 21 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" (** Base functions for writing myocamlbuild.ml @author Sylvain Le Gall *) open Ocamlbuild_plugin module OC = Ocamlbuild_pack.Ocaml_compiler type dir = string type file = string type name = string type tag = string # 56 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" type t = { lib_ocaml: (name * dir list) list; lib_c: (name * dir * file list) list; flags: (tag list * (spec OASISExpr.choices)) list; (* Replace the 'dir: include' from _tags by a precise interdepends in * directory. *) includes: (dir * dir list) list; } let env_filename = Pathname.basename BaseEnvLight.default_filename let dispatch_combine lst = fun e -> List.iter (fun dispatch -> dispatch e) lst let tag_libstubs nm = "use_lib"^nm^"_stubs" let nm_libstubs nm = nm^"_stubs" let dispatch t e = let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in match e with | Before_options -> let no_trailing_dot s = if String.length s >= 1 && s.[0] = '.' then String.sub s 1 ((String.length s) - 1) else s in List.iter (fun (opt, var) -> try opt := no_trailing_dot (BaseEnvLight.var_get var env) with Not_found -> Printf.eprintf "W: Cannot get variable %s" var) [ Options.ext_obj, "ext_obj"; Options.ext_lib, "ext_lib"; Options.ext_dll, "ext_dll"; ] | After_rules -> (* Declare OCaml libraries *) List.iter (function | nm, [] -> ocaml_lib nm | nm, dir :: tl -> ocaml_lib ~dir:dir (dir^"/"^nm); List.iter (fun dir -> List.iter (fun str -> flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) ["compile"; "infer_interface"; "doc"]) tl) t.lib_ocaml; (* Declare directories dependencies, replace "include" in _tags. *) List.iter (fun (dir, include_dirs) -> Pathname.define_context dir include_dirs) t.includes; (* Declare C libraries *) List.iter (fun (lib, dir, headers) -> (* Handle C part of library *) flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib] (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib"; A("-l"^(nm_libstubs lib))]); flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib] (S[A"-cclib"; A("-l"^(nm_libstubs lib))]); flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib] (S[A"-dllib"; A("dll"^(nm_libstubs lib))]); (* When ocaml link something that use the C library, then one need that file to be up to date. *) dep ["link"; "ocaml"; "program"; tag_libstubs lib] [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; dep ["compile"; "ocaml"; "program"; tag_libstubs lib] [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; (* TODO: be more specific about what depends on headers *) (* Depends on .h files *) dep ["compile"; "c"] headers; (* Setup search path for lib *) flag ["link"; "ocaml"; "use_"^lib] (S[A"-I"; P(dir)]); ) t.lib_c; (* Add flags *) List.iter (fun (tags, cond_specs) -> let spec = BaseEnvLight.var_choose cond_specs env in flag tags & spec) t.flags | _ -> () let dispatch_default t = dispatch_combine [ dispatch t; MyOCamlbuildFindlib.dispatch; ] end # 478 "myocamlbuild.ml" open Ocamlbuild_plugin;; let package_default = { MyOCamlbuildBase.lib_ocaml = [("cryptokit", ["src"])]; lib_c = [ ("cryptokit", "src", [ "src/arcfour.h"; "src/blowfish.h"; "src/d3des.h"; "src/rijndael-alg-fst.h"; "src/ripemd160.h"; "src/sha1.h"; "src/sha256.h"; "src/keccak.h" ]) ]; flags = [ (["oasis_library_cryptokit_ccopt"; "compile"], [ (OASISExpr.EBool true, S []); (OASISExpr.EFlag "zlib", S [A "-ccopt"; A "-O"; A "-ccopt"; A "-DHAVE_ZLIB"]) ]); (["oasis_library_cryptokit_cclib"; "link"], [ (OASISExpr.EBool true, S []); (OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64"))), S [A "-cclib"; A "-ladvapi32"]); (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")), S [A "-cclib"; A "advapi32.lib"]); (OASISExpr.EAnd (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), S [A "-cclib"; A "advapi32.lib"; A "-cclib"; A "-ladvapi32"]); (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), S [A "-cclib"; A "zlib.lib"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), S [A "-cclib"; A "zlib.lib"; A "-cclib"; A "-ladvapi32"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), S [A "-cclib"; A "zlib.lib"; A "-cclib"; A "advapi32.lib"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), S [ A "-cclib"; A "zlib.lib"; A "-cclib"; A "advapi32.lib"; A "-cclib"; A "-ladvapi32" ]); (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), S [A "-cclib"; A "-lz"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), S [A "-cclib"; A "-lz"; A "-cclib"; A "-ladvapi32"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), S [A "-cclib"; A "-lz"; A "-cclib"; A "advapi32.lib"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), S [ A "-cclib"; A "-lz"; A "-cclib"; A "advapi32.lib"; A "-cclib"; A "-ladvapi32" ]) ]); (["oasis_library_cryptokit_cclib"; "ocamlmklib"; "c"], [ (OASISExpr.EBool true, S []); (OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64"))), S [A "-ladvapi32"]); (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")), S [A "advapi32.lib"]); (OASISExpr.EAnd (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), S [A "advapi32.lib"; A "-ladvapi32"]); (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), S [A "zlib.lib"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), S [A "zlib.lib"; A "-ladvapi32"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), S [A "zlib.lib"; A "advapi32.lib"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), S [A "zlib.lib"; A "advapi32.lib"; A "-ladvapi32"]); (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), S [A "-lz"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), S [A "-lz"; A "-ladvapi32"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), S [A "-lz"; A "advapi32.lib"]); (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EAnd (OASISExpr.EFlag "zlib", OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64")))), OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EAnd (OASISExpr.ENot (OASISExpr.EOr (OASISExpr.ETest ("system", "win32"), OASISExpr.ETest ("system", "win64"))), OASISExpr.EOr (OASISExpr.ETest ("system", "mingw"), OASISExpr.ETest ("system", "mingw64")))), S [A "-lz"; A "advapi32.lib"; A "-ladvapi32"]) ]) ]; includes = [("test", ["src"])]; } ;; let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;; # 798 "myocamlbuild.ml" (* OASIS_STOP *) let package_default = (* TODO: use path to expand variable and there will be no need to load * environment at this stage. *) let env = BaseEnvLight.load ~filename:MyOCamlbuildBase.env_filename ~allow_empty:true () in let zlib_include = try BaseEnvLight.var_get "zlib_include" env with Not_found -> "" in let zlib_libdir = try BaseEnvLight.var_get "zlib_libdir" env with Not_found -> "" in {package_default with MyOCamlbuildBase.flags = (["oasis_library_cryptokit_ccopt"; "compile"], [ (OASISExpr.EBool true, S []); (OASISExpr.EBool (zlib_include <> ""), S [A "-ccopt"; A "-I"; A "-ccopt"; P zlib_include]) ]) :: (["oasis_library_cryptokit_cclib"; "link"], [ (OASISExpr.EBool true, S []); (OASISExpr.EBool (zlib_libdir <> ""), S [A "-cclib"; A "-L"; A "-cclib"; P zlib_libdir]) ]) :: (["oasis_library_cryptokit_cclib"; "ocamlmklib"; "c"], [ (OASISExpr.EBool true, S []); (OASISExpr.EBool (zlib_libdir <> ""), S [P ("-L"^zlib_libdir)]) ]) :: package_default.MyOCamlbuildBase.flags} let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;; Ocamlbuild_plugin.dispatch dispatch_default;; cryptokit-1.9/README.txt0000644000175000017500000001501112160414527014433 0ustar gildorgildor(* OASIS_START *) (* DO NOT EDIT (digest: e0e395579ad4c8ec0401e3ef76bfc6ab) *) This is the README file for the cryptokit distribution. Cryptographic primitives This library provides a variety of cryptographic primitives that can be used to implement cryptographic protocols in security-sensitive applications. The primitives provided include: - Symmetric-key ciphers: AES, DES, Triple-DES, ARCfour, in ECB, CBC, CFB and OFB modes. - Public-key cryptography: RSA encryption, Diffie-Hellman key agreement. - Hash functions and MACs: SHA-1, SHA-256, SHA-3, RIPEMD160, MD5, and MACs based on AES and DES. - Random number generation. - Encodings and compression: base 64, hexadecimal, Zlib compression. Additional ciphers and hashes can easily be used in conjunction with the library. In particular, basic mechanisms such as chaining modes, output buffering, and padding are provided by generic classes that can easily be composed with user-provided ciphers. More generally, the library promotes a "Lego"-like style of constructing and composing transformations over character streams. See the files INSTALL.txt for building and installation instructions. (* OASIS_STOP *) EXTRA REQUIREMENTS: - The Zlib C library, version 1.1.3 or up is recommended. If it is not installed on your system (look for libz.a or libz.so), get it from http://www.gzip.org/, or call configure with the flag "--disable-zlib". If you are running Linux or BSD, chances are that your distribution provides precompiled binaries for this library. - If the operating system does not provide the /dev/random device (for random number generation), consider installing the EGD entropy gathering daemon http://egd.sourceforge.net/ Without /dev/random nor EGD, this library cannot generate random data and RSA keys. The remainder of the library still works, though. WARNINGS AND DISCLAIMERS: Disclaimer 1: the author is not an expert in cryptography. While reasonable care has been taken to select good, widely-used implementations of the ciphers and hashes, and follow recommended practices found in reputable applied cryptography textbooks, you are advised to review thoroughly the implementation of this module before using it in a security-critical application. Disclaimer 2: some knowledge of cryptography is needed to use effectively this library. A recommended reading is the Handbook of Applied Cryptography http://www.cacr.math.uwaterloo.ca/hac/ Building secure applications out of cryptographic primitives also requires a general background in computer security. Disclaimer 3: in some countries, the use, distribution, import and/or export of cryptographic applications is restricted by law. The precise restrictions may depend on the strenght of the cryptography used (e.g. key size), but also on its purpose (e.g. confidentiality vs. authentication). It is up to the users of this library to comply with regulations applicable in their country. DESIGN NOTES AND REFERENCES: The library is organized around the concept of "transforms". A transform is an object that accepts strings, sub-strings, characters and bytes as input, transforms them, and buffers the output. While it is possible to enter all input, then fetch the output, lower memory requirements can be achieved by purging the output periodically during data input. The AES implementation is the public-domain optimized reference implementation by Daemen, Rijmen and Barreto. The DES implementation is based on Outerbridge's popular "d3des" implementation. This is not the fastest DES implementation available, but one of the cleanest. Outerbridge's code is marked as public domain. The Blowfish implementation is that of Paul Kocher with some performance improvements. It is under the LGPL. It passes the test vectors listed at http://www.schneier.com/code/vectors.txt ARCfour (``alleged RC4'') is implemented from scratch, based on the algorithm described in Schneier's _Applied_Cryptography_ SHA-1 is also implemented from scratch, based on the algorithm described in the _Handbook_of_Applied_Cryptography_. It passes the FIPS test vectors. SHA-256 is implemented from scratch based on FIPS publication 180-2. It passes the FIPS test vectors. SHA-3 is based on the "readable implementation" written and released by Markku-Juhani O. Saarinen. It passes the provisional test vectors listed at http://www.di-mgt.com.au/sha_testvectors.html RIPEMD-160 is based on the reference implementation by A.Bosselaers. It passes the test vectors listed at http://www.esat.kuleuven.ac.be/~bosselae/ripemd160.html MD5 uses the public-domain implementation by Colin Plumb that is also used in the OCaml runtime system for module Digest. RSA encryption and decryption was implemented from scratch, using OCaml's bignum library for arbitrary-precision arithmetic. Modular exponentiation uses the trivial Russian peasant algorithm, because the bignum library does not support Montgomery modular multiplication. The Chinese remainder theorem is exploited when possible, though. Like all ciphers in this library, the RSA implementation is *not* protected against timing attacks. RSA key generation follows the algorithms used in PGP 2.6.3. Probabilistic primality testing is achieved by Fermat tests using the first 8 prime numbers. While not as good on paper as a Miller-Rabin probabilistic primality test, this seems good enough for PGP, so it should be good enough for us. The seeded PRNG is a combination of AES encryption in CBC mode and a lagged Fibonacci generator with long period. It appears to pass the Diehard statistical tests. Still, better to use the system RNG if high-quality random numbers are needed. PERFORMANCE: Some performance figures measured on a Pentium 4 2Ghz: AES 128: raw encryption 39 Mbyte/s; with CBC and buffering 15 Mbytes/s AES 192: raw encryption 34 Mbyte/s; with CBC and buffering 14 Mbytes/s AES 256: raw encryption 29 Mbyte/s; with CBC and buffering 13 Mbytes/s DES: raw encryption 19 Mbyte/s; with CBC and buffering 8 Mbytes/s 3DES: raw encryption 6.5 Mbyte/s; with CBC and buffering 4.5 Mbytes/s ARC4: raw encryption 57 Mbyte/s; with buffering 47 Mbytes/s SHA1: 31 Mbyte/s SHA256: 21 Mbyte/s RIPEMD160: 21 Mbyte/s MD5: 53 Mbyte/s AES MAC: 20 Mbyte/s RSA 1024: key generation 120 ms public-key operation (public exponent 65537) 0.70 ms private-key operation 29 ms private-key operation with CRT 9 ms cryptokit-1.9/_oasis0000644000175000017500000000661612204237263014147 0ustar gildorgildorOASISFormat: 0.3 Name: cryptokit Version: 1.9 Authors: Xavier Leroy License: LGPL-2 with OCaml linking exception BuildTools: ocamlbuild, ocamldoc Plugins: META (0.3), DevFiles (0.3), StdFiles (0.3) Synopsis: Cryptographic primitives Description: This library provides a variety of cryptographic primitives that can be used to implement cryptographic protocols in security-sensitive applications. The primitives provided include: . - Symmetric-key ciphers: AES, DES, Triple-DES, ARCfour, in ECB, CBC, CFB and OFB modes. - Public-key cryptography: RSA encryption, Diffie-Hellman key agreement. - Hash functions and MACs: SHA-1, SHA-256, SHA-3, RIPEMD160, MD5, and MACs based on AES and DES. - Random number generation. - Encodings and compression: base 64, hexadecimal, Zlib compression. . Additional ciphers and hashes can easily be used in conjunction with the library. In particular, basic mechanisms such as chaining modes, output buffering, and padding are provided by generic classes that can easily be composed with user-provided ciphers. More generally, the library promotes a "Lego"-like style of constructing and composing transformations over character streams. Flag zlib Description: Enable ZLib Default$: !os_type(Win32) Library cryptokit Path: src Modules: Cryptokit CSources: arcfour.c, arcfour.h, stubs-arcfour.c, blowfish.c, blowfish.h, stubs-blowfish.c, d3des.c, d3des.h, stubs-des.c, rijndael-alg-fst.c, rijndael-alg-fst.h, ripemd160.c, ripemd160.h, stubs-ripemd160.c, sha1.c, sha1.h, stubs-sha1.c, sha256.c, sha256.h, stubs-sha256.c, stubs-aes.c, stubs-md5.c, stubs-misc.c, stubs-rng.c, stubs-zlib.c, keccak.h, keccak.c, stubs-sha3.c BuildDepends: unix, num if flag(zlib) CCOpt: -O -DHAVE_ZLIB if system(win32) || system(win64) CCLib: zlib.lib else CCLib: -lz if system(win32) || system(win64) CCLib+: advapi32.lib else if system(mingw) || system(mingw64) CCLib+: -ladvapi32 Executable test Path: test MainIs: test.ml Custom: true BuildDepends: cryptokit Build$: flag(tests) Install: false Test main Command: $test TestTools: test Flag bench Description: Build and run benchmark Default: false Executable speedtest Path: test MainIs: speedtest.ml CompiledObject: native BuildDepends: cryptokit Install: false Build$: flag(bench) Test bench Command: $speedtest Run$: flag(bench) TestTools: speedtest Document "api-cryptokit" Title: API reference for Cryptokit Type: ocamlbuild (0.3) InstallDir: $htmldir/cryptokit BuildTools+: ocamldoc XOCamlBuildPath: src/ XOCamlbuildLibraries: cryptokit SourceRepository head Type: svn Location: http://scm.ocamlcore.org/svnroot/cryptokit/trunk Browser: https://forge.ocamlcore.org/scm/browser.php?group_id=133 SourceRepository this Type: svn Location: http://scm.ocamlcore.org/svnroot/tags/release18 Browser: https://forge.ocamlcore.org/scm/browser.php?group_id=133 cryptokit-1.9/Makefile0000644000175000017500000000250412203237514014375 0ustar gildorgildorBUILDFLAGS=-classic-display # OASIS_START # DO NOT EDIT (digest: bc1e05bfc8b39b664f29dae8dbd3ebbb) SETUP = ocaml setup.ml build: setup.data $(SETUP) -build $(BUILDFLAGS) doc: setup.data build $(SETUP) -doc $(DOCFLAGS) test: setup.data build $(SETUP) -test $(TESTFLAGS) all: $(SETUP) -all $(ALLFLAGS) install: setup.data $(SETUP) -install $(INSTALLFLAGS) uninstall: setup.data $(SETUP) -uninstall $(UNINSTALLFLAGS) reinstall: setup.data $(SETUP) -reinstall $(REINSTALLFLAGS) clean: $(SETUP) -clean $(CLEANFLAGS) distclean: $(SETUP) -distclean $(DISTCLEANFLAGS) setup.data: $(SETUP) -configure $(CONFIGUREFLAGS) .PHONY: build doc test all install uninstall reinstall clean distclean configure # OASIS_STOP # Uncomment to test the deploy process. # DEPLOY_ARGS=--dry_run --verbose --ignore_changes # Use 'make deploy FORGE_USER=you' to change this value. FORGE_USER=gildor-admin # Contact sylvain@le-gall.net to install admin-gallu-deploy and # admin-gallu-oasis-increment or to do the release. deploy: OASIS_VERSION=$$(oasis query version | sed -e 's/\.//g'); \ ../admin-gallu/src/admin-gallu-deploy \ --vcs_tag release$$OASIS_VERSION \ --forge_upload --forge_group cryptokit --forge_user $(FORGE_USER) \ $(DEPLOY_ARGS) ../admin-gallu/src/admin-gallu-oasis-increment \ --setup_run --use_vcs \ $(DEPLOY_ARGS) cryptokit-1.9/_tags0000644000175000017500000000665212203240767013771 0ustar gildorgildor# OASIS_START # DO NOT EDIT (digest: 8a7166c77fa91d73228ad5c60f221d79) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process <**/.svn>: -traverse <**/.svn>: not_hygienic ".bzr": -traverse ".bzr": not_hygienic ".hg": -traverse ".hg": not_hygienic ".git": -traverse ".git": not_hygienic "_darcs": -traverse "_darcs": not_hygienic # Library cryptokit "src/cryptokit.cmxs": use_cryptokit : oasis_library_cryptokit_ccopt "src/arcfour.c": oasis_library_cryptokit_ccopt "src/stubs-arcfour.c": oasis_library_cryptokit_ccopt "src/blowfish.c": oasis_library_cryptokit_ccopt "src/stubs-blowfish.c": oasis_library_cryptokit_ccopt "src/d3des.c": oasis_library_cryptokit_ccopt "src/stubs-des.c": oasis_library_cryptokit_ccopt "src/rijndael-alg-fst.c": oasis_library_cryptokit_ccopt "src/ripemd160.c": oasis_library_cryptokit_ccopt "src/stubs-ripemd160.c": oasis_library_cryptokit_ccopt "src/sha1.c": oasis_library_cryptokit_ccopt "src/stubs-sha1.c": oasis_library_cryptokit_ccopt "src/sha256.c": oasis_library_cryptokit_ccopt "src/stubs-sha256.c": oasis_library_cryptokit_ccopt "src/stubs-aes.c": oasis_library_cryptokit_ccopt "src/stubs-md5.c": oasis_library_cryptokit_ccopt "src/stubs-misc.c": oasis_library_cryptokit_ccopt "src/stubs-rng.c": oasis_library_cryptokit_ccopt "src/stubs-zlib.c": oasis_library_cryptokit_ccopt "src/keccak.c": oasis_library_cryptokit_ccopt "src/stubs-sha3.c": oasis_library_cryptokit_ccopt : oasis_library_cryptokit_cclib "src/libcryptokit_stubs.lib": oasis_library_cryptokit_cclib "src/dllcryptokit_stubs.dll": oasis_library_cryptokit_cclib "src/libcryptokit_stubs.a": oasis_library_cryptokit_cclib "src/dllcryptokit_stubs.so": oasis_library_cryptokit_cclib : use_libcryptokit_stubs : pkg_unix : pkg_num "src/arcfour.c": pkg_unix "src/arcfour.c": pkg_num "src/stubs-arcfour.c": pkg_unix "src/stubs-arcfour.c": pkg_num "src/blowfish.c": pkg_unix "src/blowfish.c": pkg_num "src/stubs-blowfish.c": pkg_unix "src/stubs-blowfish.c": pkg_num "src/d3des.c": pkg_unix "src/d3des.c": pkg_num "src/stubs-des.c": pkg_unix "src/stubs-des.c": pkg_num "src/rijndael-alg-fst.c": pkg_unix "src/rijndael-alg-fst.c": pkg_num "src/ripemd160.c": pkg_unix "src/ripemd160.c": pkg_num "src/stubs-ripemd160.c": pkg_unix "src/stubs-ripemd160.c": pkg_num "src/sha1.c": pkg_unix "src/sha1.c": pkg_num "src/stubs-sha1.c": pkg_unix "src/stubs-sha1.c": pkg_num "src/sha256.c": pkg_unix "src/sha256.c": pkg_num "src/stubs-sha256.c": pkg_unix "src/stubs-sha256.c": pkg_num "src/stubs-aes.c": pkg_unix "src/stubs-aes.c": pkg_num "src/stubs-md5.c": pkg_unix "src/stubs-md5.c": pkg_num "src/stubs-misc.c": pkg_unix "src/stubs-misc.c": pkg_num "src/stubs-rng.c": pkg_unix "src/stubs-rng.c": pkg_num "src/stubs-zlib.c": pkg_unix "src/stubs-zlib.c": pkg_num "src/keccak.c": pkg_unix "src/keccak.c": pkg_num "src/stubs-sha3.c": pkg_unix "src/stubs-sha3.c": pkg_num # Executable test "test/test.byte": use_cryptokit "test/test.byte": pkg_unix "test/test.byte": pkg_num "test/test.byte": custom # Executable speedtest "test/speedtest.native": use_cryptokit "test/speedtest.native": pkg_unix "test/speedtest.native": pkg_num : use_cryptokit : pkg_unix : pkg_num # OASIS_STOP "build": not_hygienic "build": -traverse "src/cryptokit.cmxs": use_libcryptokit_stubs cryptokit-1.9/test/0000755000175000017500000000000012204467510013715 5ustar gildorgildorcryptokit-1.9/test/.depend0000644000175000017500000000000011436706614015152 0ustar gildorgildorcryptokit-1.9/test/test.ml0000644000175000017500000007376212135543724015252 0ustar gildorgildor(***********************************************************************) (* *) (* The Cryptokit library *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2002 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License, with *) (* the special exception on linking described in file LICENSE. *) (* *) (***********************************************************************) (* $Id: test.ml 71 2013-04-23 17:41:40Z xleroy $ *) (* Test vectors *) open Printf open Cryptokit (* Test harness *) let error_occurred = ref false let function_tested = ref "" let testing_function s = function_tested := s; print_newline(); print_string s; print_newline() let test test_number answer correct_answer = flush stdout; flush stderr; if answer <> correct_answer then begin eprintf "*** Bad result (%s, test %d)\n" !function_tested test_number; flush stderr; error_occurred := true end else begin printf " %d..." test_number end (* Useful auxiliaries *) let hex s = transform_string (Hexa.decode()) s let tohex s = transform_string (Hexa.encode()) s (* Test hex conversion first... *) let _ = testing_function "Hex conversion"; test 1 "6162636465666768696a6b6c6d6e6f70710a" (tohex "abcdefghijklmnopq\n"); test 2 "abcdefghijklmnopq\n" (hex "616263 64656667 \n 68696a6b 6c6d6e6f\t70710a") (* Basic ciphers and hashes *) (* AES *) let _ = testing_function "AES"; let res = String.create 16 in let do_test key plain cipher testno1 testno2 = let c = new Block.aes_encrypt (hex key) and d = new Block.aes_decrypt (hex key) in let plain = hex plain and cipher = hex cipher in c#transform plain 0 res 0; test testno1 res cipher; d#transform cipher 0 res 0; test testno2 res plain in do_test "000102030405060708090A0B0C0D0E0F" "00112233445566778899AABBCCDDEEFF" "69C4E0D86A7B0430D8CDB78070B4C55A" 1 2; do_test "000102030405060708090A0B0C0D0E0F1011121314151617" "00112233445566778899AABBCCDDEEFF" "DDA97CA4864CDFE06EAF70A0EC0D7191" 3 4; do_test "000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F" "00112233445566778899AABBCCDDEEFF" "8EA2B7CA516745BFEAFC49904B496089" 5 6 (* Blowfish *) let _ = testing_function "Blowfish"; let res = String.create 16 in let do_test key plain cipher testno = let c = new Block.blowfish_encrypt (hex key) and d = new Block.blowfish_decrypt (hex key) in let plain = hex plain and cipher = hex cipher in c#transform plain 0 res 0; d#transform cipher 0 res 8; test testno res (cipher ^ plain) in do_test "0000000000000000" "0000000000000000" "4EF997456198DD78" 1; do_test "FFFFFFFFFFFFFFFF" "FFFFFFFFFFFFFFFF" "51866FD5B85ECB8A" 2; do_test "3000000000000000" "1000000000000001" "7D856F9A613063F2" 3; do_test "1111111111111111" "1111111111111111" "2466DD878B963C9D" 4; do_test "0123456789ABCDEF" "1111111111111111" "61F9C3802281B096" 5; do_test "1111111111111111" "0123456789ABCDEF" "7D0CC630AFDA1EC7" 6; do_test "0000000000000000" "0000000000000000" "4EF997456198DD78" 7; do_test "FEDCBA9876543210" "0123456789ABCDEF" "0ACEAB0FC6A0A28D" 8; do_test "7CA110454A1A6E57" "01A1D6D039776742" "59C68245EB05282B" 9; do_test "0131D9619DC1376E" "5CD54CA83DEF57DA" "B1B8CC0B250F09A0" 10; do_test "07A1133E4A0B2686" "0248D43806F67172" "1730E5778BEA1DA4" 11; do_test "3849674C2602319E" "51454B582DDF440A" "A25E7856CF2651EB" 12; do_test "04B915BA43FEB5B6" "42FD443059577FA2" "353882B109CE8F1A" 13; do_test "0113B970FD34F2CE" "059B5E0851CF143A" "48F4D0884C379918" 14; do_test "0170F175468FB5E6" "0756D8E0774761D2" "432193B78951FC98" 15; do_test "43297FAD38E373FE" "762514B829BF486A" "13F04154D69D1AE5" 16; do_test "07A7137045DA2A16" "3BDD119049372802" "2EEDDA93FFD39C79" 17; do_test "04689104C2FD3B2F" "26955F6835AF609A" "D887E0393C2DA6E3" 18; do_test "37D06BB516CB7546" "164D5E404F275232" "5F99D04F5B163969" 19; do_test "1F08260D1AC2465E" "6B056E18759F5CCA" "4A057A3B24D3977B" 20; do_test "584023641ABA6176" "004BD6EF09176062" "452031C1E4FADA8E" 21; do_test "025816164629B007" "480D39006EE762F2" "7555AE39F59B87BD" 22; do_test "49793EBC79B3258F" "437540C8698F3CFA" "53C55F9CB49FC019" 23; do_test "4FB05E1515AB73A7" "072D43A077075292" "7A8E7BFA937E89A3" 24; do_test "49E95D6D4CA229BF" "02FE55778117F12A" "CF9C5D7A4986ADB5" 25; do_test "018310DC409B26D6" "1D9D5C5018F728C2" "D1ABB290658BC778" 26; do_test "1C587F1C13924FEF" "305532286D6F295A" "55CB3774D13EF201" 27; do_test "0101010101010101" "0123456789ABCDEF" "FA34EC4847B268B2" 28; do_test "1F1F1F1F0E0E0E0E" "0123456789ABCDEF" "A790795108EA3CAE" 29; do_test "E0FEE0FEF1FEF1FE" "0123456789ABCDEF" "C39E072D9FAC631D" 30; do_test "0000000000000000" "FFFFFFFFFFFFFFFF" "014933E0CDAFF6E4" 31; do_test "FFFFFFFFFFFFFFFF" "0000000000000000" "F21E9A77B71C49BC" 32; do_test "0123456789ABCDEF" "0000000000000000" "245946885754369A" 33; do_test "FEDCBA9876543210" "FFFFFFFFFFFFFFFF" "6B5C5A9C5D9E0A5A" 34 (* DES *) let _ = testing_function "DES"; let res = String.create 8 in let c = new Block.des_encrypt (hex "0123456789abcdef") and d = new Block.des_decrypt (hex "0123456789abcdef") in let plain = hex "0123456789abcde7" and cipher = hex "c95744256a5ed31d" in c#transform plain 0 res 0; test 1 res cipher; d#transform cipher 0 res 0; test 2 res plain; let rec iter n key input = if n <= 0 then key else begin let c = new Block.des_encrypt key in let t1 = String.create 8 in c#transform input 0 t1 0; let t2 = String.create 8 in c#transform t1 0 t2 0; let d = new Block.des_decrypt t2 in let t3 = String.create 8 in d#transform t1 0 t3 0; iter (n-1) t3 t1 end in test 3 (iter 64 (hex "5555555555555555") (hex "ffffffffffffffff")) (hex "246e9db9c550381a") (* Triple DES *) let _ = testing_function "Triple DES"; let res = String.create 8 in let do_test key plain cipher testno1 testno2 = let c = new Block.triple_des_encrypt (hex key) and d = new Block.triple_des_decrypt (hex key) in let plain = hex plain and cipher = hex cipher in c#transform plain 0 res 0; test testno1 res cipher; d#transform cipher 0 res 0; test testno2 res plain in do_test "0123456789abcdeffedcba9876543210" "0123456789abcde7" "7f1d0a77826b8aff" 1 2; do_test "0123456789abcdef0123456789abcdef" "0123456789abcde7" "c95744256a5ed31d" 3 4; do_test "0123456789abcdeffedcba987654321089abcdef01234567" "0123456789abcde7" "de0b7c06ae5e0ed5" 5 6 (* ARCfour *) let _ = testing_function "ARCfour"; let do_test n1 n2 key input output = let key = hex key and input = hex input and output = hex output in let c = new Stream.arcfour key in let d = new Stream.arcfour key in let res = String.create (String.length input) in c#transform input 0 res 0 (String.length input); test n1 res output; d#transform output 0 res 0 (String.length output); test n2 res input in do_test 1 2 "0123456789abcdef" "0123456789abcdef" "75b7878099e0c596"; do_test 3 4 "0123456789abcdef" "0000000000000000" "7494c2e7104b0879"; do_test 5 6 "0000000000000000" "0000000000000000" "de188941a3375d3a"; do_test 7 8 "ef012345" "00000000000000000000" "d6a141a7ec3c38dfbd61"; let c2 = Cipher.arcfour "key" Cipher.Encrypt in c2#put_string (String.create 1024); test 9 c2#available_output 1024 (* Blowfish *) let _ = testing_function "Blowfish"; let testcnt = ref 0 in let res = String.create 8 in let do_test (key, plain, cipher) = let key = hex key and plain = hex plain and cipher = hex cipher in let c = new Block.blowfish_encrypt key and d = new Block.blowfish_decrypt key in c#transform plain 0 res 0; incr testcnt; test !testcnt res cipher; d#transform cipher 0 res 0; incr testcnt; test !testcnt res plain in List.iter do_test [ ("0000000000000000", "0000000000000000", "4EF997456198DD78"); ("FFFFFFFFFFFFFFFF", "FFFFFFFFFFFFFFFF", "51866FD5B85ECB8A"); ("3000000000000000", "1000000000000001", "7D856F9A613063F2"); ("1111111111111111", "1111111111111111", "2466DD878B963C9D"); ("0123456789ABCDEF", "1111111111111111", "61F9C3802281B096"); ("1111111111111111", "0123456789ABCDEF", "7D0CC630AFDA1EC7"); ("0000000000000000", "0000000000000000", "4EF997456198DD78"); ("FEDCBA9876543210", "0123456789ABCDEF", "0ACEAB0FC6A0A28D"); ("7CA110454A1A6E57", "01A1D6D039776742", "59C68245EB05282B"); ("0131D9619DC1376E", "5CD54CA83DEF57DA", "B1B8CC0B250F09A0"); ("07A1133E4A0B2686", "0248D43806F67172", "1730E5778BEA1DA4"); ("3849674C2602319E", "51454B582DDF440A", "A25E7856CF2651EB"); ("04B915BA43FEB5B6", "42FD443059577FA2", "353882B109CE8F1A"); ("0113B970FD34F2CE", "059B5E0851CF143A", "48F4D0884C379918"); ("0170F175468FB5E6", "0756D8E0774761D2", "432193B78951FC98"); ("43297FAD38E373FE", "762514B829BF486A", "13F04154D69D1AE5"); ("07A7137045DA2A16", "3BDD119049372802", "2EEDDA93FFD39C79"); ("04689104C2FD3B2F", "26955F6835AF609A", "D887E0393C2DA6E3"); ("37D06BB516CB7546", "164D5E404F275232", "5F99D04F5B163969"); ("1F08260D1AC2465E", "6B056E18759F5CCA", "4A057A3B24D3977B"); ("584023641ABA6176", "004BD6EF09176062", "452031C1E4FADA8E"); ("025816164629B007", "480D39006EE762F2", "7555AE39F59B87BD"); ("49793EBC79B3258F", "437540C8698F3CFA", "53C55F9CB49FC019"); ("4FB05E1515AB73A7", "072D43A077075292", "7A8E7BFA937E89A3"); ("49E95D6D4CA229BF", "02FE55778117F12A", "CF9C5D7A4986ADB5"); ("018310DC409B26D6", "1D9D5C5018F728C2", "D1ABB290658BC778"); ("1C587F1C13924FEF", "305532286D6F295A", "55CB3774D13EF201"); ("0101010101010101", "0123456789ABCDEF", "FA34EC4847B268B2"); ("1F1F1F1F0E0E0E0E", "0123456789ABCDEF", "A790795108EA3CAE"); ("E0FEE0FEF1FEF1FE", "0123456789ABCDEF", "C39E072D9FAC631D"); ("0000000000000000", "FFFFFFFFFFFFFFFF", "014933E0CDAFF6E4"); ("FFFFFFFFFFFFFFFF", "0000000000000000", "F21E9A77B71C49BC"); ("0123456789ABCDEF", "0000000000000000", "245946885754369A"); ("FEDCBA9876543210", "FFFFFFFFFFFFFFFF", "6B5C5A9C5D9E0A5A") ] (* SHA-1 *) let _ = testing_function "SHA-1"; let hash s = hash_string (Hash.sha1()) s in test 1 (hash "") (hex "da39a3ee5e6b4b0d3255bfef95601890afd80709"); test 2 (hash "a") (hex "86f7e437faa5a7fce15d1ddcb9eaeaea377667b8"); test 3 (hash "abc") (hex "a9993e364706816aba3e25717850c26c9cd0d89d"); test 4 (hash "abcdefghijklmnopqrstuvwxyz") (hex "32d10c7b8cf96570ca04ce37f2a19d84240d3a89"); test 5 (hash "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") (hex "84983E441C3BD26EBAAE4AA1F95129E5E54670F1"); test 6 (hash (String.make 1000000 'a')) (hex "34AA973CD4C4DAA4F61EEB2BDBAD27316534016F") (* SHA-256 *) let _ = testing_function "SHA-256"; let hash s = hash_string (Hash.sha256()) s in test 1 (hash "abc") (hex "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad"); test 2 (hash "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") (hex "248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1"); test 3 (hash (String.make 1000000 'a')) (hex "cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0") (* SHA-3 *) let _ = testing_function "SHA-3"; let hash n s = hash_string (Hash.sha3 n) s in let s = "abc" in test 1 (hash 224 s) (hex "c30411768506ebe1 c2871b1ee2e87d38 df342317300a9b97 a95ec6a8"); test 2 (hash 256 s) (hex "4e03657aea45a94f c7d47ba826c8d667 c0d1e6e33a64a036 ec44f58fa12d6c45"); test 3 (hash 384 s) (hex "f7df1165f033337b e098e7d288ad6a2f 74409d7a60b49c36 642218de161b1f99 f8c681e4afaf31a3 4db29fb763e3c28e"); test 4 (hash 512 s) (hex "18587dc2ea106b9a 1563e32b3312421c a164c7f1f07bc922 a9c83d77cea3a1e5 d0c6991073902537 2dc14ac964262937 9540c17e2a65b19d 77aa511a9d00bb96"); let s = "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" in test 5 (hash 224 s) (hex "e51faa2b4655150b 931ee8d700dc202f 763ca5f962c529ea e55012b6"); test 6 (hash 256 s) (hex "45d3b367a6904e6e 8d502ee04999a7c2 7647f91fa845d456 525fd352ae3d7371"); test 7 (hash 384 s) (hex "b41e8896428f1bcb b51e17abd6acc980 52a3502e0d5bf7fa 1af949b4d3c855e7 c4dc2c390326b3f3 e74c7b1e2b9a3657"); test 8 (hash 512 s) (hex "6aa6d3669597df6d 5a007b00d09c2079 5b5c4218234e1698 a944757a488ecdc0 9965435d97ca32c3 cfed7201ff30e070 cd947f1fc12b9d92 14c467d342bcba5d"); let s = "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" in test 9 (hash 224 s) (hex "344298994b1b0687 3eae2ce739c425c4 7291a2e24189e01b 524f88dc"); test 10 (hash 256 s) (hex "f519747ed599024f 3882238e5ab43960 132572b7345fbeb9 a90769dafd21ad67"); test 11 (hash 384 s) (hex "cc063f3468513536 8b34f7449108f6d1 0fa727b09d696ec5 331771da46a923b6 c34dbd1d4f77e595 689c1f3800681c28"); test 12 (hash 512 s) (hex "ac2fb35251825d3a a48468a9948c0a91 b8256f6d97d8fa41 60faff2dd9dfcc24 f3f1db7a983dad13 d53439ccac0b37e2 4037e7b95f80f59f 37a2f683c4ba4682"); let s = String.make 1000000 'a' in test 13 (hash 224 s) (hex "19f9167be2a04c43 abd0ed554788101b 9c339031acc8e146 8531303f"); test 14 (hash 256 s) (hex "fadae6b49f129bbb 812be8407b7b2894 f34aecf6dbd1f9b0 f0c7e9853098fc96"); test 15 (hash 384 s) (hex "0c8324e1ebc18282 2c5e2a086cac07c2 fe00e3bce61d01ba 8ad6b71780e2dec5 fb89e5ae90cb593e 57bc6258fdd94e17"); test 16 (hash 512 s) (hex "5cf53f2e556be5a6 24425ede23d0e8b2 c7814b4ba0e4e09c bbf3c2fac7056f61 e048fc341262875e bc58a5183fea6514 47124370c1ebf4d6 c89bc9a7731063bb"); let s = "" in test 17 (hash 224 s) (hex "f71837502ba8e108 37bdd8d365adb855 91895602fc552b48 b7390abd"); test 18 (hash 256 s) (hex "c5d2460186f7233c 927e7db2dcc703c0 e500b653ca82273b 7bfad8045d85a470"); test 19 (hash 384 s) (hex "2c23146a63a29acf 99e73b88f8c24eaa 7dc60aa771780ccc 006afbfa8fe2479b 2dd2b21362337441 ac12b515911957ff"); test 20 (hash 512 s) (hex "0eab42de4c3ceb92 35fc91acffe746b2 9c29a8c366b7c60e 4e67c466f36a4304 c00fa9caf9d87976 ba469bcbe06713b4 35f091ef2769fb16 0cdab33d3670680e") (* Input message: the extremely-long message "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno" repeated 16,777,216 times: a bit string of length 233 bits. This test is from the SHA-3 Candidate Algorithm Submissions document [5]. The results for SHA-3 are from the Keccak Known Answer Tests [4]. The other results are by our own computation. Algorithm Output SHA-1 7789f0c9 ef7bfc40 d9331114 3dfbe69e 2017f592 SHA-224 b5989713 ca4fe47a 009f8621 980b34e6 d63ed306 3b2a0a2c 867d8a85 SHA-256 50e72a0e 26442fe2 552dc393 8ac58658 228c0cbf b1d2ca87 2ae43526 6fcd055e SHA-384 5441235cc0235341 ed806a64fb354742 b5e5c02a3c5cb71b 5f63fb793458d8fd ae599c8cd8884943 c04f11b31b89f023 SHA-512 b47c933421ea2db1 49ad6e10fce6c7f9 3d0752380180ffd7 f4629a712134831d 77be6091b819ed35 2c2967a2e2d4fa50 50723c9630691f1a 05a7281dbe6c1086 SHA-3-224 c42e4aee858e1a8a d2976896b9d23dd1 87f64436ee15969a fdbc68c5 SHA-3-256 5f313c39963dcf79 2b5470d4ade9f3a3 56a3e4021748690a 958372e2b06f82a4 SHA-3-384 9b7168b4494a80a8 6408e6b9dc4e5a18 37c85dd8ff452ed4 10f2832959c08c8c 0d040a892eb9a755 776372d4a8732315 SHA-3-512 3e122edaf3739823 1cfaca4c7c216c9d 66d5b899ec1d7ac6 17c40c7261906a45 fc01617a021e5da3 bd8d4182695b5cb7 85a28237cbb16759 0e34718e56d8aab8 *) (* RIPEMD-160 *) let _ = testing_function "RIPEMD-160"; let hash s = hash_string (Hash.ripemd160()) s in test 1 (hash "") (hex "9c1185a5c5e9fc54612808977ee8f548b2258d31"); test 2 (hash "a") (hex "0bdc9d2d256b3ee9daae347be6f4dc835a467ffe"); test 3 (hash "abc") (hex "8eb208f7e05d987a9b044a8e98c6b087f15a0bfc"); test 4 (hash "message digest") (hex "5d0689ef49d2fae572b881b123a85ffa21595f36"); test 5 (hash "abcdefghijklmnopqrstuvwxyz") (hex "f71c27109c692c1b56bbdceb5b9d2865b3708dbc"); test 6 (hash "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") (hex "12a053384a9c0c88e405a06c27dcf49ada62eb2b"); test 7 (hash "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") (hex "b0e20b6e3116640286ed3a87a5713079b21f5189"); test 8 (hash "12345678901234567890123456789012345678901234567890123456789012345678901234567890") (hex "9b752e45573d4b39f4dbd3323cab82bf63326bfb"); test 9 (hash (String.make 1000000 'a')) (hex "52783243c1697bdbe16d37f97f68f08325dc1528") (* MD5 *) let _ = testing_function "MD5"; let hash s = hash_string (Hash.md5()) s in test 1 (hash "") (hex "D41D8CD98F00B204E9800998ECF8427E"); test 2 (hash "a") (hex "0CC175B9C0F1B6A831C399E269772661"); test 3 (hash "abc") (hex "900150983CD24FB0D6963F7D28E17F72"); test 4 (hash "message digest") (hex "F96B697D7CB7938D525A2F31AAF161D0") (* Chaining modes *) open Cipher let some_key = hex "0123456789abcdef" let test_enc_dec testno cipher cleartext = let enc = cipher some_key Encrypt and dec = cipher some_key Decrypt in test testno (transform_string dec (transform_string enc cleartext)) cleartext let _ = testing_function "ECB"; test_enc_dec 1 (des ~mode:ECB) "abcdefgh"; test_enc_dec 2 (des ~mode:ECB) "abcdefgh01234567"; test_enc_dec 3 (des ~mode:ECB ~pad:Padding.length) "0123456789"; test_enc_dec 4 (des ~mode:ECB ~pad:Padding.length) "abcdefghijklmnopqrstuvwxyz"; test_enc_dec 5 (des ~mode:ECB ~pad:Padding._8000) "0123456789"; test_enc_dec 6 (des ~mode:ECB ~pad:Padding._8000) "abcdefghijklmnopqrstuvwxyz" let _ = testing_function "CBC"; test_enc_dec 1 (des ~mode:CBC) "abcdefgh"; test_enc_dec 2 (des ~mode:CBC) "abcdefgh01234567"; test_enc_dec 3 (des ~mode:CBC ~pad:Padding.length) "0123456789"; test_enc_dec 4 (des ~mode:CBC ~pad:Padding.length) "abcdefghijklmnopqrstuvwxyz"; test_enc_dec 5 (des ~mode:CBC ~pad:Padding.length ~iv:"#@#@#@#@") "0123456789"; test_enc_dec 6 (des ~mode:CBC ~pad:Padding.length ~iv:"ABCDEFGH") "abcdefghijklmnopqrstuvwxyz" let _ = testing_function "CFB 1"; test_enc_dec 1 (des ~mode:(CFB 1)) "ab"; test_enc_dec 2 (des ~mode:(CFB 1)) "abcd"; test_enc_dec 3 (des ~mode:(CFB 1)) "abcdefgh01234567"; test_enc_dec 4 (des ~mode:(CFB 1)) "abcdefghijklmnopqrstuvwxyz"; test_enc_dec 5 (des ~mode:(CFB 1) ~iv:"#@#@#@#@") "abcdefghijklmnopqrstuvwxyz" let _ = testing_function "CFB 4"; test_enc_dec 1 (des ~mode:(CFB 4)) "abcd"; test_enc_dec 2 (des ~mode:(CFB 4)) "abcdefgh01234567"; test_enc_dec 3 (des ~mode:(CFB 4) ~pad:Padding._8000) "abcdefghijklmnopqrstuvwxyz" let _ = testing_function "OFB 1"; test_enc_dec 1 (des ~mode:(OFB 1)) "ab"; test_enc_dec 2 (des ~mode:(OFB 1)) "abcd"; test_enc_dec 3 (des ~mode:(OFB 1)) "abcdefgh01234567"; test_enc_dec 4 (des ~mode:(OFB 1)) "abcdefghijklmnopqrstuvwxyz"; test_enc_dec 5 (des ~mode:(OFB 1) ~iv:"#@#@#@#@") "abcdefghijklmnopqrstuvwxyz" let _ = testing_function "OFB 8"; test_enc_dec 1 (des ~mode:(OFB 8)) "abcdefgh"; test_enc_dec 2 (des ~mode:(OFB 8)) "abcdefgh01234567"; test_enc_dec 3 (des ~mode:(OFB 8) ~pad:Padding._8000) "abcdefghijklmnopqrstuvwxyz" (* HMAC-SHA256 *) let _ = testing_function "HMAC-SHA256"; List.iter (fun (testno, hexkey, msg, hexhash) -> test testno (hash_string (MAC.hmac_sha256 (hex hexkey)) msg) (hex hexhash)) [ (1, "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20", "abc", "a21b1f5d4cf4f73a4dd939750f7a066a7f98cc131cb16a6692759021cfab8181"); (2, "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20", "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq", "104fdc1257328f08184ba73131c53caee698e36119421149ea8c712456697d30"); (3, "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f20", "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopqabcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq", "470305fc7e40fe34d3eeb3e773d95aab73acf0fd060447a5eb4595bf33a9d1a3"); (4, "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b", "Hi There", "198a607eb44bfbc69903a0f1cf2bbdc5ba0aa3f3d9ae3c1c7a3b1696a0b68cf7"); (5, "4a656665", (* "Jefe" *) "what do ya want for nothing?", "5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843"); (6, "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", "\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd", "cdcb1220d1ecccea91e53aba3092f962e549fe6ce9ed7fdc43191fbde45c30b0"); (7, "0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425", "\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd\xcd", "d4633c17f6fb8d744c66dee0f8f074556ec4af55ef07998541468eb49bd2e917"); (8, "0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c", "Test With Truncation", "7546af01841fc09b1ab9c3749a5f1c17d4f589668a587b2700a9c97c1193cf42"); (9, "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", "Test Using Larger Than Block-Size Key - Hash Key First", "6953025ed96f0c09f80a96f78e6538dbe2e7b820e3dd970e7ddd39091b32352f"); (10, "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data", "6355ac22e890d0a3c8481a5ca4825bc884d3e7a1ff98a2fc2ac7d8e064c3b2e6") ] (* HMAC-MD5 *) let _ = testing_function "HMAC-MD5"; test 1 (hash_string (MAC.hmac_md5 (hex "0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b")) "Hi There") (hex "9294727a3638bb1c13f48ef8158bfc9d"); test 2 (hash_string (MAC.hmac_md5 "Jefe") "what do ya want for nothing?") (hex "750c783e6ab0b503eaa86e310a5db738"); test 3 (hash_string (MAC.hmac_md5 (hex "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA")) (String.make 50 '\221')) (hex "56be34521d144c88dbb8c733f0e8b3f6") (* RSA *) let some_rsa_key = { RSA.size = 512; RSA.n = hex "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000c0764797b8bec8972a0ed8c90a8c334dd049add0222c09d20be0a79e338910bcae422060906ae0221de3f3fc747ccf98aecc85d6edc52d93d5b7396776160525"; RSA.e = hex "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010001"; RSA.d = hex "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001ae36b7522f66487d9f4610d1550290ac202c929bedc7032cc3e02acf37e3ebc1f866ee7ef7a0868d23ae2b184c1abd6d4db8ea9bec046bd82803727f2888701"; RSA.p = hex "0000000000000000000000000000000000000000000000000000000000000000df02b615fe15928f41b02b586b51c2c02260ca396818ca4cba60bb892465be35"; RSA.q = hex "0000000000000000000000000000000000000000000000000000000000000000dceeb60d543518b4ac74834a0546c507f2e91e389a87e2f2becc6f8c67d1c931"; RSA.dp = hex "000000000000000000000000000000000000000000000000000000000000000059487e99e375c38d732112d97d6de8687fdafc5b6b5fb16e7297d3bd1e435599"; RSA.dq = hex "000000000000000000000000000000000000000000000000000000000000000061b550de6437774db0577718ed6c770724eee466b43114b5b69c43591d313281"; RSA.qinv = hex "0000000000000000000000000000000000000000000000000000000000000000744c79c4b9bea97c25e563c9407a2d09b57358afe09af67d71f8198cb7c956b8" } let some_msg = "Supercalifragilistusexpialidolcius" let test_same_message testno msg1 msg2 = test testno msg1 (String.sub msg2 (String.length msg2 - String.length msg1) (String.length msg1)) let _ = testing_function "RSA"; (* Signature, no CRT *) test_same_message 1 some_msg (RSA.unwrap_signature some_rsa_key (RSA.sign some_rsa_key some_msg)); (* Signature, CRT *) test_same_message 2 some_msg (RSA.unwrap_signature some_rsa_key (RSA.sign_CRT some_rsa_key some_msg)); (* Encryption, no CRT *) test_same_message 3 some_msg (RSA.decrypt some_rsa_key (RSA.encrypt some_rsa_key some_msg)); (* Encryption, CRT *) test_same_message 4 some_msg (RSA.decrypt_CRT some_rsa_key (RSA.encrypt some_rsa_key some_msg)); (* Same, with a home-made key *) let prng = Random.pseudo_rng (hex "5b5e50dc5b6eaf5346eba8244e5666ac4dcd5409") in let key = RSA.new_key ~rng:prng 1024 in test_same_message 5 some_msg (RSA.unwrap_signature key (RSA.sign key some_msg)); test_same_message 6 some_msg (RSA.unwrap_signature key (RSA.sign_CRT key some_msg)); test_same_message 7 some_msg (RSA.decrypt key (RSA.encrypt key some_msg)); test_same_message 8 some_msg (RSA.decrypt_CRT key (RSA.encrypt key some_msg)); (* Same, with a home-made key of fixed public exponent *) let key = RSA.new_key ~rng:prng ~e:65537 1024 in test_same_message 9 some_msg (RSA.unwrap_signature key (RSA.sign key some_msg)); test_same_message 10 some_msg (RSA.unwrap_signature key (RSA.sign_CRT key some_msg)); test_same_message 11 some_msg (RSA.decrypt key (RSA.encrypt key some_msg)); test_same_message 12 some_msg (RSA.decrypt_CRT key (RSA.encrypt key some_msg)) (* Diffie-Hellman *) let _ = testing_function "Diffie-Hellman"; let prng = Random.pseudo_rng (hex "5b5e50dc5b6eaf5346eba8244e5666ac4dcd5409") in let param = DH.new_parameters ~rng:prng 1024 in let ps1 = DH.private_secret ~rng:prng param and ps2 = DH.private_secret ~rng:prng param in let msg1 = DH.message param ps1 and msg2 = DH.message param ps2 in let ss1 = DH.shared_secret param ps1 msg2 and ss2 = DH.shared_secret param ps2 msg1 in test 1 ss1 ss2 (* Base64 encoding *) let _ = testing_function "Base64"; test 1 "VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv dmVyIHRoZSBsYXp5IGRvZy4K " (transform_string (Base64.encode_multiline()) "The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. "); test 2 "VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv dmVyIHRoZSBsYXp5IGRvZy4uCg== " (transform_string (Base64.encode_multiline()) "The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog.. "); test 3 "VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv dmVyIHRoZSBsYXp5IGRvZy4uLgo= " (transform_string (Base64.encode_multiline()) "The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog... "); test 4 "The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. " (transform_string (Base64.decode()) "VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv dmVyIHRoZSBsYXp5IGRvZy4K "); test 5 "The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog.. " (transform_string (Base64.decode()) "VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv dmVyIHRoZSBsYXp5IGRvZy4uCg== "); test 6 "The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog... " (transform_string (Base64.decode()) "VGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNr IGJyb3duIGZveCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZv eCBqdW1wcyBvdmVyIHRoZSBsYXp5IGRvZy4KVGhlIHF1aWNrIGJyb3duIGZveCBqdW1wcyBv dmVyIHRoZSBsYXp5IGRvZy4uLgo= "); let binarytext = String.create 256 in for i = 0 to 255 do binarytext.[i] <- Char.chr i done; test 7 binarytext (transform_string (Base64.decode()) (transform_string (Base64.encode_compact()) binarytext)) (* Compression *) let _ = testing_function "Zlib compression"; let text = "The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy dog. " in try test 1 text (transform_string (Zlib.uncompress()) (transform_string (Zlib.compress()) text)); let c = Zlib.compress() and u = Zlib.uncompress() in c#put_string text; c#flush; u#put_string c#get_string; u#flush; test 2 text u#get_string; c#put_string text; c#finish; u#put_string c#get_string; u#finish; test 3 text u#get_string with Error Compression_not_supported -> printf " (not supported)" (* End of tests *) let _ = print_newline(); if !error_occurred then begin printf "********* TEST FAILED ***********\n"; exit 2 end else begin printf "All tests successful.\n"; exit 0 end cryptokit-1.9/test/speedtest.ml0000644000175000017500000001241012135543724016252 0ustar gildorgildor(***********************************************************************) (* *) (* The Cryptokit library *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2002 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the GNU Library General Public License, with *) (* the special exception on linking described in file LICENSE. *) (* *) (***********************************************************************) (* $Id: speedtest.ml 71 2013-04-23 17:41:40Z xleroy $ *) (* Performance measurement *) open Cryptokit let time_fn msg fn = let start = Sys.time() in let res = fn() in let stop = Sys.time() in Printf.printf "%6.2f %s\n" (stop -. start) msg; flush stdout; res let rec repeat n fn () = if n <= 1 then fn() else (ignore(fn()); repeat (n-1) fn ()) let raw_block_cipher cipher niter () = let msg = String.create cipher#blocksize in for i = 1 to niter do cipher#transform msg 0 msg 0 done let raw_stream_cipher cipher niter blocksize () = let msg = String.create blocksize in for i = 1 to niter do cipher#transform msg 0 msg 0 blocksize done let transform tr niter blocksize () = let msg = String.create blocksize in for i = 1 to niter do tr#put_substring msg 0 blocksize; ignore(tr#get_substring) done let hash h niter blocksize () = let msg = String.create blocksize in for i = 1 to niter do h#add_substring msg 0 blocksize done; ignore(h#result) let _ = time_fn "Raw AES 128, 16_000_000 bytes" (raw_block_cipher (new Block.aes_encrypt "0123456789ABCDEF") 1000000); time_fn "Raw AES 192, 16_000_000 bytes" (raw_block_cipher (new Block.aes_encrypt "0123456789ABCDEF01234567") 1000000); time_fn "Raw AES 256, 16_000_000 bytes" (raw_block_cipher (new Block.aes_encrypt "0123456789ABCDEF0123456789ABCDEF") 1000000); time_fn "Raw DES, 16_000_000 bytes" (raw_block_cipher (new Block.des_encrypt "01234567") 2000000); time_fn "Raw 3DES, 16_000_000 bytes" (raw_block_cipher (new Block.triple_des_encrypt "0123456789ABCDEF") 2000000); time_fn "Raw ARCfour, 16_000_000 bytes, 16-byte chunks" (raw_stream_cipher (new Stream.arcfour "0123456789ABCDEF") 1000000 16); time_fn "Raw ARCfour, 16_000_000 bytes, 64-byte chunks" (raw_stream_cipher (new Stream.arcfour "0123456789ABCDEF") 250000 64); time_fn "Raw Blowfish 128, 16_000_000 bytes" (raw_block_cipher (new Block.blowfish_encrypt "0123456789ABCDEF") 2000000); time_fn "Wrapped AES 128 CBC, 16_000_000 bytes" (transform (Cipher.aes "0123456789ABCDEF" Cipher.Encrypt) 1000000 16); time_fn "Wrapped AES 192 CBC, 16_000_000 bytes" (transform (Cipher.aes "0123456789ABCDEF01234567" Cipher.Encrypt) 1000000 16); time_fn "Wrapped AES 256 CBC, 16_000_000 bytes" (transform (Cipher.aes "0123456789ABCDEF0123456789ABCDEF" Cipher.Encrypt) 1000000 16); time_fn "Wrapped DES CBC, 16_000_000 bytes" (transform (Cipher.des "01234567" Cipher.Encrypt) 1000000 16); time_fn "Wrapped 3DES CBC, 16_000_000 bytes" (transform (Cipher.triple_des "0123456789ABCDEF" Cipher.Encrypt) 1000000 16); time_fn "Wrapped ARCfour, 16_000_000 bytes" (transform (Cipher.arcfour "0123456789ABCDEF" Cipher.Encrypt) 1000000 16); time_fn "Wrapped Blowfish 128 CBC, 16_000_000 bytes" (transform (Cipher.blowfish "0123456789ABCDEF" Cipher.Encrypt) 1000000 16); time_fn "SHA-1, 16_000_000 bytes, 16-byte chunks" (hash (Hash.sha1()) 1000000 16); time_fn "SHA-256, 16_000_000 bytes, 16-byte chunks" (hash (Hash.sha256()) 1000000 16); time_fn "SHA-3 224, 16_000_000 bytes, 16-byte chunks" (hash (Hash.sha3 224) 1000000 16); time_fn "SHA-3 256, 16_000_000 bytes, 16-byte chunks" (hash (Hash.sha3 256) 1000000 16); time_fn "SHA-3 384, 16_000_000 bytes, 16-byte chunks" (hash (Hash.sha3 384) 1000000 16); time_fn "SHA-3 512, 16_000_000 bytes, 16-byte chunks" (hash (Hash.sha3 512) 1000000 16); time_fn "RIPEMD-160, 16_000_000 bytes, 16-byte chunks" (hash (Hash.sha256()) 1000000 16); time_fn "MD5, 16_000_000 bytes, 16-byte chunks" (hash (Hash.md5()) 1000000 16); time_fn "AES MAC, 16_000_000 bytes, 16-byte chunks" (hash (MAC.aes "0123456789ABCDEF") 1000000 16); let prng = Random.pseudo_rng (Random.string Random.secure_rng 160) in let key = time_fn "RSA key generation (1024 bits) x 10" (repeat 10 (fun () -> RSA.new_key ~rng:prng ~e:65537 1024)) in let ciphertext = time_fn "RSA public-key operation (1024 bits, exponent 65537) x 1000" (repeat 1000 (fun () -> RSA.encrypt key "ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ")) in time_fn "RSA private-key operation (1024 bits) x 100" (repeat 100 (fun () -> ignore(RSA.decrypt key ciphertext))); time_fn "RSA private-key operation with CRT (1024 bits) x 100" (repeat 100 (fun () -> ignore(RSA.decrypt_CRT key ciphertext))); () cryptokit-1.9/LICENSE.txt0000644000175000017500000006343211436706614014600 0ustar gildorgildorThis Library is distributed under the terms of the GNU Library General Public License version 2 (included below). As a special exception to the GNU Library General Public License, you may link, statically or dynamically, a "work that uses the Library" with a publicly distributed version of the Library to produce an executable file containing portions of the Library, and distribute that executable file under terms of your choice, without any of the additional requirements listed in clause 6 of the GNU Library General Public License. By "a publicly distributed version of the Library", we mean either the unmodified Library as distributed by INRIA, or a modified version of the Library that is distributed under the conditions defined in clause 3 of the GNU Library General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Library General Public License. ---------------------------------------------------------------------- GNU LIBRARY GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1991 Free Software Foundation, Inc. 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the library GPL. It is numbered 2 because it goes with version 2 of the ordinary GPL.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Library General Public License, applies to some specially designated Free Software Foundation software, and to any other libraries whose authors decide to use it. You can use it for your libraries, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library, or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link a program with the library, you must provide complete object files to the recipients so that they can relink them with the library, after making changes to the library and recompiling it. And you must show them these terms so they know their rights. Our method of protecting your rights has two steps: (1) copyright the library, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the library. Also, for each distributor's protection, we want to make certain that everyone understands that there is no warranty for this free library. If the library is modified by someone else and passed on, we want its recipients to know that what they have is not the original version, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that companies distributing free software will individually obtain patent licenses, thus in effect transforming the program into proprietary software. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License, which was designed for utility programs. This license, the GNU Library General Public License, applies to certain designated libraries. This license is quite different from the ordinary one; be sure to read it in full, and don't assume that anything in it is the same as in the ordinary license. The reason we have a separate public license for some libraries is that they blur the distinction we usually make between modifying or adding to a program and simply using it. Linking a program with a library, without changing the library, is in some sense simply using the library, and is analogous to running a utility program or application program. However, in a textual and legal sense, the linked executable is a combined work, a derivative of the original library, and the ordinary General Public License treats it as such. Because of this blurred distinction, using the ordinary General Public License for libraries did not effectively promote software sharing, because most developers did not use the libraries. We concluded that weaker conditions might promote sharing better. However, unrestricted linking of non-free programs would deprive the users of those programs of all benefit from the free status of the libraries themselves. This Library General Public License is intended to permit developers of non-free programs to use free libraries, while preserving your freedom as a user of such programs to change the free libraries that are incorporated in them. (We have not seen how to achieve this as regards changes in header files, but we have achieved it as regards changes in the actual functions of the Library.) The hope is that this will lead to faster development of free libraries. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, while the latter only works together with the library. Note that it is possible for a library to be covered by the ordinary General Public License rather than by this special one. GNU LIBRARY GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Library General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also compile or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. c) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. d) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Library General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This 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. This 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! cryptokit-1.9/configure0000755000175000017500000000055411600677160014654 0ustar gildorgildor#!/bin/sh # OASIS_START # DO NOT EDIT (digest: 425187ed8bfdbdd207fd76392dd243a7) set -e FST=true for i in "$@"; do if $FST; then set -- FST=false fi case $i in --*=*) ARG=${i%%=*} VAL=${i##*=} set -- "$@" "$ARG" "$VAL" ;; *) set -- "$@" "$i" ;; esac done ocaml setup.ml -configure "$@" # OASIS_STOP cryptokit-1.9/AUTHORS.txt0000644000175000017500000000020211437417344014625 0ustar gildorgildor(* OASIS_START *) (* DO NOT EDIT (digest: 5b4688f86f9f3738147f4b2993e8495a) *) Authors of cryptokit Xavier Leroy (* OASIS_STOP *)