+30

src/c/dune

reviewed

··· 1 1 + (library 2 2 + (name crypto_c) 3 3 + (public_name crypto.c) 4 4 + (implements crypto) 5 5 + (foreign_stubs 6 6 + (language c) 7 7 + (names 8 8 + detect_cpu_features 9 9 + misc 10 10 + misc_sse 11 11 + aes_generic 12 12 + aes_aesni 13 13 + ghash_generic 14 14 + ghash_pclmul 15 15 + ghash_ctmul 16 16 + des_generic 17 17 + chacha 18 18 + poly1305-donna 19 19 + entropy_cpu_stubs) 20 20 + (flags 21 21 + (:standard) 22 22 + (:include ../cflags_optimized.sexp))) 23 23 + (foreign_stubs 24 24 + (language c) 25 25 + (names chacha_generic) 26 26 + (flags 27 27 + (:standard) 28 28 + (:include ../cflags.sexp)))) 29 29 + 30 30 + (include_subdirs unqualified)

-334

src/crypto_stubs.js

reviewed

··· 1 1 - // js_of_ocaml stubs for mirage-crypto / ocaml-crypto 2 2 - // 3 3 - // Pure JavaScript implementations of the C primitives. AES uses 4 4 - // lookup tables (same algorithm as the C generic path). Performance 5 5 - // is adequate for small payloads (demo/testing, not production). 6 6 - 7 7 - // ---- Helpers ---- 8 8 - 9 9 - //Provides: mc_detect_cpu_features 10 10 - function mc_detect_cpu_features(unit) { return 0; } 11 11 - 12 12 - //Provides: mc_entropy_detect 13 13 - function mc_entropy_detect(unit) { return 0; } 14 14 - 15 15 - //Provides: mc_misc_mode 16 16 - function mc_misc_mode(unit) { return 0; /* generic */ } 17 17 - 18 18 - //Provides: mc_aes_mode 19 19 - function mc_aes_mode(unit) { return 0; /* generic */ } 20 20 - 21 21 - //Provides: mc_ghash_mode 22 22 - function mc_ghash_mode(unit) { return 0; /* generic */ } 23 23 - 24 24 - // ---- XOR ---- 25 25 - 26 26 - //Provides: mc_xor_into_bytes 27 27 - function mc_xor_into_bytes(src, soff, dst, doff, len) { 28 28 - for (var i = 0; i < len; i++) { 29 29 - dst[doff + i] ^= src.charCodeAt(soff + i) & 0xff; 30 30 - } 31 31 - } 32 32 - 33 33 - // ---- Counter increment ---- 34 34 - 35 35 - //Provides: mc_count_8_be 36 36 - function mc_count_8_be(ctr, dst, off, blocks) { 37 37 - for (var b = 0; b < blocks; b++) { 38 38 - for (var i = 0; i < 8; i++) dst[off + b * 8 + i] = ctr[i]; 39 39 - for (var i = 7; i >= 0; i--) { 40 40 - ctr[i] = (ctr[i] + 1) & 0xff; 41 41 - if (ctr[i] !== 0) break; 42 42 - } 43 43 - } 44 44 - } 45 45 - 46 46 - //Provides: mc_count_16_be 47 47 - function mc_count_16_be(ctr, dst, off, blocks) { 48 48 - for (var b = 0; b < blocks; b++) { 49 49 - for (var i = 0; i < 16; i++) dst[off + b * 16 + i] = ctr[i]; 50 50 - for (var i = 15; i >= 0; i--) { 51 51 - ctr[i] = (ctr[i] + 1) & 0xff; 52 52 - if (ctr[i] !== 0) break; 53 53 - } 54 54 - } 55 55 - } 56 56 - 57 57 - //Provides: mc_count_16_be_4 58 58 - function mc_count_16_be_4(ctr, dst, off, blocks) { 59 59 - // Same as mc_count_16_be but increments only the last 4 bytes 60 60 - for (var b = 0; b < blocks; b++) { 61 61 - for (var i = 0; i < 16; i++) dst[off + b * 16 + i] = ctr[i]; 62 62 - for (var i = 15; i >= 12; i--) { 63 63 - ctr[i] = (ctr[i] + 1) & 0xff; 64 64 - if (ctr[i] !== 0) break; 65 65 - } 66 66 - } 67 67 - } 68 68 - 69 69 - // ---- AES ---- 70 70 - // Rijndael S-box and key schedule, standard lookup-table implementation. 71 71 - 72 72 - //Provides: _aes_sbox 73 73 - var _aes_sbox = null; 74 74 - //Provides: _aes_Te 75 75 - var _aes_Te = null; 76 76 - 77 77 - //Provides: _aes_init_tables 78 78 - //Requires: _aes_sbox, _aes_Te 79 79 - function _aes_init_tables() { 80 80 - if (_aes_sbox) return; 81 81 - // Generate S-box 82 82 - var sbox = new Uint8Array(256); 83 83 - var inv = new Uint8Array(256); 84 84 - var p = 1, q = 1; 85 85 - do { 86 86 - p = p ^ (p << 1) ^ (p & 0x80 ? 0x1B : 0); 87 87 - p &= 0xff; 88 88 - q ^= q << 1; q ^= q << 2; q ^= q << 4; 89 89 - q ^= q & 0x80 ? 0x09 : 0; q &= 0xff; 90 90 - var v = q ^ ((q << 1) | (q >> 7)) ^ ((q << 2) | (q >> 6)) ^ 91 91 - ((q << 3) | (q >> 5)) ^ ((q << 4) | (q >> 4)); 92 92 - v = (v ^ 0x63) & 0xff; 93 93 - sbox[p] = v; inv[v] = p; 94 94 - } while (p !== 1); 95 95 - sbox[0] = 0x63; inv[0x63] = 0; 96 96 - _aes_sbox = sbox; _aes_inv_sbox = inv; 97 97 - 98 98 - // Generate T-tables for encryption 99 99 - var Te0 = new Uint32Array(256), Te1 = new Uint32Array(256); 100 100 - var Te2 = new Uint32Array(256), Te3 = new Uint32Array(256); 101 101 - var Td0 = new Uint32Array(256), Td1 = new Uint32Array(256); 102 102 - var Td2 = new Uint32Array(256), Td3 = new Uint32Array(256); 103 103 - for (var i = 0; i < 256; i++) { 104 104 - var s = sbox[i]; 105 105 - var x2 = ((s << 1) ^ (s & 0x80 ? 0x1b : 0)) & 0xff; 106 106 - var x3 = x2 ^ s; 107 107 - Te0[i] = (x2 << 24) | (s << 16) | (s << 8) | x3; 108 108 - Te1[i] = (x3 << 24) | (x2 << 16) | (s << 8) | s; 109 109 - Te2[i] = (s << 24) | (x3 << 16) | (x2 << 8) | s; 110 110 - Te3[i] = (s << 24) | (s << 16) | (x3 << 8) | x2; 111 111 - 112 112 - var si = inv[i] || 0; 113 113 - if (i === 0) si = 0; 114 114 - var s9 = si, sb = si, sd = si, se = si; 115 115 - // Multiply in GF(2^8) 116 116 - function gmul(a, b) { 117 117 - var r = 0; 118 118 - for (var j = 0; j < 8; j++) { 119 119 - if (b & 1) r ^= a; 120 120 - var hi = a & 0x80; 121 121 - a = (a << 1) & 0xff; 122 122 - if (hi) a ^= 0x1b; 123 123 - b >>= 1; 124 124 - } 125 125 - return r; 126 126 - } 127 127 - s9 = gmul(si, 9); sb = gmul(si, 0xb); sd = gmul(si, 0xd); se = gmul(si, 0xe); 128 128 - Td0[i] = (se << 24) | (s9 << 16) | (sd << 8) | sb; 129 129 - Td1[i] = (sb << 24) | (se << 16) | (s9 << 8) | sd; 130 130 - Td2[i] = (sd << 24) | (sb << 16) | (se << 8) | s9; 131 131 - Td3[i] = (s9 << 24) | (sd << 16) | (sb << 8) | se; 132 132 - } 133 133 - _aes_Te = [Te0, Te1, Te2, Te3]; 134 134 - _aes_Td = [Td0, Td1, Td2, Td3]; 135 135 - } 136 136 - 137 137 - //Provides: mc_aes_rk_size 138 138 - function mc_aes_rk_size(rounds) { 139 139 - return (rounds + 1) * 16; 140 140 - } 141 141 - 142 142 - //Provides: mc_aes_derive_e_key 143 143 - //Requires: _aes_init_tables 144 144 - function mc_aes_derive_e_key(key, rk, rounds) { 145 145 - _aes_init_tables(); 146 146 - var nk = key.length / 4; 147 147 - var nb = 4; 148 148 - // Copy key into rk as 32-bit words 149 149 - for (var i = 0; i < nk; i++) { 150 150 - rk[i*4] = key.charCodeAt(i*4); 151 151 - rk[i*4+1] = key.charCodeAt(i*4+1); 152 152 - rk[i*4+2] = key.charCodeAt(i*4+2); 153 153 - rk[i*4+3] = key.charCodeAt(i*4+3); 154 154 - } 155 155 - var rcon = [0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80, 0x1b, 0x36]; 156 156 - var ri = 0; 157 157 - for (var i = nk; i < nb * (rounds + 1); i++) { 158 158 - var t0 = rk[(i-1)*4], t1 = rk[(i-1)*4+1], t2 = rk[(i-1)*4+2], t3 = rk[(i-1)*4+3]; 159 159 - if (i % nk === 0) { 160 160 - var tmp = t0; 161 161 - t0 = _aes_sbox[t1] ^ rcon[ri++]; t1 = _aes_sbox[t2]; 162 162 - t2 = _aes_sbox[t3]; t3 = _aes_sbox[tmp]; 163 163 - } else if (nk > 6 && i % nk === 4) { 164 164 - t0 = _aes_sbox[t0]; t1 = _aes_sbox[t1]; 165 165 - t2 = _aes_sbox[t2]; t3 = _aes_sbox[t3]; 166 166 - } 167 167 - rk[i*4] = rk[(i-nk)*4] ^ t0; 168 168 - rk[i*4+1] = rk[(i-nk)*4+1] ^ t1; 169 169 - rk[i*4+2] = rk[(i-nk)*4+2] ^ t2; 170 170 - rk[i*4+3] = rk[(i-nk)*4+3] ^ t3; 171 171 - } 172 172 - } 173 173 - 174 174 - //Provides: mc_aes_derive_d_key 175 175 - //Requires: mc_aes_derive_e_key 176 176 - function mc_aes_derive_d_key(key, rk, rounds, ekey_opt) { 177 177 - // For decryption key schedule, first derive encryption then invert 178 178 - // (simplified: just derive encryption key for now — GCM only uses encrypt) 179 179 - mc_aes_derive_e_key(key, rk, rounds); 180 180 - } 181 181 - 182 182 - //Provides: mc_aes_enc_bc 183 183 - //Requires: _aes_init_tables 184 184 - function mc_aes_enc_bc(src, soff, dst, doff, rk, rounds, blocks) { 185 185 - _aes_init_tables(); 186 186 - var Te0 = _aes_Te[0], Te1 = _aes_Te[1], Te2 = _aes_Te[2], Te3 = _aes_Te[3]; 187 187 - for (var b = 0; b < blocks; b++) { 188 188 - var bo = b * 16; 189 189 - // Read input block 190 190 - var s0 = (src.charCodeAt(soff+bo)<<24)|(src.charCodeAt(soff+bo+1)<<16)| 191 191 - (src.charCodeAt(soff+bo+2)<<8)|src.charCodeAt(soff+bo+3); 192 192 - var s1 = (src.charCodeAt(soff+bo+4)<<24)|(src.charCodeAt(soff+bo+5)<<16)| 193 193 - (src.charCodeAt(soff+bo+6)<<8)|src.charCodeAt(soff+bo+7); 194 194 - var s2 = (src.charCodeAt(soff+bo+8)<<24)|(src.charCodeAt(soff+bo+9)<<16)| 195 195 - (src.charCodeAt(soff+bo+10)<<8)|src.charCodeAt(soff+bo+11); 196 196 - var s3 = (src.charCodeAt(soff+bo+12)<<24)|(src.charCodeAt(soff+bo+13)<<16)| 197 197 - (src.charCodeAt(soff+bo+14)<<8)|src.charCodeAt(soff+bo+15); 198 198 - // Add round key 0 199 199 - var rko = 0; 200 200 - s0 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 201 201 - s1 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 202 202 - s2 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 203 203 - s3 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 204 204 - // Rounds 1..Nr-1 205 205 - for (var r = 1; r < rounds; r++) { 206 206 - var t0 = Te0[(s0>>>24)&0xff] ^ Te1[(s1>>>16)&0xff] ^ Te2[(s2>>>8)&0xff] ^ Te3[s3&0xff]; 207 207 - var t1 = Te0[(s1>>>24)&0xff] ^ Te1[(s2>>>16)&0xff] ^ Te2[(s3>>>8)&0xff] ^ Te3[s0&0xff]; 208 208 - var t2 = Te0[(s2>>>24)&0xff] ^ Te1[(s3>>>16)&0xff] ^ Te2[(s0>>>8)&0xff] ^ Te3[s1&0xff]; 209 209 - var t3 = Te0[(s3>>>24)&0xff] ^ Te1[(s0>>>16)&0xff] ^ Te2[(s1>>>8)&0xff] ^ Te3[s2&0xff]; 210 210 - t0 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 211 211 - t1 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 212 212 - t2 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 213 213 - t3 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 214 214 - s0 = t0; s1 = t1; s2 = t2; s3 = t3; 215 215 - } 216 216 - // Final round (no MixColumns) 217 217 - var t0 = ((_aes_sbox[(s0>>>24)&0xff]<<24)|(_aes_sbox[(s1>>>16)&0xff]<<16)| 218 218 - (_aes_sbox[(s2>>>8)&0xff]<<8)|_aes_sbox[s3&0xff]); 219 219 - var t1 = ((_aes_sbox[(s1>>>24)&0xff]<<24)|(_aes_sbox[(s2>>>16)&0xff]<<16)| 220 220 - (_aes_sbox[(s3>>>8)&0xff]<<8)|_aes_sbox[s0&0xff]); 221 221 - var t2 = ((_aes_sbox[(s2>>>24)&0xff]<<24)|(_aes_sbox[(s3>>>16)&0xff]<<16)| 222 222 - (_aes_sbox[(s0>>>8)&0xff]<<8)|_aes_sbox[s1&0xff]); 223 223 - var t3 = ((_aes_sbox[(s3>>>24)&0xff]<<24)|(_aes_sbox[(s0>>>16)&0xff]<<16)| 224 224 - (_aes_sbox[(s1>>>8)&0xff]<<8)|_aes_sbox[s2&0xff]); 225 225 - t0 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 226 226 - t1 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 227 227 - t2 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 228 228 - t3 ^= (rk[rko]<<24)|(rk[rko+1]<<16)|(rk[rko+2]<<8)|rk[rko+3]; rko+=4; 229 229 - // Write output 230 230 - dst[doff+bo]=(t0>>>24)&0xff; dst[doff+bo+1]=(t0>>>16)&0xff; 231 231 - dst[doff+bo+2]=(t0>>>8)&0xff; dst[doff+bo+3]=t0&0xff; 232 232 - dst[doff+bo+4]=(t1>>>24)&0xff; dst[doff+bo+5]=(t1>>>16)&0xff; 233 233 - dst[doff+bo+6]=(t1>>>8)&0xff; dst[doff+bo+7]=t1&0xff; 234 234 - dst[doff+bo+8]=(t2>>>24)&0xff; dst[doff+bo+9]=(t2>>>16)&0xff; 235 235 - dst[doff+bo+10]=(t2>>>8)&0xff; dst[doff+bo+11]=t2&0xff; 236 236 - dst[doff+bo+12]=(t3>>>24)&0xff; dst[doff+bo+13]=(t3>>>16)&0xff; 237 237 - dst[doff+bo+14]=(t3>>>8)&0xff; dst[doff+bo+15]=t3&0xff; 238 238 - } 239 239 - } 240 240 - 241 241 - //Provides: mc_aes_dec_bc 242 242 - //Requires: mc_aes_enc_bc 243 243 - function mc_aes_dec_bc(src, soff, dst, doff, rk, rounds, blocks) { 244 244 - // TODO: proper AES decryption. For GCM we only need encrypt. 245 245 - // Stub that prevents crash; actual GCM decrypt uses encrypt direction. 246 246 - mc_aes_enc_bc(src, soff, dst, doff, rk, rounds, blocks); 247 247 - } 248 248 - 249 249 - // ---- DES (stub only — not used by SDLS/GCM) ---- 250 250 - 251 251 - //Provides: mc_des_key_size 252 252 - function mc_des_key_size(unit) { return 128; } 253 253 - 254 254 - //Provides: mc_des_des3key 255 255 - function mc_des_des3key(key, mode, ek) { /* stub */ } 256 256 - 257 257 - //Provides: mc_des_ddes_bc 258 258 - function mc_des_ddes_bc(key, koff, dst, doff, mode, src) { /* stub */ } 259 259 - 260 260 - // ---- ChaCha20 (stub — not used by SDLS/GCM) ---- 261 261 - 262 262 - //Provides: mc_chacha_round 263 263 - function mc_chacha_round(count, state, output, off) { /* stub */ } 264 264 - 265 265 - // ---- Poly1305 (stub — not used by AES-GCM) ---- 266 266 - 267 267 - //Provides: mc_poly1305_ctx_size 268 268 - function mc_poly1305_ctx_size(unit) { return 256; } 269 269 - 270 270 - //Provides: mc_poly1305_mac_size 271 271 - function mc_poly1305_mac_size(unit) { return 16; } 272 272 - 273 273 - //Provides: mc_poly1305_init 274 274 - function mc_poly1305_init(ctx, key) { /* stub */ } 275 275 - 276 276 - //Provides: mc_poly1305_update 277 277 - function mc_poly1305_update(ctx, data, off, len) { /* stub */ } 278 278 - 279 279 - //Provides: mc_poly1305_finalize 280 280 - function mc_poly1305_finalize(ctx, mac, off) { /* stub */ } 281 281 - 282 282 - // ---- GHASH ---- 283 283 - 284 284 - //Provides: mc_ghash_key_size 285 285 - function mc_ghash_key_size(unit) { return 128; /* 8 * 16-byte entries */ } 286 286 - 287 287 - //Provides: mc_ghash_init_key 288 288 - function mc_ghash_init_key(h_str, htable) { 289 289 - // Store H as bytes for use in ghash 290 290 - for (var i = 0; i < 16; i++) { 291 291 - htable[i] = h_str.charCodeAt(i) & 0xff; 292 292 - } 293 293 - } 294 294 - 295 295 - //Provides: mc_ghash 296 296 - //Requires: mc_ghash_init_key 297 297 - function mc_ghash(htable_str, tag, data, off, len) { 298 298 - // Simplified GHASH: XOR + GF(2^128) multiply 299 299 - // H is stored in first 16 bytes of htable 300 300 - var H = new Uint8Array(16); 301 301 - for (var i = 0; i < 16; i++) H[i] = htable_str.charCodeAt(i) & 0xff; 302 302 - 303 303 - function gf128_mul(x, y) { 304 304 - var z = new Uint8Array(16); 305 305 - var v = new Uint8Array(y); 306 306 - for (var i = 0; i < 128; i++) { 307 307 - if (x[Math.floor(i/8)] & (0x80 >> (i%8))) { 308 308 - for (var j = 0; j < 16; j++) z[j] ^= v[j]; 309 309 - } 310 310 - var carry = v[15] & 1; 311 311 - for (var j = 15; j > 0; j--) v[j] = (v[j] >> 1) | ((v[j-1] & 1) << 7); 312 312 - v[0] >>= 1; 313 313 - if (carry) v[0] ^= 0xe1; 314 314 - } 315 315 - return z; 316 316 - } 317 317 - 318 318 - var blocks = Math.floor(len / 16); 319 319 - for (var b = 0; b < blocks; b++) { 320 320 - var x = new Uint8Array(16); 321 321 - for (var i = 0; i < 16; i++) x[i] = tag[i] ^ (data.charCodeAt(off + b*16 + i) & 0xff); 322 322 - var r = gf128_mul(x, H); 323 323 - for (var i = 0; i < 16; i++) tag[i] = r[i]; 324 324 - } 325 325 - // Handle partial last block 326 326 - var rem = len - blocks * 16; 327 327 - if (rem > 0) { 328 328 - var x = new Uint8Array(16); 329 329 - for (var i = 0; i < rem; i++) x[i] = tag[i] ^ (data.charCodeAt(off + blocks*16 + i) & 0xff); 330 330 - for (var i = rem; i < 16; i++) x[i] = tag[i]; 331 331 - var r = gf128_mul(x, H); 332 332 - for (var i = 0; i < 16; i++) tag[i] = r[i]; 333 333 - } 334 334 - }

+3 -35

src/dune

reviewed

··· 1 1 (library 2 2 (name crypto) 3 3 (public_name crypto) 4 4 - (js_of_ocaml 5 5 - (javascript_files crypto_stubs.js)) 6 4 (libraries eqaf fmt) 5 5 + (virtual_modules native) 6 6 + (default_implementation crypto.c) 7 7 (private_modules 8 8 aead 9 9 chacha20 10 10 ccm 11 11 cipher_block 12 12 cipher_stream 13 13 - native 14 13 poly1305 15 15 - uncommon) 16 16 - (foreign_stubs 17 17 - (language c) 18 18 - (names 19 19 - detect_cpu_features 20 20 - misc 21 21 - misc_sse 22 22 - aes_generic 23 23 - aes_aesni 24 24 - ghash_generic 25 25 - ghash_pclmul 26 26 - ghash_ctmul 27 27 - des_generic 28 28 - chacha 29 29 - poly1305-donna 30 30 - entropy_cpu_stubs) 31 31 - (flags 32 32 - (:standard) 33 33 - (:include cflags_optimized.sexp))) 34 34 - (foreign_stubs 35 35 - (language c) 36 36 - (names chacha_generic) 37 37 - (flags 38 38 - (:standard) 39 39 - (:include cflags.sexp)))) 40 40 - 41 41 - (env 42 42 - (dev 43 43 - (c_flags 44 44 - (:include cflags_warn.sexp)))) 45 45 - 46 46 - (include_subdirs unqualified) 14 14 + uncommon)) 47 15 48 16 (rule 49 17 (targets cflags.sexp cflags_optimized.sexp cflags_warn.sexp)

src/native.ml src/c/native.ml

reviewed

+30 -59

src/native.mli

reviewed

··· 1 1 - (** C accelerated cryptographic primitives. 1 1 + (** Platform-specific cryptographic primitives. 2 2 3 3 - Low-level bindings to platform-optimised implementations of AES, DES, 4 4 - ChaCha20, Poly1305, and GHASH. *) 3 3 + Low-level implementations of AES, DES, ChaCha20, Poly1305, and GHASH. 4 4 + 5 5 + This is a virtual module with two implementations: 6 6 + - {b crypto.c}: C with optional AES-NI/PCLMULQDQ acceleration (default) 7 7 + - {b crypto.ocaml}: pure OCaml (for js_of_ocaml / wasm_of_ocaml) *) 5 8 6 9 (** AES block cipher. *) 7 10 module AES : sig 8 8 - external enc : string -> int -> bytes -> int -> string -> int -> int -> unit 9 9 - = "mc_aes_enc_bc" "mc_aes_enc" 10 10 - [@@noalloc] 11 11 + val enc : string -> int -> bytes -> int -> string -> int -> int -> unit 11 12 (** [enc src src_off dst dst_off rk rk_off blocks] encrypts [blocks] AES 12 13 blocks from [src] into [dst] using round keys [rk]. *) 13 14 14 14 - external dec : string -> int -> bytes -> int -> string -> int -> int -> unit 15 15 - = "mc_aes_dec_bc" "mc_aes_dec" 16 16 - [@@noalloc] 15 15 + val dec : string -> int -> bytes -> int -> string -> int -> int -> unit 17 16 (** [dec src src_off dst dst_off rk rk_off blocks] decrypts [blocks] AES 18 17 blocks from [src] into [dst] using round keys [rk]. *) 19 18 20 20 - external derive_e : string -> bytes -> int -> unit = "mc_aes_derive_e_key" 21 21 - [@@noalloc] 19 19 + val derive_e : string -> bytes -> int -> unit 22 20 (** [derive_e key rk rounds] derives the encryption round-key schedule from 23 21 [key] into [rk]. *) 24 22 25 25 - external derive_d : string -> bytes -> int -> string option -> unit 26 26 - = "mc_aes_derive_d_key" 27 27 - [@@noalloc] 23 23 + val derive_d : string -> bytes -> int -> string option -> unit 28 24 (** [derive_d key rk rounds ekey] derives the decryption round-key schedule. 29 25 If [ekey] is provided, it is used as a precomputed encryption schedule. *) 30 26 31 31 - external rk_s : int -> int = "mc_aes_rk_size" 32 32 - [@@noalloc] 27 27 + val rk_s : int -> int 33 28 (** [rk_s rounds] is the round-key buffer size in bytes for [rounds] rounds. 34 29 *) 35 30 36 36 - external mode : unit -> int = "mc_aes_mode" 37 37 - [@@noalloc] 31 31 + val mode : unit -> int 38 32 (** [mode ()] detects the AES implementation: [0] for generic, [1] for AES-NI. 39 33 *) 40 34 end 41 35 42 36 (** Triple DES block cipher. *) 43 37 module DES : sig 44 44 - external ddes : string -> int -> bytes -> int -> int -> string -> unit 45 45 - = "mc_des_ddes_bc" "mc_des_ddes" 46 46 - [@@noalloc] 38 38 + val ddes : string -> int -> bytes -> int -> int -> string -> unit 47 39 (** [ddes src src_off dst dst_off blocks ks] encrypts or decrypts [blocks] DES 48 40 blocks using key schedule [ks]. *) 49 41 50 50 - external des3key : bytes -> int -> bytes -> unit = "mc_des_des3key" 51 51 - [@@noalloc] 42 42 + val des3key : bytes -> int -> bytes -> unit 52 43 (** [des3key key mode ks] derives a Triple-DES key schedule from [key] into 53 44 [ks]. [mode] selects encryption or decryption. *) 54 45 55 55 - external k_s : unit -> int = "mc_des_key_size" 56 56 - [@@noalloc] 46 46 + val k_s : unit -> int 57 47 (** [k_s ()] is the key-schedule buffer size in bytes. *) 58 48 end 59 49 60 50 (** ChaCha20 stream cipher. *) 61 51 module Chacha : sig 62 62 - external round : int -> bytes -> bytes -> int -> unit = "mc_chacha_round" 63 63 - [@@noalloc] 52 52 + val round : int -> bytes -> bytes -> int -> unit 64 53 (** [round count state dst off] performs [count] ChaCha20 rounds on [state], 65 54 writing output into [dst] at offset [off]. *) 66 55 end 67 56 68 57 (** Poly1305 message authentication. *) 69 58 module Poly1305 : sig 70 70 - external init : bytes -> string -> unit = "mc_poly1305_init" 71 71 - [@@noalloc] 59 59 + val init : bytes -> string -> unit 72 60 (** [init ctx key] initialises the Poly1305 context [ctx] with [key]. *) 73 61 74 74 - external update : bytes -> string -> int -> int -> unit = "mc_poly1305_update" 75 75 - [@@noalloc] 62 62 + val update : bytes -> string -> int -> int -> unit 76 63 (** [update ctx data off len] feeds [len] bytes from [data] at [off] into 77 64 [ctx]. *) 78 65 79 79 - external finalize : bytes -> bytes -> int -> unit = "mc_poly1305_finalize" 80 80 - [@@noalloc] 66 66 + val finalize : bytes -> bytes -> int -> unit 81 67 (** [finalize ctx mac off] writes the final MAC tag into [mac] at [off]. *) 82 68 83 83 - external ctx_size : unit -> int = "mc_poly1305_ctx_size" 84 84 - [@@noalloc] 69 69 + val ctx_size : unit -> int 85 70 (** [ctx_size ()] is the Poly1305 context size in bytes. *) 86 71 87 87 - external mac_size : unit -> int = "mc_poly1305_mac_size" 88 88 - [@@noalloc] 72 72 + val mac_size : unit -> int 89 73 (** [mac_size ()] is the MAC tag size in bytes (16). *) 90 74 end 91 75 92 76 (** GHASH universal hash for GCM. *) 93 77 module GHASH : sig 94 94 - external keysize : unit -> int = "mc_ghash_key_size" 95 95 - [@@noalloc] 78 78 + val keysize : unit -> int 96 79 (** [keysize ()] is the GHASH key buffer size in bytes. *) 97 80 98 98 - external keyinit : string -> bytes -> unit = "mc_ghash_init_key" 99 99 - [@@noalloc] 81 81 + val keyinit : string -> bytes -> unit 100 82 (** [keyinit key buf] derives the GHASH subkey into [buf]. *) 101 83 102 102 - external ghash : string -> bytes -> string -> int -> int -> unit = "mc_ghash" 103 103 - [@@noalloc] 84 84 + val ghash : string -> bytes -> string -> int -> int -> unit 104 85 (** [ghash key hash data off len] updates [hash] with [len] bytes from [data] 105 86 at [off] using the GHASH [key]. *) 106 87 107 107 - external mode : unit -> int = "mc_ghash_mode" 108 108 - [@@noalloc] 88 88 + val mode : unit -> int 109 89 (** [mode ()] detects the GHASH implementation: [0] for generic, [1] for 110 90 PCLMULQDQ. *) 111 91 end 112 92 113 113 - external xor_into_bytes : string -> int -> bytes -> int -> int -> unit 114 114 - = "mc_xor_into_bytes" 115 115 - [@@noalloc] 93 93 + val xor_into_bytes : string -> int -> bytes -> int -> int -> unit 116 94 (** [xor_into_bytes src src_off dst dst_off len] XORs [len] bytes from [src] at 117 95 [src_off] into [dst] at [dst_off]. *) 118 96 119 119 - external count8be : ctr:bytes -> bytes -> off:int -> blocks:int -> unit 120 120 - = "mc_count_8_be" 121 121 - [@@noalloc] 97 97 + val count8be : ctr:bytes -> bytes -> off:int -> blocks:int -> unit 122 98 (** [count8be ~ctr buf ~off ~blocks] writes [blocks] big-endian 8-byte counter 123 99 values into [buf]. *) 124 100 125 125 - external count16be : ctr:bytes -> bytes -> off:int -> blocks:int -> unit 126 126 - = "mc_count_16_be" 127 127 - [@@noalloc] 101 101 + val count16be : ctr:bytes -> bytes -> off:int -> blocks:int -> unit 128 102 (** [count16be ~ctr buf ~off ~blocks] writes [blocks] big-endian 16-byte counter 129 103 values into [buf]. *) 130 104 131 131 - external count16be4 : ctr:bytes -> bytes -> off:int -> blocks:int -> unit 132 132 - = "mc_count_16_be_4" 133 133 - [@@noalloc] 105 105 + val count16be4 : ctr:bytes -> bytes -> off:int -> blocks:int -> unit 134 106 (** [count16be4 ~ctr buf ~off ~blocks] writes [blocks] big-endian 16-byte 135 107 counter values into [buf], incrementing only the lower 32 bits. *) 136 108 137 137 - external misc_mode : unit -> int = "mc_misc_mode" 138 138 - [@@noalloc] 109 109 + val misc_mode : unit -> int 139 110 (** [misc_mode ()] detects hardware XOR acceleration. *)

src/native/aes_aesni.c src/c/aes_aesni.c

reviewed

src/native/aes_generic.c src/c/aes_generic.c

reviewed

src/native/bitfn.h src/c/bitfn.h

reviewed

src/native/chacha.c src/c/chacha.c

reviewed

src/native/chacha_generic.c src/c/chacha_generic.c

reviewed

src/native/crypto.h src/c/crypto.h

reviewed

src/native/des_generic.c src/c/des_generic.c

reviewed

src/native/detect_cpu_features.c src/c/detect_cpu_features.c

reviewed

src/native/entropy_cpu_stubs.c src/c/entropy_cpu_stubs.c

reviewed

src/native/ghash_ctmul.c src/c/ghash_ctmul.c

reviewed

src/native/ghash_generic.c src/c/ghash_generic.c

reviewed

src/native/ghash_pclmul.c src/c/ghash_pclmul.c

reviewed

src/native/misc.c src/c/misc.c

reviewed

src/native/misc_sse.c src/c/misc_sse.c

reviewed

src/native/poly1305-donna-32.h src/c/poly1305-donna-32.h

reviewed

src/native/poly1305-donna-64.h src/c/poly1305-donna-64.h

reviewed

src/native/poly1305-donna.c src/c/poly1305-donna.c

reviewed

+488

src/ocaml/aes_pure.ml

reviewed

··· 1 1 + (** Pure OCaml AES implementation using T-tables. 2 2 + 3 3 + Same algorithm as aes_generic.c (public domain, Philip J. Erdelsky). Uses 4 4 + Int32 for 32-bit operations so it works on both 64-bit native and 32-bit 5 5 + targets (js_of_ocaml, wasm_of_ocaml). *) 6 6 + 7 7 + (* S-box from FIPS 197 *) 8 8 + let sbox = 9 9 + [| 10 10 + 0x63; 11 11 + 0x7c; 12 12 + 0x77; 13 13 + 0x7b; 14 14 + 0xf2; 15 15 + 0x6b; 16 16 + 0x6f; 17 17 + 0xc5; 18 18 + 0x30; 19 19 + 0x01; 20 20 + 0x67; 21 21 + 0x2b; 22 22 + 0xfe; 23 23 + 0xd7; 24 24 + 0xab; 25 25 + 0x76; 26 26 + 0xca; 27 27 + 0x82; 28 28 + 0xc9; 29 29 + 0x7d; 30 30 + 0xfa; 31 31 + 0x59; 32 32 + 0x47; 33 33 + 0xf0; 34 34 + 0xad; 35 35 + 0xd4; 36 36 + 0xa2; 37 37 + 0xaf; 38 38 + 0x9c; 39 39 + 0xa4; 40 40 + 0x72; 41 41 + 0xc0; 42 42 + 0xb7; 43 43 + 0xfd; 44 44 + 0x93; 45 45 + 0x26; 46 46 + 0x36; 47 47 + 0x3f; 48 48 + 0xf7; 49 49 + 0xcc; 50 50 + 0x34; 51 51 + 0xa5; 52 52 + 0xe5; 53 53 + 0xf1; 54 54 + 0x71; 55 55 + 0xd8; 56 56 + 0x31; 57 57 + 0x15; 58 58 + 0x04; 59 59 + 0xc7; 60 60 + 0x23; 61 61 + 0xc3; 62 62 + 0x18; 63 63 + 0x96; 64 64 + 0x05; 65 65 + 0x9a; 66 66 + 0x07; 67 67 + 0x12; 68 68 + 0x80; 69 69 + 0xe2; 70 70 + 0xeb; 71 71 + 0x27; 72 72 + 0xb2; 73 73 + 0x75; 74 74 + 0x09; 75 75 + 0x83; 76 76 + 0x2c; 77 77 + 0x1a; 78 78 + 0x1b; 79 79 + 0x6e; 80 80 + 0x5a; 81 81 + 0xa0; 82 82 + 0x52; 83 83 + 0x3b; 84 84 + 0xd6; 85 85 + 0xb3; 86 86 + 0x29; 87 87 + 0xe3; 88 88 + 0x2f; 89 89 + 0x84; 90 90 + 0x53; 91 91 + 0xd1; 92 92 + 0x00; 93 93 + 0xed; 94 94 + 0x20; 95 95 + 0xfc; 96 96 + 0xb1; 97 97 + 0x5b; 98 98 + 0x6a; 99 99 + 0xcb; 100 100 + 0xbe; 101 101 + 0x39; 102 102 + 0x4a; 103 103 + 0x4c; 104 104 + 0x58; 105 105 + 0xcf; 106 106 + 0xd0; 107 107 + 0xef; 108 108 + 0xaa; 109 109 + 0xfb; 110 110 + 0x43; 111 111 + 0x4d; 112 112 + 0x33; 113 113 + 0x85; 114 114 + 0x45; 115 115 + 0xf9; 116 116 + 0x02; 117 117 + 0x7f; 118 118 + 0x50; 119 119 + 0x3c; 120 120 + 0x9f; 121 121 + 0xa8; 122 122 + 0x51; 123 123 + 0xa3; 124 124 + 0x40; 125 125 + 0x8f; 126 126 + 0x92; 127 127 + 0x9d; 128 128 + 0x38; 129 129 + 0xf5; 130 130 + 0xbc; 131 131 + 0xb6; 132 132 + 0xda; 133 133 + 0x21; 134 134 + 0x10; 135 135 + 0xff; 136 136 + 0xf3; 137 137 + 0xd2; 138 138 + 0xcd; 139 139 + 0x0c; 140 140 + 0x13; 141 141 + 0xec; 142 142 + 0x5f; 143 143 + 0x97; 144 144 + 0x44; 145 145 + 0x17; 146 146 + 0xc4; 147 147 + 0xa7; 148 148 + 0x7e; 149 149 + 0x3d; 150 150 + 0x64; 151 151 + 0x5d; 152 152 + 0x19; 153 153 + 0x73; 154 154 + 0x60; 155 155 + 0x81; 156 156 + 0x4f; 157 157 + 0xdc; 158 158 + 0x22; 159 159 + 0x2a; 160 160 + 0x90; 161 161 + 0x88; 162 162 + 0x46; 163 163 + 0xee; 164 164 + 0xb8; 165 165 + 0x14; 166 166 + 0xde; 167 167 + 0x5e; 168 168 + 0x0b; 169 169 + 0xdb; 170 170 + 0xe0; 171 171 + 0x32; 172 172 + 0x3a; 173 173 + 0x0a; 174 174 + 0x49; 175 175 + 0x06; 176 176 + 0x24; 177 177 + 0x5c; 178 178 + 0xc2; 179 179 + 0xd3; 180 180 + 0xac; 181 181 + 0x62; 182 182 + 0x91; 183 183 + 0x95; 184 184 + 0xe4; 185 185 + 0x79; 186 186 + 0xe7; 187 187 + 0xc8; 188 188 + 0x37; 189 189 + 0x6d; 190 190 + 0x8d; 191 191 + 0xd5; 192 192 + 0x4e; 193 193 + 0xa9; 194 194 + 0x6c; 195 195 + 0x56; 196 196 + 0xf4; 197 197 + 0xea; 198 198 + 0x65; 199 199 + 0x7a; 200 200 + 0xae; 201 201 + 0x08; 202 202 + 0xba; 203 203 + 0x78; 204 204 + 0x25; 205 205 + 0x2e; 206 206 + 0x1c; 207 207 + 0xa6; 208 208 + 0xb4; 209 209 + 0xc6; 210 210 + 0xe8; 211 211 + 0xdd; 212 212 + 0x74; 213 213 + 0x1f; 214 214 + 0x4b; 215 215 + 0xbd; 216 216 + 0x8b; 217 217 + 0x8a; 218 218 + 0x70; 219 219 + 0x3e; 220 220 + 0xb5; 221 221 + 0x66; 222 222 + 0x48; 223 223 + 0x03; 224 224 + 0xf6; 225 225 + 0x0e; 226 226 + 0x61; 227 227 + 0x35; 228 228 + 0x57; 229 229 + 0xb9; 230 230 + 0x86; 231 231 + 0xc1; 232 232 + 0x1d; 233 233 + 0x9e; 234 234 + 0xe1; 235 235 + 0xf8; 236 236 + 0x98; 237 237 + 0x11; 238 238 + 0x69; 239 239 + 0xd9; 240 240 + 0x8e; 241 241 + 0x94; 242 242 + 0x9b; 243 243 + 0x1e; 244 244 + 0x87; 245 245 + 0xe9; 246 246 + 0xce; 247 247 + 0x55; 248 248 + 0x28; 249 249 + 0xdf; 250 250 + 0x8c; 251 251 + 0xa1; 252 252 + 0x89; 253 253 + 0x0d; 254 254 + 0xbf; 255 255 + 0xe6; 256 256 + 0x42; 257 257 + 0x68; 258 258 + 0x41; 259 259 + 0x99; 260 260 + 0x2d; 261 261 + 0x0f; 262 262 + 0xb0; 263 263 + 0x54; 264 264 + 0xbb; 265 265 + 0x16; 266 266 + |] 267 267 + 268 268 + (* GF(2^8) multiply by 2 *) 269 269 + let xtime x = 270 270 + let x2 = (x lsl 1) land 0xff in 271 271 + if x land 0x80 <> 0 then x2 lxor 0x1b else x2 272 272 + 273 273 + (* Build T-table entry: [x2, x, x, x3] as Int32 *) 274 274 + let te0 = 275 275 + Array.init 256 (fun i -> 276 276 + let s = sbox.(i) in 277 277 + let x2 = xtime s in 278 278 + let x3 = x2 lxor s in 279 279 + Int32.logor 280 280 + (Int32.logor 281 281 + (Int32.shift_left (Int32.of_int x2) 24) 282 282 + (Int32.shift_left (Int32.of_int s) 16)) 283 283 + (Int32.logor (Int32.shift_left (Int32.of_int s) 8) (Int32.of_int x3))) 284 284 + 285 285 + (* Rotate T-table entries for Te1, Te2, Te3 *) 286 286 + let rot8 x = 287 287 + Int32.logor 288 288 + (Int32.shift_right_logical x 8) 289 289 + (Int32.shift_left (Int32.logand x 0xffl) 24) 290 290 + 291 291 + let te1 = Array.map rot8 te0 292 292 + let te2 = Array.map rot8 te1 293 293 + let te3 = Array.map rot8 te2 294 294 + 295 295 + (* Round constant *) 296 296 + let rcon = [| 0x01; 0x02; 0x04; 0x08; 0x10; 0x20; 0x40; 0x80; 0x1b; 0x36 |] 297 297 + 298 298 + (* Key schedule: returns round keys as Int32 array *) 299 299 + let expand_key key = 300 300 + let klen = String.length key in 301 301 + let nk = klen / 4 in 302 302 + let rounds = 303 303 + match klen with 304 304 + | 16 -> 10 305 305 + | 24 -> 12 306 306 + | 32 -> 14 307 307 + | _ -> invalid_arg "AES key" 308 308 + in 309 309 + let nb = 4 in 310 310 + let rk = Array.make (nb * (rounds + 1)) 0l in 311 311 + for i = 0 to nk - 1 do 312 312 + rk.(i) <- 313 313 + Int32.logor 314 314 + (Int32.logor 315 315 + (Int32.shift_left (Int32.of_int (Char.code key.[i * 4])) 24) 316 316 + (Int32.shift_left (Int32.of_int (Char.code key.[(i * 4) + 1])) 16)) 317 317 + (Int32.logor 318 318 + (Int32.shift_left (Int32.of_int (Char.code key.[(i * 4) + 2])) 8) 319 319 + (Int32.of_int (Char.code key.[(i * 4) + 3]))) 320 320 + done; 321 321 + let ri = ref 0 in 322 322 + for i = nk to (nb * (rounds + 1)) - 1 do 323 323 + let prev = rk.(i - 1) in 324 324 + let t = 325 325 + if i mod nk = 0 then begin 326 326 + let r = !ri in 327 327 + incr ri; 328 328 + let b0 = 329 329 + Int32.of_int 330 330 + (sbox.(Int32.to_int 331 331 + (Int32.logand (Int32.shift_right_logical prev 16) 0xffl)) 332 332 + lxor rcon.(r)) 333 333 + in 334 334 + let b1 = 335 335 + Int32.of_int 336 336 + sbox.(Int32.to_int 337 337 + (Int32.logand (Int32.shift_right_logical prev 8) 0xffl)) 338 338 + in 339 339 + let b2 = Int32.of_int sbox.(Int32.to_int (Int32.logand prev 0xffl)) in 340 340 + let b3 = 341 341 + Int32.of_int 342 342 + sbox.(Int32.to_int 343 343 + (Int32.logand (Int32.shift_right_logical prev 24) 0xffl)) 344 344 + in 345 345 + Int32.logor 346 346 + (Int32.logor (Int32.shift_left b0 24) (Int32.shift_left b1 16)) 347 347 + (Int32.logor (Int32.shift_left b2 8) b3) 348 348 + end 349 349 + else if nk > 6 && i mod nk = 4 then begin 350 350 + let b0 = 351 351 + Int32.of_int 352 352 + sbox.(Int32.to_int 353 353 + (Int32.logand (Int32.shift_right_logical prev 24) 0xffl)) 354 354 + in 355 355 + let b1 = 356 356 + Int32.of_int 357 357 + sbox.(Int32.to_int 358 358 + (Int32.logand (Int32.shift_right_logical prev 16) 0xffl)) 359 359 + in 360 360 + let b2 = 361 361 + Int32.of_int 362 362 + sbox.(Int32.to_int 363 363 + (Int32.logand (Int32.shift_right_logical prev 8) 0xffl)) 364 364 + in 365 365 + let b3 = Int32.of_int sbox.(Int32.to_int (Int32.logand prev 0xffl)) in 366 366 + Int32.logor 367 367 + (Int32.logor (Int32.shift_left b0 24) (Int32.shift_left b1 16)) 368 368 + (Int32.logor (Int32.shift_left b2 8) b3) 369 369 + end 370 370 + else prev 371 371 + in 372 372 + rk.(i) <- Int32.logxor rk.(i - nk) t 373 373 + done; 374 374 + (rk, rounds) 375 375 + 376 376 + (* Encrypt one 16-byte block *) 377 377 + let encrypt_block rk rounds src soff dst doff = 378 378 + let ( lxor ) = Int32.logxor in 379 379 + let ( land ) = Int32.logand in 380 380 + let ( lsr ) = Int32.shift_right_logical in 381 381 + let get_byte32 w shift = Int32.to_int ((w lsr shift) land 0xffl) in 382 382 + let get32 buf off = 383 383 + Int32.logor 384 384 + (Int32.logor 385 385 + (Int32.shift_left (Int32.of_int (Char.code buf.[off])) 24) 386 386 + (Int32.shift_left (Int32.of_int (Char.code buf.[off + 1])) 16)) 387 387 + (Int32.logor 388 388 + (Int32.shift_left (Int32.of_int (Char.code buf.[off + 2])) 8) 389 389 + (Int32.of_int (Char.code buf.[off + 3]))) 390 390 + in 391 391 + let put32 buf off w = 392 392 + Bytes.set buf off (Char.chr (get_byte32 w 24)); 393 393 + Bytes.set buf (off + 1) (Char.chr (get_byte32 w 16)); 394 394 + Bytes.set buf (off + 2) (Char.chr (get_byte32 w 8)); 395 395 + Bytes.set buf (off + 3) (Char.chr (get_byte32 w 0)) 396 396 + in 397 397 + let s0 = ref (get32 src soff lxor rk.(0)) in 398 398 + let s1 = ref (get32 src (soff + 4) lxor rk.(1)) in 399 399 + let s2 = ref (get32 src (soff + 8) lxor rk.(2)) in 400 400 + let s3 = ref (get32 src (soff + 12) lxor rk.(3)) in 401 401 + let rki = ref 4 in 402 402 + for _ = 1 to rounds - 1 do 403 403 + let t0 = 404 404 + te0.(get_byte32 !s0 24) 405 405 + lxor te1.(get_byte32 !s1 16) 406 406 + lxor te2.(get_byte32 !s2 8) 407 407 + lxor te3.(get_byte32 !s3 0) 408 408 + lxor rk.(!rki) 409 409 + in 410 410 + let t1 = 411 411 + te0.(get_byte32 !s1 24) 412 412 + lxor te1.(get_byte32 !s2 16) 413 413 + lxor te2.(get_byte32 !s3 8) 414 414 + lxor te3.(get_byte32 !s0 0) 415 415 + lxor rk.(!rki + 1) 416 416 + in 417 417 + let t2 = 418 418 + te0.(get_byte32 !s2 24) 419 419 + lxor te1.(get_byte32 !s3 16) 420 420 + lxor te2.(get_byte32 !s0 8) 421 421 + lxor te3.(get_byte32 !s1 0) 422 422 + lxor rk.(!rki + 2) 423 423 + in 424 424 + let t3 = 425 425 + te0.(get_byte32 !s3 24) 426 426 + lxor te1.(get_byte32 !s0 16) 427 427 + lxor te2.(get_byte32 !s1 8) 428 428 + lxor te3.(get_byte32 !s2 0) 429 429 + lxor rk.(!rki + 3) 430 430 + in 431 431 + s0 := t0; 432 432 + s1 := t1; 433 433 + s2 := t2; 434 434 + s3 := t3; 435 435 + rki := !rki + 4 436 436 + done; 437 437 + (* Final round: SubBytes + ShiftRows + AddRoundKey, no MixColumns *) 438 438 + let sb i = Int32.of_int sbox.(i) in 439 439 + let t0 = 440 440 + Int32.logor 441 441 + (Int32.logor 442 442 + (Int32.shift_left (sb (get_byte32 !s0 24)) 24) 443 443 + (Int32.shift_left (sb (get_byte32 !s1 16)) 16)) 444 444 + (Int32.logor 445 445 + (Int32.shift_left (sb (get_byte32 !s2 8)) 8) 446 446 + (sb (get_byte32 !s3 0))) 447 447 + lxor rk.(!rki) 448 448 + in 449 449 + let t1 = 450 450 + Int32.logor 451 451 + (Int32.logor 452 452 + (Int32.shift_left (sb (get_byte32 !s1 24)) 24) 453 453 + (Int32.shift_left (sb (get_byte32 !s2 16)) 16)) 454 454 + (Int32.logor 455 455 + (Int32.shift_left (sb (get_byte32 !s3 8)) 8) 456 456 + (sb (get_byte32 !s0 0))) 457 457 + lxor rk.(!rki + 1) 458 458 + in 459 459 + let t2 = 460 460 + Int32.logor 461 461 + (Int32.logor 462 462 + (Int32.shift_left (sb (get_byte32 !s2 24)) 24) 463 463 + (Int32.shift_left (sb (get_byte32 !s3 16)) 16)) 464 464 + (Int32.logor 465 465 + (Int32.shift_left (sb (get_byte32 !s0 8)) 8) 466 466 + (sb (get_byte32 !s1 0))) 467 467 + lxor rk.(!rki + 2) 468 468 + in 469 469 + let t3 = 470 470 + Int32.logor 471 471 + (Int32.logor 472 472 + (Int32.shift_left (sb (get_byte32 !s3 24)) 24) 473 473 + (Int32.shift_left (sb (get_byte32 !s0 16)) 16)) 474 474 + (Int32.logor 475 475 + (Int32.shift_left (sb (get_byte32 !s1 8)) 8) 476 476 + (sb (get_byte32 !s2 0))) 477 477 + lxor rk.(!rki + 3) 478 478 + in 479 479 + put32 dst doff t0; 480 480 + put32 dst (doff + 4) t1; 481 481 + put32 dst (doff + 8) t2; 482 482 + put32 dst (doff + 12) t3 483 483 + 484 484 + (* Multi-block encrypt matching the mc_aes_enc_bc interface *) 485 485 + let encrypt_ecb rk rounds src soff dst doff blocks = 486 486 + for b = 0 to blocks - 1 do 487 487 + encrypt_block rk rounds src (soff + (b * 16)) dst (doff + (b * 16)) 488 488 + done

+5

src/ocaml/dune

reviewed

··· 1 1 + (library 2 2 + (name crypto_ocaml) 3 3 + (public_name crypto.ocaml) 4 4 + (implements crypto) 5 5 + (private_modules aes_pure ghash_pure))

+58

src/ocaml/ghash_pure.ml

reviewed

··· 1 1 + (** Pure OCaml GHASH (GF(2^128) multiplication for AES-GCM). 2 2 + 3 3 + Bit-by-bit implementation. Correct but not constant-time. For production use 4 4 + on native targets, use the C implementation. *) 5 5 + 6 6 + let gf128_mul (x : bytes) (h : bytes) = 7 7 + let z = Bytes.make 16 '\x00' in 8 8 + let v = Bytes.copy h in 9 9 + for i = 0 to 127 do 10 10 + if Char.code (Bytes.get x (i / 8)) land (0x80 lsr (i mod 8)) <> 0 then 11 11 + for j = 0 to 15 do 12 12 + Bytes.set z j 13 13 + (Char.chr (Char.code (Bytes.get z j) lxor Char.code (Bytes.get v j))) 14 14 + done; 15 15 + let carry = Char.code (Bytes.get v 15) land 1 in 16 16 + for j = 15 downto 1 do 17 17 + Bytes.set v j 18 18 + (Char.chr 19 19 + ((Char.code (Bytes.get v j) lsr 1) 20 20 + lor ((Char.code (Bytes.get v (j - 1)) land 1) lsl 7) 21 21 + land 0xff)) 22 22 + done; 23 23 + Bytes.set v 0 (Char.chr ((Char.code (Bytes.get v 0) lsr 1) land 0xff)); 24 24 + if carry <> 0 then 25 25 + Bytes.set v 0 (Char.chr (Char.code (Bytes.get v 0) lxor 0xe1)) 26 26 + done; 27 27 + z 28 28 + 29 29 + let ghash (key : bytes) (tag : bytes) (data : string) (off : int) (len : int) = 30 30 + let h = Bytes.copy key in 31 31 + let nblocks = len / 16 in 32 32 + for b = 0 to nblocks - 1 do 33 33 + let x = Bytes.make 16 '\x00' in 34 34 + for i = 0 to 15 do 35 35 + Bytes.set x i 36 36 + (Char.chr 37 37 + (Char.code (Bytes.get tag i) 38 38 + lxor Char.code (String.get data (off + (b * 16) + i)))) 39 39 + done; 40 40 + let r = gf128_mul x h in 41 41 + Bytes.blit r 0 tag 0 16 42 42 + done; 43 43 + (* Partial last block *) 44 44 + let rem = len - (nblocks * 16) in 45 45 + if rem > 0 then begin 46 46 + let x = Bytes.make 16 '\x00' in 47 47 + for i = 0 to rem - 1 do 48 48 + Bytes.set x i 49 49 + (Char.chr 50 50 + (Char.code (Bytes.get tag i) 51 51 + lxor Char.code (String.get data (off + (nblocks * 16) + i)))) 52 52 + done; 53 53 + for i = rem to 15 do 54 54 + Bytes.set x i (Bytes.get tag i) 55 55 + done; 56 56 + let r = gf128_mul x h in 57 57 + Bytes.blit r 0 tag 0 16 58 58 + end

+138

src/ocaml/native.ml

reviewed

··· 1 1 + (** Pure OCaml implementation of the crypto primitives. 2 2 + 3 3 + For js_of_ocaml and wasm_of_ocaml targets. Same algorithms as the C 4 4 + implementations but without hardware acceleration. *) 5 5 + 6 6 + module AES = struct 7 7 + let rk_s rounds = (rounds + 1) * 16 8 8 + 9 9 + let derive_e key rk rounds = 10 10 + let ekey, _rounds = Aes_pure.expand_key key in 11 11 + assert (_rounds = rounds); 12 12 + (* Store Int32 round keys as big-endian bytes in rk *) 13 13 + for i = 0 to Array.length ekey - 1 do 14 14 + let w = ekey.(i) in 15 15 + Bytes.set rk (i * 4) 16 16 + (Char.chr (Int32.to_int (Int32.shift_right_logical w 24) land 0xff)); 17 17 + Bytes.set rk 18 18 + ((i * 4) + 1) 19 19 + (Char.chr (Int32.to_int (Int32.shift_right_logical w 16) land 0xff)); 20 20 + Bytes.set rk 21 21 + ((i * 4) + 2) 22 22 + (Char.chr (Int32.to_int (Int32.shift_right_logical w 8) land 0xff)); 23 23 + Bytes.set rk ((i * 4) + 3) (Char.chr (Int32.to_int w land 0xff)) 24 24 + done 25 25 + 26 26 + let derive_d key rk rounds _ekey = 27 27 + (* For GCM we only need encrypt direction. Store encryption keys. *) 28 28 + derive_e key rk rounds 29 29 + 30 30 + let enc src soff dst doff rk rounds blocks = 31 31 + (* Reconstruct Int32 array from rk bytes *) 32 32 + let nrk = (rounds + 1) * 4 in 33 33 + let rka = 34 34 + Array.init nrk (fun i -> 35 35 + let o = i * 4 in 36 36 + Int32.logor 37 37 + (Int32.logor 38 38 + (Int32.shift_left 39 39 + (Int32.of_int (Char.code (String.get rk o))) 40 40 + 24) 41 41 + (Int32.shift_left 42 42 + (Int32.of_int (Char.code (String.get rk (o + 1)))) 43 43 + 16)) 44 44 + (Int32.logor 45 45 + (Int32.shift_left 46 46 + (Int32.of_int (Char.code (String.get rk (o + 2)))) 47 47 + 8) 48 48 + (Int32.of_int (Char.code (String.get rk (o + 3)))))) 49 49 + in 50 50 + Aes_pure.encrypt_ecb rka rounds src soff dst doff blocks 51 51 + 52 52 + let dec = enc (* GCM only uses encrypt direction *) 53 53 + let mode () = 0 (* generic *) 54 54 + end 55 55 + 56 56 + module DES = struct 57 57 + let k_s () = 128 58 58 + 59 59 + let des3key _key _mode _ks = 60 60 + failwith "DES not implemented in pure OCaml backend" 61 61 + 62 62 + let ddes _src _soff _dst _doff _blocks _ks = 63 63 + failwith "DES not implemented in pure OCaml backend" 64 64 + end 65 65 + 66 66 + module Chacha = struct 67 67 + let round _count _state _dst _off = 68 68 + failwith "ChaCha20 not implemented in pure OCaml backend" 69 69 + end 70 70 + 71 71 + module Poly1305 = struct 72 72 + let ctx_size () = 256 73 73 + let mac_size () = 16 74 74 + let init _ctx _key = failwith "Poly1305 not implemented in pure OCaml backend" 75 75 + 76 76 + let update _ctx _data _off _len = 77 77 + failwith "Poly1305 not implemented in pure OCaml backend" 78 78 + 79 79 + let finalize _ctx _mac _off = 80 80 + failwith "Poly1305 not implemented in pure OCaml backend" 81 81 + end 82 82 + 83 83 + module GHASH = struct 84 84 + let keysize () = 16 85 85 + 86 86 + let keyinit h buf = 87 87 + (* Store H directly as 16 bytes *) 88 88 + Bytes.blit_string h 0 buf 0 16 89 89 + 90 90 + let ghash key tag data off len = 91 91 + Ghash_pure.ghash (Bytes.of_string key) tag data off len 92 92 + 93 93 + let mode () = 0 (* generic *) 94 94 + end 95 95 + 96 96 + let xor_into_bytes src soff dst doff len = 97 97 + for i = 0 to len - 1 do 98 98 + let s = Char.code (String.get src (soff + i)) in 99 99 + let d = Char.code (Bytes.get dst (doff + i)) in 100 100 + Bytes.set dst (doff + i) (Char.chr (s lxor d)) 101 101 + done 102 102 + 103 103 + let count8be ~ctr buf ~off ~blocks = 104 104 + for b = 0 to blocks - 1 do 105 105 + Bytes.blit ctr 0 buf (off + (b * 8)) 8; 106 106 + (* Increment counter (big-endian) *) 107 107 + let i = ref 7 in 108 108 + while !i >= 0 do 109 109 + let v = Char.code (Bytes.get ctr !i) + 1 in 110 110 + Bytes.set ctr !i (Char.chr (v land 0xff)); 111 111 + if v < 256 then i := -1 (* break *) else decr i 112 112 + done 113 113 + done 114 114 + 115 115 + let count16be ~ctr buf ~off ~blocks = 116 116 + for b = 0 to blocks - 1 do 117 117 + Bytes.blit ctr 0 buf (off + (b * 16)) 16; 118 118 + let i = ref 15 in 119 119 + while !i >= 0 do 120 120 + let v = Char.code (Bytes.get ctr !i) + 1 in 121 121 + Bytes.set ctr !i (Char.chr (v land 0xff)); 122 122 + if v < 256 then i := -1 else decr i 123 123 + done 124 124 + done 125 125 + 126 126 + let count16be4 ~ctr buf ~off ~blocks = 127 127 + for b = 0 to blocks - 1 do 128 128 + Bytes.blit ctr 0 buf (off + (b * 16)) 16; 129 129 + (* Only increment last 4 bytes *) 130 130 + let i = ref 15 in 131 131 + while !i >= 12 do 132 132 + let v = Char.code (Bytes.get ctr !i) + 1 in 133 133 + Bytes.set ctr !i (Char.chr (v land 0xff)); 134 134 + if v < 256 then i := 11 (* break *) else decr i 135 135 + done 136 136 + done 137 137 + 138 138 + let misc_mode () = 0 (* generic *)