├── .ocamlformat ├── test ├── dune └── simulate.t ├── dune-project ├── bin ├── dune └── simulate.ml ├── .gitignore ├── lib ├── dune ├── utils.c ├── pbkdf2.mli ├── fe_51 │ ├── constants.h │ ├── base2.h │ └── fe.h ├── utils.h ├── fe_25_5 │ ├── constants.h │ ├── base2.h │ └── fe.h ├── xor.c ├── pbkdf2.ml ├── ed25519_ref10.h ├── flow.mli ├── spoke.mli ├── ed25519_ref10_fe_51.h ├── spoke.ml ├── flow.ml └── ed25519_ref10_fe_25_5.h ├── CHANGES.md ├── LICENSE ├── spoke.opam └── README.md /.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.27.0 2 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (deps ../bin/simulate.exe)) 3 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | (name spoke) 3 | (cram enable) 4 | -------------------------------------------------------------------------------- /test/simulate.t: -------------------------------------------------------------------------------- 1 | Simulate communication with Spoke 2 | $ echo "Hello World!" > hello 3 | $ ../bin/simulate.exe hello 127.0.0.1:4242 hello-world 4 | -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name simulate) 3 | (libraries 4 | logs.fmt 5 | mimic 6 | rresult 7 | tcpip.stack-socket 8 | logs 9 | hxd.string 10 | hxd.core 11 | spoke 12 | flow 13 | base64)) 14 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | setup.data 3 | setup.log 4 | doc/*.html 5 | *.native 6 | *.byte 7 | *.so 8 | lib/decompress_conf.ml 9 | *.tar.gz 10 | _tests 11 | lib_test/files 12 | zpipe 13 | c/dpipe 14 | *.merlin 15 | *.install -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name spoke) 3 | (public_name spoke.core) 4 | (modules spoke pbkdf2) 5 | (foreign_stubs 6 | (language c) 7 | (flags :standard) 8 | (names utils ed25519_ref10 xor)) 9 | (libraries mirage-crypto encore digestif fmt)) 10 | 11 | (library 12 | (name flow) 13 | (public_name spoke.flow) 14 | (modules flow) 15 | (libraries base64 hxd.string hxd.core ke mirage-flow logs spoke.core)) 16 | 17 | (include_subdirs unqualified) 18 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## v0.0.4 (2025-10-03) Paris - France 2 | 3 | - Update to `mirage-crypto.1.0.0` (@dinosaure, #10) 4 | 5 | ## v0.0.3 (2024-07-12) Tokyo - Japon 6 | 7 | - Fix deprecation (@dinosaure, #5) 8 | - Update to `mirage-flow.4.0.0` and introduce `shutdown` (@dinosaure, #7) 9 | - Restrict `spoke` to not use `mirage-crypto.1.0.0` (@dinosaure, #8) 10 | 11 | ## v0.0.2 (2023-02-14) Paris - France 12 | 13 | - Update to `mirage-crypto.0.11.0` (@hannesm, #3) 14 | 15 | ## v0.0.1 (2022-09-22) Mirleft - Morocco 16 | 17 | - First release of `spoke` 18 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 Calascibetta Romain 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /lib/utils.c: -------------------------------------------------------------------------------- 1 | /* 2 | * ISC License 3 | * 4 | * Copyright (c) 2013-2022 5 | * Frank Denis 6 | * 7 | * Permission to use, copy, modify, and/or distribute this software for any 8 | * purpose with or without fee is hereby granted, provided that the above 9 | * copyright notice and this permission notice appear in all copies. 10 | * 11 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 12 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 13 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 14 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 15 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 16 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 17 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 18 | */ 19 | 20 | #include 21 | #include 22 | 23 | int 24 | is_zero(const unsigned char *n, const size_t nlen) 25 | { 26 | size_t i; 27 | volatile unsigned char d = 0U; 28 | 29 | for (i = 0U; i < nlen; i++) { 30 | d |= n[i]; 31 | } 32 | 33 | return 1 & ((d - 1) >> 8); 34 | } 35 | -------------------------------------------------------------------------------- /spoke.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "spoke" 3 | maintainer: "Romain Calascibetta " 4 | authors: "Romain Calascibetta " 5 | homepage: "https://github.com/dinosaure/spoke" 6 | bug-reports: "https://github.com/dinosaure/spoke/issues" 7 | dev-repo: "git+https://github.com/dinosaure/spoke.git" 8 | doc: "https://dinosaure.github.io/spoke/" 9 | license: "MIT" 10 | synopsis: "SPAKE+EE implementation in OCaml" 11 | description: """A Password-authenticated key agreement protocol in OCaml""" 12 | 13 | build: [ "dune" "build" "-p" name "-j" jobs ] 14 | run-test: [ "dune" "runtest" "-p" name "-j" jobs ] {os != "macos" & arch != "x86_32" & arch != "arm32"} 15 | 16 | depends: [ 17 | "ocaml" {>= "4.08.0"} 18 | "dune" {>= "2.9.0"} 19 | "fmt" 20 | "hxd" 21 | "logs" 22 | "cstruct" {>= "6.0.0"} 23 | "base64" {>= "3.0.0"} 24 | "digestif" {>= "0.8.1"} 25 | "bigstringaf" {>= "0.9.0"} 26 | "encore" {>= "0.8"} 27 | "ke" 28 | "mirage-crypto" {>= "2.0.0"} 29 | "mirage-flow" {>= "4.0.0"} 30 | "lwt" {>= "5.6.1"} 31 | "result" {>= "1.5"} 32 | "mimic" {with-test} 33 | "rresult" {with-test} 34 | "tcpip" {with-test} 35 | ] 36 | 37 | x-maintenance-intent: [ "(latest)" ] 38 | -------------------------------------------------------------------------------- /lib/pbkdf2.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2016, Alfredo Beaumont, Sonia Meruelo 3 | * All rights reserved. 4 | * 5 | * Redistribution and use in source and binary forms, with or without 6 | * modification, are permitted provided that the following conditions are met: 7 | * 8 | * * Redistributions of source code must retain the above copyright notice, this 9 | * list of conditions and the following disclaimer. 10 | * 11 | * * Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | val generate : 28 | 'hash Digestif.hash -> 29 | password:string -> 30 | salt:string -> 31 | count:int -> 32 | int32 -> 33 | string 34 | -------------------------------------------------------------------------------- /lib/fe_51/constants.h: -------------------------------------------------------------------------------- 1 | /* sqrt(-1) */ 2 | static const fe25519 fe25519_sqrtm1 = { 3 | 1718705420411056, 234908883556509, 2233514472574048, 2117202627021982, 765476049583133 4 | }; 5 | 6 | /* sqrt(-486664) */ 7 | static const fe25519 ed25519_sqrtam2 = { 8 | 1693982333959686, 608509411481997, 2235573344831311, 947681270984193, 266558006233600 9 | }; 10 | 11 | /* 37095705934669439343138083508754565189542113879843219016388785533085940283555 */ 12 | static const fe25519 ed25519_d = { 13 | 929955233495203, 466365720129213, 1662059464998953, 2033849074728123, 1442794654840575 14 | }; 15 | 16 | /* 2 * d = 17 | * 16295367250680780974490674513165176452449235426866156013048779062215315747161 18 | */ 19 | static const fe25519 ed25519_d2 = { 20 | 1859910466990425, 932731440258426, 1072319116312658, 1815898335770999, 633789495995903 21 | }; 22 | 23 | /* A = 486662 */ 24 | #define ed25519_A_32 486662 25 | static const fe25519 ed25519_A = { 26 | ed25519_A_32, 0, 0, 0, 0 27 | }; 28 | 29 | /* sqrt(ad - 1) with a = -1 (mod p) */ 30 | static const fe25519 ed25519_sqrtadm1 = { 31 | 2241493124984347, 425987919032274, 2207028919301688, 1220490630685848, 974799131293748 32 | }; 33 | 34 | /* 1 / sqrt(a - d) */ 35 | static const fe25519 ed25519_invsqrtamd = { 36 | 278908739862762, 821645201101625, 8113234426968, 1777959178193151, 2118520810568447 37 | }; 38 | 39 | /* 1 - d ^ 2 */ 40 | static const fe25519 ed25519_onemsqd = { 41 | 1136626929484150, 1998550399581263, 496427632559748, 118527312129759, 45110755273534 42 | }; 43 | 44 | /* (d - 1) ^ 2 */ 45 | static const fe25519 ed25519_sqdmone = { 46 | 1507062230895904, 1572317787530805, 683053064812840, 317374165784489, 1572899562415810 47 | }; 48 | -------------------------------------------------------------------------------- /lib/utils.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #ifndef __SPOKE_UTILS__ 5 | #define __SPOKE_UTILS__ 6 | 7 | int is_zero(const unsigned char *, const size_t nlen); 8 | 9 | #define LOAD64_LE(SRC) load64_le(SRC) 10 | static inline uint64_t 11 | load64_le(const uint8_t src[8]) 12 | { 13 | #ifdef NATIVE_LITTLE_ENDIAN 14 | uint64_t w; 15 | memcpy(&w, src, sizeof w); 16 | return w; 17 | #else 18 | uint64_t w = (uint64_t) src[0]; 19 | w |= (uint64_t) src[1] << 8; 20 | w |= (uint64_t) src[2] << 16; 21 | w |= (uint64_t) src[3] << 24; 22 | w |= (uint64_t) src[4] << 32; 23 | w |= (uint64_t) src[5] << 40; 24 | w |= (uint64_t) src[6] << 48; 25 | w |= (uint64_t) src[7] << 56; 26 | return w; 27 | #endif 28 | } 29 | 30 | #define STORE64_LE(DST, W) store64_le((DST), (W)) 31 | static inline void 32 | store64_le(uint8_t dst[8], uint64_t w) 33 | { 34 | #ifdef NATIVE_LITTLE_ENDIAN 35 | memcpy(dst, &w, sizeof w); 36 | #else 37 | dst[0] = (uint8_t) w; w >>= 8; 38 | dst[1] = (uint8_t) w; w >>= 8; 39 | dst[2] = (uint8_t) w; w >>= 8; 40 | dst[3] = (uint8_t) w; w >>= 8; 41 | dst[4] = (uint8_t) w; w >>= 8; 42 | dst[5] = (uint8_t) w; w >>= 8; 43 | dst[6] = (uint8_t) w; w >>= 8; 44 | dst[7] = (uint8_t) w; 45 | #endif 46 | } 47 | 48 | #if !defined(__clang__) && !defined(__GNUC__) 49 | # ifdef __attribute__ 50 | # undef __attribute__ 51 | # endif 52 | # define __attribute__(a) 53 | #endif 54 | 55 | #ifndef CRYPTO_ALIGN 56 | # if defined(__INTEL_COMPILER) || defined(_MSC_VER) 57 | # define CRYPTO_ALIGN(x) __declspec(align(x)) 58 | # else 59 | # define CRYPTO_ALIGN(x) __attribute__ ((aligned(x))) 60 | # endif 61 | #endif 62 | 63 | #define COMPILER_ASSERT(X) (void) sizeof(char[(X) ? 1 : -1]) 64 | 65 | #endif /* __SPOKE_UTILS__ */ 66 | -------------------------------------------------------------------------------- /lib/fe_25_5/constants.h: -------------------------------------------------------------------------------- 1 | /* sqrt(-1) */ 2 | static const fe25519 fe25519_sqrtm1 = { 3 | -32595792, -7943725, 9377950, 3500415, 12389472, -272473, -25146209, -2005654, 326686, 11406482 4 | }; 5 | 6 | /* sqrt(-486664) */ 7 | static const fe25519 ed25519_sqrtam2 = { 8 | -12222970, -8312128, -11511410, 9067497, -15300785, -241793, 25456130, 14121551, -12187136, 3972024 9 | }; 10 | 11 | /* 37095705934669439343138083508754565189542113879843219016388785533085940283555 */ 12 | static const fe25519 ed25519_d = { 13 | -10913610, 13857413, -15372611, 6949391, 114729, -8787816, -6275908, -3247719, -18696448, -12055116 14 | }; 15 | 16 | /* 2 * d = 17 | * 16295367250680780974490674513165176452449235426866156013048779062215315747161 18 | */ 19 | static const fe25519 ed25519_d2 = { 20 | -21827239, -5839606, -30745221, 13898782, 229458, 15978800, -12551817, -6495438, 29715968, 9444199 }; 21 | 22 | /* A = 486662 */ 23 | #define ed25519_A_32 486662 24 | static const fe25519 ed25519_A = { 25 | ed25519_A_32, 0, 0, 0, 0, 0, 0, 0, 0, 0 26 | }; 27 | 28 | /* sqrt(ad - 1) with a = -1 (mod p) */ 29 | static const fe25519 ed25519_sqrtadm1 = { 30 | 24849947, -153582, -23613485, 6347715, -21072328, -667138, -25271143, -15367704, -870347, 14525639 31 | }; 32 | 33 | /* 1 / sqrt(a - d) */ 34 | static const fe25519 ed25519_invsqrtamd = { 35 | 6111485, 4156064, -27798727, 12243468, -25904040, 120897, 20826367, -7060776, 6093568, -1986012 36 | }; 37 | 38 | /* 1 - d ^ 2 */ 39 | static const fe25519 ed25519_onemsqd = { 40 | 6275446, -16617371, -22938544, -3773710, 11667077, 7397348, -27922721, 1766195, -24433858, 672203 41 | }; 42 | 43 | /* (d - 1) ^ 2 */ 44 | static const fe25519 ed25519_sqdmone = { 45 | 15551795, -11097455, -13425098, -10125071, -11896535, 10178284, -26634327, 4729244, -5282110, -10116402 46 | }; 47 | -------------------------------------------------------------------------------- /lib/xor.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2014-2016 David Kaloper Meršinjak 3 | * 4 | * Permission to use, copy, modify, and/or distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | */ 16 | 17 | #include 18 | #include 19 | #include 20 | 21 | #include 22 | #include 23 | 24 | static inline void xor_into (uint8_t *src, uint8_t *dst, size_t n) { 25 | /* see issue mirage/mirage-crypto#70 mirage/mirage-crypto#81 for alignment 26 | * considerations (memcpy used below) */ 27 | #ifdef ARCH_SIXTYFOUR 28 | uint64_t s; 29 | for (; n >= 8; n -= 8, src += 8, dst += 8) 30 | *(uint64_t*) dst ^= *(uint64_t*)memcpy(&s, src, 8); 31 | #endif 32 | 33 | uint32_t t; 34 | for (; n >= 4; n -= 4, src += 4, dst += 4) 35 | *(uint32_t*) dst ^= *(uint32_t*)memcpy(&t, src, 4); 36 | 37 | for (; n --; ++ src, ++ dst) *dst = *src ^ *dst; 38 | } 39 | 40 | #define String_off(str, off) ((uint8_t*) String_val (str) + Long_val (off)) 41 | #define Bigarray_off(ba, off) ((uint8_t*) Caml_ba_data_val (ba) + Long_val (off)) 42 | 43 | CAMLprim value 44 | spoke_xor_into_generic (value src, value src_off, value dst, value dst_off, value len) { 45 | xor_into (String_off (src, src_off), String_off (dst, dst_off), Long_val (len)); 46 | return Val_unit; 47 | } 48 | 49 | CAMLprim value 50 | spoke_xor_into_generic_bigarray (value src, value src_off, value dst, value dst_off, value len) { 51 | xor_into (Bigarray_off (src, src_off), Bigarray_off (dst, dst_off), Long_val (len)); 52 | return Val_unit; 53 | } 54 | 55 | 56 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Spoke, a password-authenticated key agreement protocol in OCaml 2 | 3 | The goal of Spoke is to establish an agreement on two strong keys from a shared 4 | weak password. This implementation comes from a description of SPAKE2+EE 5 | available [here][spake2+ee]. 6 | 7 | Let's start with Bob and Alice. They share a weak password and they want to 8 | initiate a secure connection. Spoke is able to derive from this weak password 2 9 | keys that can be used to establish a secure connection using symmetric 10 | encryption (like AEAD). 11 | 12 | Spoke implements a handshake between Alice and Bob and returns the 2 keys for 13 | Alice and for Bob. It provides a [Mirage\_flow.S][mirage-flow] implementation 14 | which uses GCM, CCM or ChaCha20\_Poly1305 as a symmetric encryption mechamism 15 | between the client to the server and the server to the client (they can be 16 | different). 17 | 18 | You can simulate this handshake with the `bin/simulate.exe` program. It creates 19 | a socket and simulates a communication between Alice and Bob and finds an 20 | arrangement about 2 keys usable for symmetric encryption. Then, it sends a file 21 | to the server which repeats contents to the client. The client check the 22 | integrity of the received contents. 23 | 24 | ``` 25 | .---->----. (via GCM) 26 | [ client ] [ server ] 27 | (via ChaCha20_Poly1305) '----<----' 28 | ``` 29 | 30 | You can execute it with: 31 | 32 | ```sh 33 | $ dune exec bin/simulate.exe -- filename 127.0.0.1:9000 hello-world 34 | ``` 35 | 36 | The goal of this tool is to ensure: 37 | - that the handshake is done correctly if Bob & Alice share the same password 38 | - the transmission throught a symmetric cipher from the shared keys works 39 | 40 | A full explanation of the protocol and the handshake is available on my blog: 41 | [Spoke, how to implement a little cryptographic protocol][spoke]. Finally, you 42 | should take a look on [bob][bob] which has a real usage of Spoke. 43 | 44 | [spake2+ee]: https://moderncrypto.org/mail-archive/curves/2015/000424.html 45 | [mirage-flow]: https://github.com/mirage/mirage-flow/ 46 | [spoke]: https://blog.osau.re/articles/spoke.html 47 | [bob]: https://github.com/dinosaure/bob 48 | -------------------------------------------------------------------------------- /lib/fe_51/base2.h: -------------------------------------------------------------------------------- 1 | { 2 | { 1288382639258501, 245678601348599, 269427782077623, 1462984067271730, 137412439391563 }, 3 | { 62697248952638, 204681361388450, 631292143396476, 338455783676468, 1213667448819585 }, 4 | { 301289933810280, 1259582250014073, 1422107436869536, 796239922652654, 1953934009299142 } 5 | }, 6 | { 7 | { 1601611775252272, 1720807796594148, 1132070835939856, 1260455018889551, 2147779492816911 }, 8 | { 316559037616741, 2177824224946892, 1459442586438991, 1461528397712656, 751590696113597 }, 9 | { 1850748884277385, 1200145853858453, 1068094770532492, 672251375690438, 1586055907191707 } 10 | }, 11 | { 12 | { 769950342298419, 132954430919746, 844085933195555, 974092374476333, 726076285546016 }, 13 | { 425251763115706, 608463272472562, 442562545713235, 837766094556764, 374555092627893 }, 14 | { 1086255230780037, 274979815921559, 1960002765731872, 929474102396301, 1190409889297339 } 15 | }, 16 | { 17 | { 665000864555967, 2065379846933859, 370231110385876, 350988370788628, 1233371373142985 }, 18 | { 2019367628972465, 676711900706637, 110710997811333, 1108646842542025, 517791959672113 }, 19 | { 965130719900578, 247011430587952, 526356006571389, 91986625355052, 2157223321444601 } 20 | }, 21 | { 22 | { 1802695059465007, 1664899123557221, 593559490740857, 2160434469266659, 927570450755031 }, 23 | { 1725674970513508, 1933645953859181, 1542344539275782, 1767788773573747, 1297447965928905 }, 24 | { 1381809363726107, 1430341051343062, 2061843536018959, 1551778050872521, 2036394857967624 } 25 | }, 26 | { 27 | { 1970894096313054, 528066325833207, 1619374932191227, 2207306624415883, 1169170329061080 }, 28 | { 2070390218572616, 1458919061857835, 624171843017421, 1055332792707765, 433987520732508 }, 29 | { 893653801273833, 1168026499324677, 1242553501121234, 1306366254304474, 1086752658510815 } 30 | }, 31 | { 32 | { 213454002618221, 939771523987438, 1159882208056014, 317388369627517, 621213314200687 }, 33 | { 1971678598905747, 338026507889165, 762398079972271, 655096486107477, 42299032696322 }, 34 | { 177130678690680, 1754759263300204, 1864311296286618, 1180675631479880, 1292726903152791 } 35 | }, 36 | { 37 | { 1913163449625248, 460779200291993, 2193883288642314, 1008900146920800, 1721983679009502 }, 38 | { 1070401523076875, 1272492007800961, 1910153608563310, 2075579521696771, 1191169788841221 }, 39 | { 692896803108118, 500174642072499, 2068223309439677, 1162190621851337, 1426986007309901 } 40 | } 41 | -------------------------------------------------------------------------------- /lib/fe_25_5/base2.h: -------------------------------------------------------------------------------- 1 | { 2 | { 25967493, -14356035, 29566456, 3660896, -12694345, 4014787, 27544626, -11754271, -6079156, 2047605 }, 3 | { -12545711, 934262, -2722910, 3049990, -727428, 9406986, 12720692, 5043384, 19500929, -15469378 }, 4 | { -8738181, 4489570, 9688441, -14785194, 10184609, -12363380, 29287919, 11864899, -24514362, -4438546 } 5 | }, 6 | { 7 | { 15636291, -9688557, 24204773, -7912398, 616977, -16685262, 27787600, -14772189, 28944400, -1550024 }, 8 | { 16568933, 4717097, -11556148, -1102322, 15682896, -11807043, 16354577, -11775962, 7689662, 11199574 }, 9 | { 30464156, -5976125, -11779434, -15670865, 23220365, 15915852, 7512774, 10017326, -17749093, -9920357 } 10 | }, 11 | { 12 | { 10861363, 11473154, 27284546, 1981175, -30064349, 12577861, 32867885, 14515107, -15438304, 10819380 }, 13 | { 4708026, 6336745, 20377586, 9066809, -11272109, 6594696, -25653668, 12483688, -12668491, 5581306 }, 14 | { 19563160, 16186464, -29386857, 4097519, 10237984, -4348115, 28542350, 13850243, -23678021, -15815942 } 15 | }, 16 | { 17 | { 5153746, 9909285, 1723747, -2777874, 30523605, 5516873, 19480852, 5230134, -23952439, -15175766 }, 18 | { -30269007, -3463509, 7665486, 10083793, 28475525, 1649722, 20654025, 16520125, 30598449, 7715701 }, 19 | { 28881845, 14381568, 9657904, 3680757, -20181635, 7843316, -31400660, 1370708, 29794553, -1409300 } 20 | }, 21 | { 22 | { -22518993, -6692182, 14201702, -8745502, -23510406, 8844726, 18474211, -1361450, -13062696, 13821877 }, 23 | { -6455177, -7839871, 3374702, -4740862, -27098617, -10571707, 31655028, -7212327, 18853322, -14220951 }, 24 | { 4566830, -12963868, -28974889, -12240689, -7602672, -2830569, -8514358, -10431137, 2207753, -3209784 } 25 | }, 26 | { 27 | { -25154831, -4185821, 29681144, 7868801, -6854661, -9423865, -12437364, -663000, -31111463, -16132436 }, 28 | { 25576264, -2703214, 7349804, -11814844, 16472782, 9300885, 3844789, 15725684, 171356, 6466918 }, 29 | { 23103977, 13316479, 9739013, -16149481, 817875, -15038942, 8965339, -14088058, -30714912, 16193877 } 30 | }, 31 | { 32 | { -33521811, 3180713, -2394130, 14003687, -16903474, -16270840, 17238398, 4729455, -18074513, 9256800 }, 33 | { -25182317, -4174131, 32336398, 5036987, -21236817, 11360617, 22616405, 9761698, -19827198, 630305 }, 34 | { -13720693, 2639453, -24237460, -7406481, 9494427, -5774029, -6554551, -15960994, -2449256, -14291300 } 35 | }, 36 | { 37 | { -3151181, -5046075, 9282714, 6866145, -31907062, -863023, -18940575, 15033784, 25105118, -7894876 }, 38 | { -24326370, 15950226, -31801215, -14592823, -11662737, -5090925, 1573892, -2625887, 2198790, -15804619 }, 39 | { -3099351, 10324967, -2241613, 7453183, -5446979, -2735503, -13812022, -16236442, -32461234, -12290683 } 40 | } 41 | -------------------------------------------------------------------------------- /lib/fe_51/fe.h: -------------------------------------------------------------------------------- 1 | typedef signed __int128 int128_t; 2 | typedef unsigned __int128 uint128_t; 3 | 4 | /* 5 | Ignores top bit of s. 6 | */ 7 | 8 | void 9 | fe25519_frombytes(fe25519 h, const unsigned char *s) 10 | { 11 | const uint64_t mask = 0x7ffffffffffffULL; 12 | uint64_t h0, h1, h2, h3, h4; 13 | 14 | h0 = (LOAD64_LE(s ) ) & mask; 15 | h1 = (LOAD64_LE(s + 6) >> 3) & mask; 16 | h2 = (LOAD64_LE(s + 12) >> 6) & mask; 17 | h3 = (LOAD64_LE(s + 19) >> 1) & mask; 18 | h4 = (LOAD64_LE(s + 24) >> 12) & mask; 19 | 20 | h[0] = h0; 21 | h[1] = h1; 22 | h[2] = h2; 23 | h[3] = h3; 24 | h[4] = h4; 25 | } 26 | 27 | static void 28 | fe25519_reduce(fe25519 h, const fe25519 f) 29 | { 30 | const uint64_t mask = 0x7ffffffffffffULL; 31 | uint128_t t[5]; 32 | 33 | t[0] = f[0]; 34 | t[1] = f[1]; 35 | t[2] = f[2]; 36 | t[3] = f[3]; 37 | t[4] = f[4]; 38 | 39 | t[1] += t[0] >> 51; 40 | t[0] &= mask; 41 | t[2] += t[1] >> 51; 42 | t[1] &= mask; 43 | t[3] += t[2] >> 51; 44 | t[2] &= mask; 45 | t[4] += t[3] >> 51; 46 | t[3] &= mask; 47 | t[0] += 19 * (t[4] >> 51); 48 | t[4] &= mask; 49 | 50 | t[1] += t[0] >> 51; 51 | t[0] &= mask; 52 | t[2] += t[1] >> 51; 53 | t[1] &= mask; 54 | t[3] += t[2] >> 51; 55 | t[2] &= mask; 56 | t[4] += t[3] >> 51; 57 | t[3] &= mask; 58 | t[0] += 19 * (t[4] >> 51); 59 | t[4] &= mask; 60 | 61 | /* now t is between 0 and 2^255-1, properly carried. */ 62 | /* case 1: between 0 and 2^255-20. case 2: between 2^255-19 and 2^255-1. */ 63 | 64 | t[0] += 19ULL; 65 | 66 | t[1] += t[0] >> 51; 67 | t[0] &= mask; 68 | t[2] += t[1] >> 51; 69 | t[1] &= mask; 70 | t[3] += t[2] >> 51; 71 | t[2] &= mask; 72 | t[4] += t[3] >> 51; 73 | t[3] &= mask; 74 | t[0] += 19ULL * (t[4] >> 51); 75 | t[4] &= mask; 76 | 77 | /* now between 19 and 2^255-1 in both cases, and offset by 19. */ 78 | 79 | t[0] += 0x8000000000000 - 19ULL; 80 | t[1] += 0x8000000000000 - 1ULL; 81 | t[2] += 0x8000000000000 - 1ULL; 82 | t[3] += 0x8000000000000 - 1ULL; 83 | t[4] += 0x8000000000000 - 1ULL; 84 | 85 | /* now between 2^255 and 2^256-20, and offset by 2^255. */ 86 | 87 | t[1] += t[0] >> 51; 88 | t[0] &= mask; 89 | t[2] += t[1] >> 51; 90 | t[1] &= mask; 91 | t[3] += t[2] >> 51; 92 | t[2] &= mask; 93 | t[4] += t[3] >> 51; 94 | t[3] &= mask; 95 | t[4] &= mask; 96 | 97 | h[0] = t[0]; 98 | h[1] = t[1]; 99 | h[2] = t[2]; 100 | h[3] = t[3]; 101 | h[4] = t[4]; 102 | } 103 | 104 | void 105 | fe25519_tobytes(unsigned char *s, const fe25519 h) 106 | { 107 | fe25519 t; 108 | uint64_t t0, t1, t2, t3; 109 | 110 | fe25519_reduce(t, h); 111 | t0 = t[0] | (t[1] << 51); 112 | t1 = (t[1] >> 13) | (t[2] << 38); 113 | t2 = (t[2] >> 26) | (t[3] << 25); 114 | t3 = (t[3] >> 39) | (t[4] << 12); 115 | STORE64_LE(s + 0, t0); 116 | STORE64_LE(s + 8, t1); 117 | STORE64_LE(s + 16, t2); 118 | STORE64_LE(s + 24, t3); 119 | } 120 | -------------------------------------------------------------------------------- /lib/pbkdf2.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2016, Alfredo Beaumont, Sonia Meruelo 3 | * All rights reserved. 4 | * 5 | * Redistribution and use in source and binary forms, with or without 6 | * modification, are permitted provided that the following conditions are met: 7 | * 8 | * * Redistributions of source code must retain the above copyright notice, this 9 | * list of conditions and the following disclaimer. 10 | * 11 | * * Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 16 | * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 17 | * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 19 | * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 20 | * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 21 | * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 22 | * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 23 | * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 24 | * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | *) 26 | 27 | external xor_into : 28 | string -> src_off:int -> bytes -> dst_off:int -> len:int -> unit 29 | = "spoke_xor_into_generic" 30 | [@@noalloc] 31 | 32 | external bytes_set_int32 : bytes -> int -> int32 -> unit = "%caml_bytes_set32" 33 | external lessequal : 'a -> 'a -> bool = "%lessequal" 34 | 35 | let imin (a : int) b = 36 | let ( <= ) (x : int) y = lessequal x y in 37 | if a <= b then a else b 38 | [@@inline] 39 | 40 | let xor_into src ~src_off dst ~dst_off ~len = 41 | if len > imin (String.length src) (Bytes.length dst) then 42 | Fmt.invalid_arg "xor: buffers to small (need %d)" len 43 | else xor_into src ~src_off dst ~dst_off ~len 44 | 45 | let xor str0 str1 = 46 | let len = imin (String.length str0) (String.length str1) in 47 | let buf = Bytes.of_string (String.sub str1 0 len) in 48 | xor_into str0 ~src_off:0 buf ~dst_off:0 ~len; 49 | Bytes.unsafe_to_string buf 50 | 51 | let ( // ) x y = 52 | if y < 1 then raise Division_by_zero; 53 | if x > 0 then 1 + ((x - 1) / y) else 0 54 | [@@inline] 55 | 56 | (* XXX(dinosaure): implementation of PBKDF 2 from ocaml-pbkdf without the 57 | * mirage-crypto dependency. ocaml-pbkdf is under the BSD-2-Clause license. 58 | * 59 | * Copyright (c) 2016, Alfredo Beaumont, Sonia Meruelo 60 | * All rights reserved. *) 61 | let generate : type hash. 62 | hash Digestif.hash -> 63 | password:string -> 64 | salt:string -> 65 | count:int -> 66 | int32 -> 67 | string = 68 | fun hash ~password ~salt ~count len -> 69 | let module Hash = (val Digestif.module_of hash) in 70 | if count <= 0 then Fmt.invalid_arg "pbkdf2: count must be a positive integer"; 71 | if len <= 0l then 72 | Fmt.invalid_arg "pbkdf2: derived key length must be a positive integer"; 73 | let hash_len = Hash.digest_size in 74 | let derived_key_len = Int32.to_int len in 75 | let len = derived_key_len // hash_len in 76 | let r = derived_key_len - ((len - 1) * hash_len) in 77 | let block idx : string = 78 | let rec go u v = function 79 | | 0 -> v 80 | | j -> 81 | let u = Hash.hmac_string ~key:password u in 82 | let u = Hash.to_raw_string u in 83 | go u (xor v u) (pred j) 84 | in 85 | let trailer = 86 | let buf = Bytes.make 4 '\000' in 87 | bytes_set_int32 buf 0 (Int32.of_int idx); 88 | Bytes.unsafe_to_string buf 89 | in 90 | let u = Hash.hmac_string ~key:password (salt ^ trailer) in 91 | let u = Hash.to_raw_string u in 92 | go u u (pred count) 93 | in 94 | let rec go blocks = function 95 | | 0 -> blocks 96 | | n -> go (block n :: blocks) (pred n) 97 | in 98 | String.concat "" (go [ String.sub (block len) 0 r ] (pred len)) 99 | -------------------------------------------------------------------------------- /lib/ed25519_ref10.h: -------------------------------------------------------------------------------- 1 | /* 2 | * ISC License 3 | * 4 | * Copyright (c) 2013-2022 5 | * Frank Denis 6 | * 7 | * Permission to use, copy, modify, and/or distribute this software for any 8 | * purpose with or without fee is hereby granted, provided that the above 9 | * copyright notice and this permission notice appear in all copies. 10 | * 11 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 12 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 13 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 14 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 15 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 16 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 17 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 18 | */ 19 | 20 | #include 21 | 22 | #if (__WORDSIZE == 64) 23 | #define _64 24 | #endif 25 | 26 | #ifndef ed25519_ref10_H 27 | #define ed25519_ref10_H 28 | 29 | #include 30 | #include 31 | 32 | /* 33 | fe means field element. 34 | Here the field is \Z/(2^255-19). 35 | */ 36 | 37 | #ifdef _64 38 | typedef uint64_t fe25519[5]; 39 | #else 40 | typedef int32_t fe25519[10]; 41 | #endif 42 | 43 | void fe25519_invert(fe25519 out, const fe25519 z); 44 | void fe25519_frombytes(fe25519 h, const unsigned char *s); 45 | void fe25519_tobytes(unsigned char *s, const fe25519 h); 46 | 47 | #ifdef _64 48 | # include "ed25519_ref10_fe_51.h" 49 | #else 50 | # include "ed25519_ref10_fe_25_5.h" 51 | #endif 52 | 53 | 54 | /* 55 | ge means group element. 56 | 57 | Here the group is the set of pairs (x,y) of field elements 58 | satisfying -x^2 + y^2 = 1 + d x^2y^2 59 | where d = -121665/121666. 60 | 61 | Representations: 62 | ge25519_p2 (projective): (X:Y:Z) satisfying x=X/Z, y=Y/Z 63 | ge25519_p3 (extended): (X:Y:Z:T) satisfying x=X/Z, y=Y/Z, XY=ZT 64 | ge25519_p1p1 (completed): ((X:Z),(Y:T)) satisfying x=X/Z, y=Y/T 65 | ge25519_precomp (Duif): (y+x,y-x,2dxy) 66 | */ 67 | 68 | typedef struct { 69 | fe25519 X; 70 | fe25519 Y; 71 | fe25519 Z; 72 | } ge25519_p2; 73 | 74 | typedef struct { 75 | fe25519 X; 76 | fe25519 Y; 77 | fe25519 Z; 78 | fe25519 T; 79 | } ge25519_p3; 80 | 81 | typedef struct { 82 | fe25519 X; 83 | fe25519 Y; 84 | fe25519 Z; 85 | fe25519 T; 86 | } ge25519_p1p1; 87 | 88 | typedef struct { 89 | fe25519 yplusx; 90 | fe25519 yminusx; 91 | fe25519 xy2d; 92 | } ge25519_precomp; 93 | 94 | typedef struct { 95 | fe25519 YplusX; 96 | fe25519 YminusX; 97 | fe25519 Z; 98 | fe25519 T2d; 99 | } ge25519_cached; 100 | 101 | void ge25519_tobytes(unsigned char *s, const ge25519_p2 *h); 102 | 103 | void ge25519_p3_tobytes(unsigned char *s, const ge25519_p3 *h); 104 | 105 | int ge25519_frombytes(ge25519_p3 *h, const unsigned char *s); 106 | 107 | int ge25519_frombytes_negate_vartime(ge25519_p3 *h, const unsigned char *s); 108 | 109 | void ge25519_p3_to_cached(ge25519_cached *r, const ge25519_p3 *p); 110 | 111 | void ge25519_p1p1_to_p2(ge25519_p2 *r, const ge25519_p1p1 *p); 112 | 113 | void ge25519_p1p1_to_p3(ge25519_p3 *r, const ge25519_p1p1 *p); 114 | 115 | void ge25519_add_cached(ge25519_p1p1 *r, const ge25519_p3 *p, const ge25519_cached *q); 116 | 117 | void ge25519_sub_cached(ge25519_p1p1 *r, const ge25519_p3 *p, const ge25519_cached *q); 118 | 119 | void ge25519_scalarmult_base(ge25519_p3 *h, const unsigned char *a); 120 | 121 | void ge25519_double_scalarmult_vartime(ge25519_p2 *r, const unsigned char *a, 122 | const ge25519_p3 *A, 123 | const unsigned char *b); 124 | 125 | void ge25519_scalarmult(ge25519_p3 *h, const unsigned char *a, 126 | const ge25519_p3 *p); 127 | 128 | int ge25519_is_canonical(const unsigned char *s); 129 | 130 | int ge25519_is_on_curve(const ge25519_p3 *p); 131 | 132 | int ge25519_is_on_main_subgroup(const ge25519_p3 *p); 133 | 134 | int ge25519_has_small_order(const unsigned char s[32]); 135 | 136 | void ge25519_from_uniform(unsigned char s[32], const unsigned char r[32]); 137 | 138 | void ge25519_from_hash(unsigned char s[32], const unsigned char h[64]); 139 | 140 | /* 141 | Ristretto group 142 | */ 143 | 144 | int ristretto255_frombytes(ge25519_p3 *h, const unsigned char *s); 145 | 146 | void ristretto255_p3_tobytes(unsigned char *s, const ge25519_p3 *h); 147 | 148 | void ristretto255_from_hash(unsigned char s[32], const unsigned char h[64]); 149 | 150 | /* 151 | The set of scalars is \Z/l 152 | where l = 2^252 + 27742317777372353535851937790883648493. 153 | */ 154 | 155 | void sc25519_invert(unsigned char recip[32], const unsigned char s[32]); 156 | 157 | void sc25519_reduce(unsigned char s[64]); 158 | 159 | void sc25519_mul(unsigned char s[32], const unsigned char a[32], 160 | const unsigned char b[32]); 161 | 162 | void sc25519_muladd(unsigned char s[32], const unsigned char a[32], 163 | const unsigned char b[32], const unsigned char c[32]); 164 | 165 | int sc25519_is_canonical(const unsigned char s[32]); 166 | 167 | #endif 168 | -------------------------------------------------------------------------------- /lib/flow.mli: -------------------------------------------------------------------------------- 1 | (** {1: The {i Flow} implementation of SPAKE2+EE.} 2 | 3 | This module provides a concrete implementation of the {i handshake} on the 4 | client side and the server side which is agnostic to any protocols. These 5 | implementations emits a {!type:t} which supervises the user knows that 6 | when to read ([Rd]) and when to write ([Wr]). 7 | 8 | From these implementations, the module provides a [Mirage_flow.S] 9 | implementation which requires a [Mirage_flow.S] implementation as the 10 | underlying implementation to read/write through a {i network}. 11 | 12 | {2: The agnostic implementation of the {i handshake}.} 13 | 14 | As a server, for instance, you have 2 available {i syscalls}, one to 15 | read [read : fd -> bytes -> int -> int -> int] and one to write 16 | [write : fd -> string -> unit]. You receive a connection and you have an 17 | [fd]. You are able to compute the handshake: 18 | 19 | {[ 20 | let cfg = Flow.Cfg (Spoke.Pbkdf2, 16) 21 | let identities = "Bob", "Alice" 22 | let password = "Your Password" 23 | 24 | let handle_client fd = 25 | let ctx = Flow.ctx () in 26 | let rec go = function 27 | | Rd { buf; off; len; k; } -> 28 | ( match read fd buf off len with 29 | | 0 -> go (k `End) 30 | | len -> go (k (`Len len)) ) 31 | | Wr { str; off; len; k; } -> 32 | let str = String.sub str off len in 33 | write fd str ; go (k len) 34 | | Done (ciphers, sk) -> Ok (ciphers, sk) 35 | | Fail err -> Error err in 36 | go (Flow.handshake_server ctx ~password ~identity:identities cfg) 37 | ]} 38 | 39 | A {!type:ctx} is required to keep incoming/outcoming data along the 40 | computation of {!type:t}. 41 | 42 | {2: A [Mirage_flow.S] which handles ciphers.} 43 | 44 | Obviously, we can go further than just complete the handshake. We can 45 | finally start a communication with our peer through a symmetric cipher. The 46 | {i functor} {!module:Make} gives you the ability to upgrade a given flow 47 | implementation to a secured transmission protocol through a symmetric 48 | cipher from a shared weak password. The example below is about a server 49 | which handles client connections and it wants to upgrade them through 50 | symmetric ciphers to finally send a secured ["Hello World"]. 51 | 52 | {[ 53 | module SPOKEFlow = Flow.Make (Tcpip) 54 | 55 | let cfg = Flow.Cfg (Spoke.Pbkdf2, 16) 56 | let identities = "Bob", "Alice" 57 | let password = "Your Password" 58 | 59 | let handle_client_with_with_secured_connection 60 | : SPOKEFlow.flow -> unit Lwt.t 61 | = fun flow -> 62 | SPOKEFlow.write flow "Secured Hello World!" >>= fun () -> 63 | ... 64 | 65 | let handle_client (fd : Tcpip.flow) = 66 | SPOKEFlow.server_of_flow ~cfg ~password ~identity:identities 67 | >>= function 68 | | Ok flow -> handle_client_with_secured_connection flow 69 | | Error err -> ... 70 | ]} 71 | *) 72 | 73 | type ctx 74 | (** Type of a context. *) 75 | 76 | val ctx : unit -> ctx 77 | (** [ctx ()] creates a fresh {!type:ctx}. *) 78 | 79 | val remaining_bytes_of_ctx : ctx -> string option 80 | (** [remaining_bytes_of_ctx ctx] returns bytes which are not consumed by the 81 | handshake but they are already consumed by the [read] {i syscall}. In other 82 | words, at the end of the handshake, you may read more than you needed to and 83 | this function allows you to recover the excess. *) 84 | 85 | type error = [ `Not_enough_space | `End_of_input | `Spoke of Spoke.error ] 86 | (** The type of errors. *) 87 | 88 | val pp_error : error Fmt.t 89 | (** The pretty-printer of {!type:error}. *) 90 | 91 | (** The type of actions needed to compute the handshake. *) 92 | type 'a t = 93 | | Rd of { buf : bytes; off : int; len : int; k : 'a krd } 94 | | Wr of { str : string; off : int; len : int; k : 'a kwr } 95 | | Done of 'a 96 | | Fail of error 97 | 98 | and 'a krd = [ `End | `Len of int ] -> 'a t 99 | and 'a kwr = int -> 'a t 100 | 101 | (** The type of configurations. *) 102 | type cfg = Cfg : 'a Spoke.algorithm * 'a -> cfg 103 | 104 | val handshake_client : 105 | ctx -> 106 | ?g:Random.State.t -> 107 | identity:string * string -> 108 | string -> 109 | ((Spoke.cipher * Spoke.cipher) * Spoke.shared_keys) t 110 | (** [handshake_client ctx ~identity password] returns a {!type:t} which leads 111 | users when they need to read or write. If the handshake succeed, we return 112 | {!type:Spoke.cipher}s and {!type:Spoke.shared_keys}. Otherwise, we return an 113 | error. *) 114 | 115 | val handshake_server : 116 | ctx -> 117 | ?g:Random.State.t -> 118 | password:string -> 119 | identity:string * string -> 120 | cfg -> 121 | ((Spoke.cipher * Spoke.cipher) * Spoke.shared_keys) t 122 | (** [handshake_server ctx ~password ~identity cfg] returns a {!type:t} which 123 | leads users when they need to read or write. If the handshake succeed, we 124 | return {!type:Spoke.cipher}s and {!type:Spoke.shared_keys}. Otherwise, we 125 | return an error. *) 126 | 127 | module Make (Flow : Mirage_flow.S) : sig 128 | type write_error = 129 | [ `Closed | `Flow of Flow.error | `Flow_write of Flow.write_error | error ] 130 | 131 | type error = [ `Flow of Flow.error | `Corrupted ] 132 | 133 | include 134 | Mirage_flow.S with type error := error and type write_error := write_error 135 | 136 | val client_of_flow : 137 | ?g:Random.State.t -> 138 | identity:string * string -> 139 | password:string -> 140 | Flow.flow -> 141 | (flow, [> write_error ]) result Lwt.t 142 | 143 | val server_of_flow : 144 | ?g:Random.State.t -> 145 | cfg:cfg -> 146 | identity:string * string -> 147 | password:string -> 148 | Flow.flow -> 149 | (flow, [> write_error ]) result Lwt.t 150 | end 151 | -------------------------------------------------------------------------------- /lib/fe_25_5/fe.h: -------------------------------------------------------------------------------- 1 | /* 2 | Ignores top bit of s. 3 | */ 4 | 5 | void 6 | fe25519_frombytes(fe25519 h, const unsigned char *s) 7 | { 8 | int64_t h0 = load_4(s); 9 | int64_t h1 = load_3(s + 4) << 6; 10 | int64_t h2 = load_3(s + 7) << 5; 11 | int64_t h3 = load_3(s + 10) << 3; 12 | int64_t h4 = load_3(s + 13) << 2; 13 | int64_t h5 = load_4(s + 16); 14 | int64_t h6 = load_3(s + 20) << 7; 15 | int64_t h7 = load_3(s + 23) << 5; 16 | int64_t h8 = load_3(s + 26) << 4; 17 | int64_t h9 = (load_3(s + 29) & 8388607) << 2; 18 | 19 | int64_t carry0; 20 | int64_t carry1; 21 | int64_t carry2; 22 | int64_t carry3; 23 | int64_t carry4; 24 | int64_t carry5; 25 | int64_t carry6; 26 | int64_t carry7; 27 | int64_t carry8; 28 | int64_t carry9; 29 | 30 | carry9 = (h9 + (int64_t)(1L << 24)) >> 25; 31 | h0 += carry9 * 19; 32 | h9 -= carry9 * ((uint64_t) 1L << 25); 33 | carry1 = (h1 + (int64_t)(1L << 24)) >> 25; 34 | h2 += carry1; 35 | h1 -= carry1 * ((uint64_t) 1L << 25); 36 | carry3 = (h3 + (int64_t)(1L << 24)) >> 25; 37 | h4 += carry3; 38 | h3 -= carry3 * ((uint64_t) 1L << 25); 39 | carry5 = (h5 + (int64_t)(1L << 24)) >> 25; 40 | h6 += carry5; 41 | h5 -= carry5 * ((uint64_t) 1L << 25); 42 | carry7 = (h7 + (int64_t)(1L << 24)) >> 25; 43 | h8 += carry7; 44 | h7 -= carry7 * ((uint64_t) 1L << 25); 45 | 46 | carry0 = (h0 + (int64_t)(1L << 25)) >> 26; 47 | h1 += carry0; 48 | h0 -= carry0 * ((uint64_t) 1L << 26); 49 | carry2 = (h2 + (int64_t)(1L << 25)) >> 26; 50 | h3 += carry2; 51 | h2 -= carry2 * ((uint64_t) 1L << 26); 52 | carry4 = (h4 + (int64_t)(1L << 25)) >> 26; 53 | h5 += carry4; 54 | h4 -= carry4 * ((uint64_t) 1L << 26); 55 | carry6 = (h6 + (int64_t)(1L << 25)) >> 26; 56 | h7 += carry6; 57 | h6 -= carry6 * ((uint64_t) 1L << 26); 58 | carry8 = (h8 + (int64_t)(1L << 25)) >> 26; 59 | h9 += carry8; 60 | h8 -= carry8 * ((uint64_t) 1L << 26); 61 | 62 | h[0] = (int32_t) h0; 63 | h[1] = (int32_t) h1; 64 | h[2] = (int32_t) h2; 65 | h[3] = (int32_t) h3; 66 | h[4] = (int32_t) h4; 67 | h[5] = (int32_t) h5; 68 | h[6] = (int32_t) h6; 69 | h[7] = (int32_t) h7; 70 | h[8] = (int32_t) h8; 71 | h[9] = (int32_t) h9; 72 | } 73 | 74 | /* 75 | Preconditions: 76 | |h| bounded by 1.1*2^26,1.1*2^25,1.1*2^26,1.1*2^25,etc. 77 | 78 | Write p=2^255-19; q=floor(h/p). 79 | Basic claim: q = floor(2^(-255)(h + 19 2^(-25)h9 + 2^(-1))). 80 | 81 | Proof: 82 | Have |h|<=p so |q|<=1 so |19^2 2^(-255) q|<1/4. 83 | Also have |h-2^230 h9|<2^231 so |19 2^(-255)(h-2^230 h9)|<1/4. 84 | 85 | Write y=2^(-1)-19^2 2^(-255)q-19 2^(-255)(h-2^230 h9). 86 | Then 0> 25; 117 | q = (h0 + q) >> 26; 118 | q = (h1 + q) >> 25; 119 | q = (h2 + q) >> 26; 120 | q = (h3 + q) >> 25; 121 | q = (h4 + q) >> 26; 122 | q = (h5 + q) >> 25; 123 | q = (h6 + q) >> 26; 124 | q = (h7 + q) >> 25; 125 | q = (h8 + q) >> 26; 126 | q = (h9 + q) >> 25; 127 | 128 | /* Goal: Output h-(2^255-19)q, which is between 0 and 2^255-20. */ 129 | h0 += 19 * q; 130 | /* Goal: Output h-2^255 q, which is between 0 and 2^255-20. */ 131 | 132 | carry0 = h0 >> 26; 133 | h1 += carry0; 134 | h0 -= carry0 * ((uint32_t) 1L << 26); 135 | carry1 = h1 >> 25; 136 | h2 += carry1; 137 | h1 -= carry1 * ((uint32_t) 1L << 25); 138 | carry2 = h2 >> 26; 139 | h3 += carry2; 140 | h2 -= carry2 * ((uint32_t) 1L << 26); 141 | carry3 = h3 >> 25; 142 | h4 += carry3; 143 | h3 -= carry3 * ((uint32_t) 1L << 25); 144 | carry4 = h4 >> 26; 145 | h5 += carry4; 146 | h4 -= carry4 * ((uint32_t) 1L << 26); 147 | carry5 = h5 >> 25; 148 | h6 += carry5; 149 | h5 -= carry5 * ((uint32_t) 1L << 25); 150 | carry6 = h6 >> 26; 151 | h7 += carry6; 152 | h6 -= carry6 * ((uint32_t) 1L << 26); 153 | carry7 = h7 >> 25; 154 | h8 += carry7; 155 | h7 -= carry7 * ((uint32_t) 1L << 25); 156 | carry8 = h8 >> 26; 157 | h9 += carry8; 158 | h8 -= carry8 * ((uint32_t) 1L << 26); 159 | carry9 = h9 >> 25; 160 | h9 -= carry9 * ((uint32_t) 1L << 25); 161 | 162 | h[0] = h0; 163 | h[1] = h1; 164 | h[2] = h2; 165 | h[3] = h3; 166 | h[4] = h4; 167 | h[5] = h5; 168 | h[6] = h6; 169 | h[7] = h7; 170 | h[8] = h8; 171 | h[9] = h9; 172 | } 173 | 174 | /* 175 | Goal: Output h0+...+2^255 h10-2^255 q, which is between 0 and 2^255-20. 176 | Have h0+...+2^230 h9 between 0 and 2^255-1; 177 | evidently 2^255 h10-2^255 q = 0. 178 | 179 | Goal: Output h0+...+2^230 h9. 180 | */ 181 | 182 | void 183 | fe25519_tobytes(unsigned char *s, const fe25519 h) 184 | { 185 | fe25519 t; 186 | 187 | fe25519_reduce(t, h); 188 | s[0] = t[0] >> 0; 189 | s[1] = t[0] >> 8; 190 | s[2] = t[0] >> 16; 191 | s[3] = (t[0] >> 24) | (t[1] * ((uint32_t) 1 << 2)); 192 | s[4] = t[1] >> 6; 193 | s[5] = t[1] >> 14; 194 | s[6] = (t[1] >> 22) | (t[2] * ((uint32_t) 1 << 3)); 195 | s[7] = t[2] >> 5; 196 | s[8] = t[2] >> 13; 197 | s[9] = (t[2] >> 21) | (t[3] * ((uint32_t) 1 << 5)); 198 | s[10] = t[3] >> 3; 199 | s[11] = t[3] >> 11; 200 | s[12] = (t[3] >> 19) | (t[4] * ((uint32_t) 1 << 6)); 201 | s[13] = t[4] >> 2; 202 | s[14] = t[4] >> 10; 203 | s[15] = t[4] >> 18; 204 | s[16] = t[5] >> 0; 205 | s[17] = t[5] >> 8; 206 | s[18] = t[5] >> 16; 207 | s[19] = (t[5] >> 24) | (t[6] * ((uint32_t) 1 << 1)); 208 | s[20] = t[6] >> 7; 209 | s[21] = t[6] >> 15; 210 | s[22] = (t[6] >> 23) | (t[7] * ((uint32_t) 1 << 3)); 211 | s[23] = t[7] >> 5; 212 | s[24] = t[7] >> 13; 213 | s[25] = (t[7] >> 21) | (t[8] * ((uint32_t) 1 << 4)); 214 | s[26] = t[8] >> 4; 215 | s[27] = t[8] >> 12; 216 | s[28] = (t[8] >> 20) | (t[9] * ((uint32_t) 1 << 6)); 217 | s[29] = t[9] >> 2; 218 | s[30] = t[9] >> 10; 219 | s[31] = t[9] >> 18; 220 | } 221 | -------------------------------------------------------------------------------- /lib/spoke.mli: -------------------------------------------------------------------------------- 1 | (** {1: Spoke, an implementation of SPAKE2+EE in OCaml.} 2 | 3 | Spoke is an implementation of SPAKE2+EE, a Password-Authenticated Key 4 | Agreement. It permits to find an agreement between two people who share a 5 | weak password with a strong key via an exchange of few information. From 6 | the shared strong key, 2 people can initiate a communication via, for 7 | example, a symmetric cryptographic method such as GCM or ChaCha20 Poly1305. 8 | 9 | This module wants to implement the necessary cryptographic primitives for 10 | this agreement. 11 | 12 | {2: The Handshake.} 13 | 14 | We identify 2 persons, a [server] and a [client]. The server will generate 15 | some values and a {i salt} and send it to the client with {!val:generate}. 16 | 2 values are then generated, {!type:secret} and {!type:public}. The first 17 | must be strictly known only by the server. The second must be transferred 18 | to the client. 19 | 20 | The client can manipulate [public] with {!val:hello} and generate a value 21 | to be passed to the server. The value is named [X]. {!val:hello} returns 22 | a {!type:client} value which must be kept by the client. 23 | 24 | The server can then manipulate this received value with 25 | {!val:server_compute} to produce 2 values (which can be concatenated) to 26 | send to the client. These values are: [Y] and [client_validator]. The first 27 | participates to the handshake, the second checks the shared key on the 28 | client side. {!val:server_compute} returns a {!type:server} which must be 29 | kept by the server and used later. 30 | 31 | The client can finalise the agreement with {!val:client_compute} by finally 32 | calculating the {type:shared_keys}. It requires the [Y] value and the 33 | [client_validator] value as well as the {!type:client} value returned 34 | previously. It will then send a final value to ensure that the server can 35 | correctly produce the said shared key. The name of this value is the 36 | [server_validator]. 37 | 38 | Finally, the server can commit the agreement by checking the value 39 | transmitted by the client as well as the {!type:server} value generated 40 | previously and in turn generating the shared key. 41 | 42 | {2: Parameters.} 43 | 44 | The user is able to choose: 45 | - the [KDF] function used to generate values (see {!type:algorithm}) 46 | - an argument which will be used by the chosen algorithm 47 | - {!type:cipher}s which will be used by the client and the server 48 | - tha {!type:hash} algorithm used to craft internal values 49 | 50 | {2: Order of primities.} 51 | 52 | Following the handshake explanation above, here is an example of the order 53 | in which the primitives should be executed: 54 | {[ 55 | let run ~password = 56 | let secret, public = Spoke.generate ~password ~algorithm:Pbkdf2 16 in 57 | let+ client, _X = Spoke.hello ~public password in 58 | let+ server, (_Y, client_validator) = Spoke.server_compute ~secret 59 | ~identity:("Bob", "Alice") _X in 60 | let+ sk0, server_validator = Spoke.client_compute ~client 61 | ~identity:("Bob", "Alice") _Y client_validator in 62 | let+ sk1 = Spoke.server_finalize ~server server_validator in 63 | assert (sk0 = sk1) 64 | ]} 65 | *) 66 | 67 | type client 68 | (** The type of a client. *) 69 | 70 | type server 71 | (** The type of a server. *) 72 | 73 | type hash = Hash : 'k Digestif.hash -> hash (** The hash algorithm. *) 74 | 75 | (** The [KDF] (Key Derivation Function) used to generate common informations 76 | between client & server. *) 77 | type 'a algorithm = Pbkdf2 : int algorithm 78 | 79 | (** The type of Authenticated Encryptions with Associated Data. *) 80 | type _ aead = 81 | | GCM : Mirage_crypto.AES.GCM.key aead 82 | | CCM16 : Mirage_crypto.AES.CCM16.key aead 83 | | ChaCha20_Poly1305 : Mirage_crypto.Chacha20.key aead 84 | 85 | (** The type of ciphers. *) 86 | type cipher = AEAD : 'k aead -> cipher 87 | 88 | type public 89 | (** The type of the public part of the handshake. *) 90 | 91 | type secret 92 | (** The type of the secret part of the handshake. *) 93 | 94 | type shared_keys = string * string 95 | (** The type of shared keys. *) 96 | 97 | type error = 98 | [ `Point_is_not_on_prime_order_subgroup 99 | | `Invalid_client_validator 100 | | `Invalid_server_validator 101 | | `Invalid_public_packet 102 | | `Invalid_secret_packet ] 103 | (** The type of errors. *) 104 | 105 | val pp_error : error Fmt.t 106 | (** The pretty-printer of {!type:error}. *) 107 | 108 | val version : int 109 | (** The version of the handshake. *) 110 | 111 | val generate : 112 | ?hash:hash -> 113 | ?ciphers:cipher * cipher -> 114 | ?g:Random.State.t -> 115 | password:string -> 116 | algorithm:'a algorithm -> 117 | 'a -> 118 | secret * public 119 | (** [generate ?hash ?ciphers ?g ~password ~algorithm v] generates the 120 | {!type:public} and the {!type:secret} informations used to handle the 121 | handshake for a server. *) 122 | 123 | val public_to_string : public -> string 124 | (** [public_to_string public] serializes the {!type:public} information into 125 | bytes. Therefore, the public information can be transmitted to a client 126 | throught a (secured?) channel. *) 127 | 128 | val public_of_string : string -> (public, [> error ]) result 129 | (** [public_of_string str] tries to deserialize a serie of bytes to a public 130 | information. *) 131 | 132 | val ciphers_of_public : string -> (cipher * cipher, [> error ]) result 133 | (** [ciphers_of_public str] returns ciphers announced by the {!type:public} 134 | information serialized. *) 135 | 136 | val ciphers_of_client : client -> cipher * cipher 137 | (** [ciphers_of_client client] returns ciphers from a {!type:client} value. *) 138 | 139 | val ciphers_of_secret : secret -> cipher * cipher 140 | (** [ciphers_of_secret secret] returns ciphers from a {!type:secret} value. 141 | 142 | @raise [Invalid_argument] if the [secret] value is malformed. *) 143 | 144 | val public_of_secret : secret -> public 145 | (** [public_of_secret secret] regenerates {!type:public} from {!type:secret}. *) 146 | 147 | val hello : 148 | ?g:Random.State.t -> 149 | public:string -> 150 | string -> 151 | (client * string, [> error ]) result 152 | (** [hello ?g ~public password] tries to create a {!type:client} information 153 | from a serialized {!type:public} one and a [password]. It generates a curve 154 | point which should be transmitted to the server. *) 155 | 156 | val server_compute : 157 | ?g:Random.State.t -> 158 | secret:secret -> 159 | identity:string * string -> 160 | string -> 161 | (server * (string * string), [> error ]) result 162 | (** [server_compute ?g ~secret ~identity:(client, server) _X] tries to validate 163 | [_X] with the given {!type:secret} information and identities. It returns a 164 | {!type:server} information if it succeed as well as a curve point [_Y] and a 165 | {i client validator}. [_Y] and [client_validator] should be transmitted to 166 | the client. 167 | 168 | {b NOTE}: identities is something known to both parties. The client must 169 | recognise the server with a unique identifier (like ["Bob"]) and the server 170 | must recognise the client with a unique identifier (like ["Alice"]). But 171 | more concretely, the identifier can be the IP address as well as the port of 172 | each of the two peers. *) 173 | 174 | val client_compute : 175 | client:client -> 176 | identity:string * string -> 177 | string -> 178 | string -> 179 | (shared_keys * string, [> error ]) result 180 | (** [client_compute ~client ~identity:(client, server) _Y client_validator] 181 | tries to validate [_Y] and the [client_validator] with the given 182 | {!type:client} information and identities (for more details, about 183 | identities, you can look at the note for {!val:server_compute}). It returns 184 | {!type:shared_keys} and the server validator if it succeed. The 185 | [server_validator] should be transmitted to the server. *) 186 | 187 | val server_finalize : 188 | server:server -> string -> (shared_keys, [> error ]) result 189 | (** [server_finalize ~server server_validator] finalizes the handshake and tries 190 | to validate the given [server_validator] with the given {!type:server} 191 | information. If it succeed, it returns the {!type:shared_keys}. Then, the 192 | user is able to initiate a secure communication with the given client. *) 193 | -------------------------------------------------------------------------------- /lib/ed25519_ref10_fe_51.h: -------------------------------------------------------------------------------- 1 | /* 2 | * ISC License 3 | * 4 | * Copyright (c) 2013-2022 5 | * Frank Denis 6 | * 7 | * Permission to use, copy, modify, and/or distribute this software for any 8 | * purpose with or without fee is hereby granted, provided that the above 9 | * copyright notice and this permission notice appear in all copies. 10 | * 11 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 12 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 13 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 14 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 15 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 16 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 17 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 18 | */ 19 | 20 | #include 21 | #include "utils.h" 22 | 23 | typedef signed __int128 int128_t; 24 | typedef unsigned __int128 uint128_t; 25 | 26 | /* 27 | h = 0 28 | */ 29 | 30 | static inline void 31 | fe25519_0(fe25519 h) 32 | { 33 | memset(&h[0], 0, 5 * sizeof h[0]); 34 | } 35 | 36 | /* 37 | h = 1 38 | */ 39 | 40 | static inline void 41 | fe25519_1(fe25519 h) 42 | { 43 | h[0] = 1; 44 | memset(&h[1], 0, 4 * sizeof h[0]); 45 | } 46 | 47 | /* 48 | h = f + g 49 | Can overlap h with f or g. 50 | */ 51 | 52 | static inline void 53 | fe25519_add(fe25519 h, const fe25519 f, const fe25519 g) 54 | { 55 | uint64_t h0 = f[0] + g[0]; 56 | uint64_t h1 = f[1] + g[1]; 57 | uint64_t h2 = f[2] + g[2]; 58 | uint64_t h3 = f[3] + g[3]; 59 | uint64_t h4 = f[4] + g[4]; 60 | 61 | h[0] = h0; 62 | h[1] = h1; 63 | h[2] = h2; 64 | h[3] = h3; 65 | h[4] = h4; 66 | } 67 | 68 | /* 69 | h = f - g 70 | */ 71 | 72 | static void 73 | fe25519_sub(fe25519 h, const fe25519 f, const fe25519 g) 74 | { 75 | const uint64_t mask = 0x7ffffffffffffULL; 76 | uint64_t h0, h1, h2, h3, h4; 77 | 78 | h0 = g[0]; 79 | h1 = g[1]; 80 | h2 = g[2]; 81 | h3 = g[3]; 82 | h4 = g[4]; 83 | 84 | h1 += h0 >> 51; 85 | h0 &= mask; 86 | h2 += h1 >> 51; 87 | h1 &= mask; 88 | h3 += h2 >> 51; 89 | h2 &= mask; 90 | h4 += h3 >> 51; 91 | h3 &= mask; 92 | h0 += 19ULL * (h4 >> 51); 93 | h4 &= mask; 94 | 95 | h0 = (f[0] + 0xfffffffffffdaULL) - h0; 96 | h1 = (f[1] + 0xffffffffffffeULL) - h1; 97 | h2 = (f[2] + 0xffffffffffffeULL) - h2; 98 | h3 = (f[3] + 0xffffffffffffeULL) - h3; 99 | h4 = (f[4] + 0xffffffffffffeULL) - h4; 100 | 101 | h[0] = h0; 102 | h[1] = h1; 103 | h[2] = h2; 104 | h[3] = h3; 105 | h[4] = h4; 106 | } 107 | 108 | /* 109 | h = -f 110 | */ 111 | 112 | static inline void 113 | fe25519_neg(fe25519 h, const fe25519 f) 114 | { 115 | fe25519 zero; 116 | 117 | fe25519_0(zero); 118 | fe25519_sub(h, zero, f); 119 | } 120 | 121 | /* 122 | Replace (f,g) with (g,g) if b == 1; 123 | replace (f,g) with (f,g) if b == 0. 124 | * 125 | Preconditions: b in {0,1}. 126 | */ 127 | 128 | static void 129 | fe25519_cmov(fe25519 f, const fe25519 g, unsigned int b) 130 | { 131 | #ifdef HAVE_AMD64_ASM 132 | uint64_t t0, t1, t2; 133 | 134 | __asm__ __volatile__ 135 | ( 136 | "test %[c], %[c]\n" 137 | "movq (%[b]), %[t0]\n" 138 | "cmoveq (%[a]), %[t0]\n" 139 | "movq 8(%[b]), %[t1]\n" 140 | "cmoveq 8(%[a]), %[t1]\n" 141 | "movq 16(%[b]), %[t2]\n" 142 | "cmoveq 16(%[a]), %[t2]\n" 143 | "movq %[t0], (%[a])\n" 144 | "movq %[t1], 8(%[a])\n" 145 | "movq 24(%[b]), %[t0]\n" 146 | "cmoveq 24(%[a]), %[t0]\n" 147 | "movq 32(%[b]), %[t1]\n" 148 | "cmoveq 32(%[a]), %[t1]\n" 149 | "movq %[t2], 16(%[a])\n" 150 | "movq %[t0], 24(%[a])\n" 151 | "movq %[t1], 32(%[a])\n" 152 | : [ t0 ] "=&r"(t0), [ t1 ] "=&r"(t1), [ t2 ] "=&r"(t2) 153 | : [ a ] "r"(f), [ b ] "r"(g), [ c ] "r"(b) 154 | : "cc", "memory"); 155 | #else 156 | uint64_t mask = (uint64_t) (-(int64_t) b); 157 | uint64_t f0, f1, f2, f3, f4; 158 | uint64_t x0, x1, x2, x3, x4; 159 | 160 | f0 = f[0]; 161 | f1 = f[1]; 162 | f2 = f[2]; 163 | f3 = f[3]; 164 | f4 = f[4]; 165 | 166 | x0 = f0 ^ g[0]; 167 | x1 = f1 ^ g[1]; 168 | x2 = f2 ^ g[2]; 169 | x3 = f3 ^ g[3]; 170 | x4 = f4 ^ g[4]; 171 | 172 | # ifdef HAVE_INLINE_ASM 173 | __asm__ __volatile__("" : "+r"(mask)); 174 | # endif 175 | 176 | x0 &= mask; 177 | x1 &= mask; 178 | x2 &= mask; 179 | x3 &= mask; 180 | x4 &= mask; 181 | 182 | f[0] = f0 ^ x0; 183 | f[1] = f1 ^ x1; 184 | f[2] = f2 ^ x2; 185 | f[3] = f3 ^ x3; 186 | f[4] = f4 ^ x4; 187 | #endif 188 | } 189 | 190 | /* 191 | Replace (f,g) with (g,f) if b == 1; 192 | replace (f,g) with (f,g) if b == 0. 193 | 194 | Preconditions: b in {0,1}. 195 | */ 196 | 197 | static void 198 | fe25519_cswap(fe25519 f, fe25519 g, unsigned int b) 199 | { 200 | uint64_t mask = (uint64_t) (-(int64_t) b); 201 | uint64_t f0, f1, f2, f3, f4; 202 | uint64_t g0, g1, g2, g3, g4; 203 | uint64_t x0, x1, x2, x3, x4; 204 | 205 | f0 = f[0]; 206 | f1 = f[1]; 207 | f2 = f[2]; 208 | f3 = f[3]; 209 | f4 = f[4]; 210 | 211 | g0 = g[0]; 212 | g1 = g[1]; 213 | g2 = g[2]; 214 | g3 = g[3]; 215 | g4 = g[4]; 216 | 217 | x0 = f0 ^ g0; 218 | x1 = f1 ^ g1; 219 | x2 = f2 ^ g2; 220 | x3 = f3 ^ g3; 221 | x4 = f4 ^ g4; 222 | 223 | # ifdef HAVE_INLINE_ASM 224 | __asm__ __volatile__("" : "+r"(mask)); 225 | # endif 226 | 227 | x0 &= mask; 228 | x1 &= mask; 229 | x2 &= mask; 230 | x3 &= mask; 231 | x4 &= mask; 232 | 233 | f[0] = f0 ^ x0; 234 | f[1] = f1 ^ x1; 235 | f[2] = f2 ^ x2; 236 | f[3] = f3 ^ x3; 237 | f[4] = f4 ^ x4; 238 | 239 | g[0] = g0 ^ x0; 240 | g[1] = g1 ^ x1; 241 | g[2] = g2 ^ x2; 242 | g[3] = g3 ^ x3; 243 | g[4] = g4 ^ x4; 244 | } 245 | 246 | /* 247 | h = f 248 | */ 249 | 250 | static inline void 251 | fe25519_copy(fe25519 h, const fe25519 f) 252 | { 253 | memcpy(h, f, 5 * 8); 254 | } 255 | 256 | /* 257 | return 1 if f is in {1,3,5,...,q-2} 258 | return 0 if f is in {0,2,4,...,q-1} 259 | */ 260 | 261 | static inline int 262 | fe25519_isnegative(const fe25519 f) 263 | { 264 | unsigned char s[32]; 265 | 266 | fe25519_tobytes(s, f); 267 | 268 | return s[0] & 1; 269 | } 270 | 271 | /* 272 | return 1 if f == 0 273 | return 0 if f != 0 274 | */ 275 | 276 | static inline int 277 | fe25519_iszero(const fe25519 f) 278 | { 279 | unsigned char s[32]; 280 | 281 | fe25519_tobytes(s, f); 282 | 283 | return is_zero(s, 32); 284 | } 285 | 286 | /* 287 | h = f * g 288 | Can overlap h with f or g. 289 | */ 290 | 291 | static void 292 | fe25519_mul(fe25519 h, const fe25519 f, const fe25519 g) 293 | { 294 | const uint64_t mask = 0x7ffffffffffffULL; 295 | uint128_t r0, r1, r2, r3, r4; 296 | uint128_t f0, f1, f2, f3, f4; 297 | uint128_t f1_19, f2_19, f3_19, f4_19; 298 | uint128_t g0, g1, g2, g3, g4; 299 | uint64_t r00, r01, r02, r03, r04; 300 | uint64_t carry; 301 | 302 | f0 = (uint128_t) f[0]; 303 | f1 = (uint128_t) f[1]; 304 | f2 = (uint128_t) f[2]; 305 | f3 = (uint128_t) f[3]; 306 | f4 = (uint128_t) f[4]; 307 | 308 | g0 = (uint128_t) g[0]; 309 | g1 = (uint128_t) g[1]; 310 | g2 = (uint128_t) g[2]; 311 | g3 = (uint128_t) g[3]; 312 | g4 = (uint128_t) g[4]; 313 | 314 | f1_19 = 19ULL * f1; 315 | f2_19 = 19ULL * f2; 316 | f3_19 = 19ULL * f3; 317 | f4_19 = 19ULL * f4; 318 | 319 | r0 = f0 * g0 + f1_19 * g4 + f2_19 * g3 + f3_19 * g2 + f4_19 * g1; 320 | r1 = f0 * g1 + f1 * g0 + f2_19 * g4 + f3_19 * g3 + f4_19 * g2; 321 | r2 = f0 * g2 + f1 * g1 + f2 * g0 + f3_19 * g4 + f4_19 * g3; 322 | r3 = f0 * g3 + f1 * g2 + f2 * g1 + f3 * g0 + f4_19 * g4; 323 | r4 = f0 * g4 + f1 * g3 + f2 * g2 + f3 * g1 + f4 * g0; 324 | 325 | r00 = ((uint64_t) r0) & mask; 326 | carry = (uint64_t) (r0 >> 51); 327 | r1 += carry; 328 | r01 = ((uint64_t) r1) & mask; 329 | carry = (uint64_t) (r1 >> 51); 330 | r2 += carry; 331 | r02 = ((uint64_t) r2) & mask; 332 | carry = (uint64_t) (r2 >> 51); 333 | r3 += carry; 334 | r03 = ((uint64_t) r3) & mask; 335 | carry = (uint64_t) (r3 >> 51); 336 | r4 += carry; 337 | r04 = ((uint64_t) r4) & mask; 338 | carry = (uint64_t) (r4 >> 51); 339 | r00 += 19ULL * carry; 340 | carry = r00 >> 51; 341 | r00 &= mask; 342 | r01 += carry; 343 | carry = r01 >> 51; 344 | r01 &= mask; 345 | r02 += carry; 346 | 347 | h[0] = r00; 348 | h[1] = r01; 349 | h[2] = r02; 350 | h[3] = r03; 351 | h[4] = r04; 352 | } 353 | 354 | /* 355 | h = f * f 356 | Can overlap h with f. 357 | */ 358 | 359 | static void 360 | fe25519_sq(fe25519 h, const fe25519 f) 361 | { 362 | const uint64_t mask = 0x7ffffffffffffULL; 363 | uint128_t r0, r1, r2, r3, r4; 364 | uint128_t f0, f1, f2, f3, f4; 365 | uint128_t f0_2, f1_2, f1_38, f2_38, f3_38, f3_19, f4_19; 366 | uint64_t r00, r01, r02, r03, r04; 367 | uint64_t carry; 368 | 369 | f0 = (uint128_t) f[0]; 370 | f1 = (uint128_t) f[1]; 371 | f2 = (uint128_t) f[2]; 372 | f3 = (uint128_t) f[3]; 373 | f4 = (uint128_t) f[4]; 374 | 375 | f0_2 = f0 << 1; 376 | f1_2 = f1 << 1; 377 | 378 | f1_38 = 38ULL * f1; 379 | f2_38 = 38ULL * f2; 380 | f3_38 = 38ULL * f3; 381 | 382 | f3_19 = 19ULL * f3; 383 | f4_19 = 19ULL * f4; 384 | 385 | r0 = f0 * f0 + f1_38 * f4 + f2_38 * f3; 386 | r1 = f0_2 * f1 + f2_38 * f4 + f3_19 * f3; 387 | r2 = f0_2 * f2 + f1 * f1 + f3_38 * f4; 388 | r3 = f0_2 * f3 + f1_2 * f2 + f4_19 * f4; 389 | r4 = f0_2 * f4 + f1_2 * f3 + f2 * f2; 390 | 391 | r00 = ((uint64_t) r0) & mask; 392 | carry = (uint64_t) (r0 >> 51); 393 | r1 += carry; 394 | r01 = ((uint64_t) r1) & mask; 395 | carry = (uint64_t) (r1 >> 51); 396 | r2 += carry; 397 | r02 = ((uint64_t) r2) & mask; 398 | carry = (uint64_t) (r2 >> 51); 399 | r3 += carry; 400 | r03 = ((uint64_t) r3) & mask; 401 | carry = (uint64_t) (r3 >> 51); 402 | r4 += carry; 403 | r04 = ((uint64_t) r4) & mask; 404 | carry = (uint64_t) (r4 >> 51); 405 | r00 += 19ULL * carry; 406 | carry = r00 >> 51; 407 | r00 &= mask; 408 | r01 += carry; 409 | carry = r01 >> 51; 410 | r01 &= mask; 411 | r02 += carry; 412 | 413 | h[0] = r00; 414 | h[1] = r01; 415 | h[2] = r02; 416 | h[3] = r03; 417 | h[4] = r04; 418 | } 419 | 420 | /* 421 | h = 2 * f * f 422 | Can overlap h with f. 423 | */ 424 | 425 | static void 426 | fe25519_sq2(fe25519 h, const fe25519 f) 427 | { 428 | const uint64_t mask = 0x7ffffffffffffULL; 429 | uint128_t r0, r1, r2, r3, r4; 430 | uint128_t f0, f1, f2, f3, f4; 431 | uint128_t f0_2, f1_2, f1_38, f2_38, f3_38, f3_19, f4_19; 432 | uint64_t r00, r01, r02, r03, r04; 433 | uint64_t carry; 434 | 435 | f0 = (uint128_t) f[0]; 436 | f1 = (uint128_t) f[1]; 437 | f2 = (uint128_t) f[2]; 438 | f3 = (uint128_t) f[3]; 439 | f4 = (uint128_t) f[4]; 440 | 441 | f0_2 = f0 << 1; 442 | f1_2 = f1 << 1; 443 | 444 | f1_38 = 38ULL * f1; 445 | f2_38 = 38ULL * f2; 446 | f3_38 = 38ULL * f3; 447 | 448 | f3_19 = 19ULL * f3; 449 | f4_19 = 19ULL * f4; 450 | 451 | r0 = f0 * f0 + f1_38 * f4 + f2_38 * f3; 452 | r1 = f0_2 * f1 + f2_38 * f4 + f3_19 * f3; 453 | r2 = f0_2 * f2 + f1 * f1 + f3_38 * f4; 454 | r3 = f0_2 * f3 + f1_2 * f2 + f4_19 * f4; 455 | r4 = f0_2 * f4 + f1_2 * f3 + f2 * f2; 456 | 457 | r0 <<= 1; 458 | r1 <<= 1; 459 | r2 <<= 1; 460 | r3 <<= 1; 461 | r4 <<= 1; 462 | 463 | r00 = ((uint64_t) r0) & mask; 464 | carry = (uint64_t) (r0 >> 51); 465 | r1 += carry; 466 | r01 = ((uint64_t) r1) & mask; 467 | carry = (uint64_t) (r1 >> 51); 468 | r2 += carry; 469 | r02 = ((uint64_t) r2) & mask; 470 | carry = (uint64_t) (r2 >> 51); 471 | r3 += carry; 472 | r03 = ((uint64_t) r3) & mask; 473 | carry = (uint64_t) (r3 >> 51); 474 | r4 += carry; 475 | r04 = ((uint64_t) r4) & mask; 476 | carry = (uint64_t) (r4 >> 51); 477 | r00 += 19ULL * carry; 478 | carry = r00 >> 51; 479 | r00 &= mask; 480 | r01 += carry; 481 | carry = r01 >> 51; 482 | r01 &= mask; 483 | r02 += carry; 484 | 485 | h[0] = r00; 486 | h[1] = r01; 487 | h[2] = r02; 488 | h[3] = r03; 489 | h[4] = r04; 490 | } 491 | 492 | static inline void 493 | fe25519_mul32(fe25519 h, const fe25519 f, uint32_t n) 494 | { 495 | const uint64_t mask = 0x7ffffffffffffULL; 496 | uint128_t a; 497 | uint128_t sn = (uint128_t) n; 498 | uint64_t h0, h1, h2, h3, h4; 499 | 500 | a = f[0] * sn; 501 | h0 = ((uint64_t) a) & mask; 502 | a = f[1] * sn + ((uint64_t) (a >> 51)); 503 | h1 = ((uint64_t) a) & mask; 504 | a = f[2] * sn + ((uint64_t) (a >> 51)); 505 | h2 = ((uint64_t) a) & mask; 506 | a = f[3] * sn + ((uint64_t) (a >> 51)); 507 | h3 = ((uint64_t) a) & mask; 508 | a = f[4] * sn + ((uint64_t) (a >> 51)); 509 | h4 = ((uint64_t) a) & mask; 510 | 511 | h0 += (a >> 51) * 19ULL; 512 | 513 | h[0] = h0; 514 | h[1] = h1; 515 | h[2] = h2; 516 | h[3] = h3; 517 | h[4] = h4; 518 | } 519 | -------------------------------------------------------------------------------- /lib/spoke.ml: -------------------------------------------------------------------------------- 1 | exception Invalid_algorithm 2 | exception Invalid_cipher 3 | exception Invalid_hash 4 | 5 | external bytes_get_uint8 : bytes -> int -> int = "%bytes_safe_get" 6 | external bytes_set_uint8 : bytes -> int -> int -> unit = "%bytes_safe_set" 7 | external bytes_set_uint16 : bytes -> int -> int -> unit = "%caml_bytes_set16" 8 | external bytes_set_uint32 : bytes -> int -> int32 -> unit = "%caml_bytes_set32" 9 | external bytes_set_uint64 : bytes -> int -> int64 -> unit = "%caml_bytes_set64" 10 | external string_get_uint16 : string -> int -> int = "%caml_string_get16" 11 | external string_get_uint64 : string -> int -> int64 = "%caml_string_get64" 12 | external swap16 : int -> int = "%bswap16" 13 | external swap64 : int64 -> int64 = "%bswap_int64" 14 | 15 | let bytes_set_uint16_be = 16 | if Sys.big_endian then bytes_set_uint16 17 | else fun buf off v -> bytes_set_uint16 buf off (swap16 v) 18 | 19 | let string_get_uint16_be = 20 | if Sys.big_endian then string_get_uint16 21 | else fun str off -> swap16 (string_get_uint16 str off) 22 | 23 | let bytes_set_uint64_be = 24 | if Sys.big_endian then bytes_set_uint64 25 | else fun buf off v -> bytes_set_uint64 buf off (swap64 v) 26 | 27 | let string_get_uint64_be = 28 | if Sys.big_endian then string_get_uint64 29 | else fun str off -> swap64 (string_get_uint64 str off) 30 | 31 | type shared_keys = string * string 32 | type public = string 33 | type secret = string 34 | type scalar = Scalar of string 35 | 36 | let scalar (Scalar v) = v 37 | 38 | type keys = { 39 | _M : scalar; 40 | _N : scalar; 41 | _L : scalar; 42 | h_K : string; 43 | h_L : string; 44 | } 45 | 46 | external spoke_ed25519_from_uniform : 47 | bytes -> dst_off:int -> string -> src_off:int -> unit 48 | = "spoke_ed25519_from_uniform" 49 | 50 | let ed25519_from_uniform src ~off = 51 | let buf = Bytes.create 32 in 52 | spoke_ed25519_from_uniform buf ~dst_off:0 src ~src_off:off; 53 | Scalar (Bytes.unsafe_to_string buf) 54 | 55 | external spoke_ed25519_scalarmult_base : 56 | bytes -> dst_off:int -> string -> src_off:int -> unit 57 | = "spoke_ed25519_scalarmult_base" 58 | 59 | let ed25519_scalarmult_base hash ~off = 60 | let buf = Bytes.create 32 in 61 | spoke_ed25519_scalarmult_base buf ~dst_off:0 hash ~src_off:off; 62 | Scalar (Bytes.unsafe_to_string buf) 63 | 64 | let random_buffer ?g buf = 65 | let g = match g with Some g -> g | None -> Random.State.make_self_init () in 66 | let len = Bytes.length buf in 67 | let len0 = len land 3 in 68 | let len1 = len asr 2 in 69 | for i = 0 to len1 - 1 do 70 | let i = i * 4 in 71 | bytes_set_uint32 buf i (Random.State.int32 g Int32.max_int) 72 | done; 73 | for i = 0 to len0 - 1 do 74 | let i = (len1 * 4) + i in 75 | bytes_set_uint8 buf i (Random.State.bits g land 0xff) 76 | done 77 | 78 | let random_bytes ?g len = 79 | let buf = Bytes.create len in 80 | random_buffer ?g buf; 81 | Bytes.unsafe_to_string buf 82 | 83 | let version = 1 84 | 85 | let version_string = 86 | let buf = Bytes.create 2 in 87 | bytes_set_uint16 buf 0 1; 88 | Bytes.unsafe_to_string buf 89 | 90 | type _ algorithm = Pbkdf2 : int algorithm 91 | type a = Algorithm : 'a algorithm -> a 92 | 93 | type _ aead = 94 | | GCM : Mirage_crypto.AES.GCM.key aead 95 | | CCM16 : Mirage_crypto.AES.CCM16.key aead 96 | | ChaCha20_Poly1305 : Mirage_crypto.Chacha20.key aead 97 | 98 | type cipher = AEAD : 'k aead -> cipher 99 | type hash = Hash : 'k Digestif.hash -> hash 100 | 101 | let int_of_algorithm : type a. a algorithm -> int = function Pbkdf2 -> 2 102 | 103 | let algorithm_of_int : int -> a = function 104 | | 2 -> Algorithm Pbkdf2 105 | | _ -> raise Invalid_algorithm 106 | 107 | let int_of_hash : type k. k Digestif.hash -> int = function 108 | | Digestif.SHA256 -> 4 109 | | _ -> assert false (* TODO *) 110 | 111 | let hash_of_int : int -> hash = function 112 | | 4 -> Hash Digestif.SHA256 113 | | _ -> raise Invalid_hash 114 | 115 | let int_of_cipher = function 116 | | AEAD GCM -> 0 117 | | AEAD CCM16 -> 1 118 | | AEAD ChaCha20_Poly1305 -> 2 119 | 120 | let cipher_of_int = function 121 | | 0 -> AEAD GCM 122 | | 1 -> AEAD CCM16 123 | | 2 -> AEAD ChaCha20_Poly1305 124 | | _ -> raise Invalid_cipher 125 | 126 | let keys : type a. 127 | salt:string -> 128 | hash:hash -> 129 | string -> 130 | algorithm:a algorithm -> 131 | a -> 132 | keys * int64 = 133 | fun ~salt ~hash password ~algorithm arguments -> 134 | let (Hash hash) = hash in 135 | let mnkl = 136 | match algorithm with 137 | | Pbkdf2 -> 138 | let count = arguments in 139 | Pbkdf2.generate hash ~password ~salt ~count (Int32.of_int (32 * 4)) 140 | in 141 | let h_K = String.sub mnkl 64 32 in 142 | let h_L = String.sub mnkl 96 32 in 143 | let _M = ed25519_from_uniform mnkl ~off:0 in 144 | let _N = ed25519_from_uniform mnkl ~off:32 in 145 | let _L = ed25519_scalarmult_base mnkl ~off:96 in 146 | let arguments = match algorithm with Pbkdf2 -> Int64.of_int arguments in 147 | ({ _M; _N; _L; h_K; h_L }, arguments) 148 | 149 | let uint16_be_to_string v = 150 | let buf = Bytes.create 2 in 151 | bytes_set_uint16_be buf 0 v; 152 | Bytes.unsafe_to_string buf 153 | 154 | let pbkdf2 = uint16_be_to_string (int_of_algorithm Pbkdf2) 155 | 156 | let uint64_be_to_string v = 157 | let buf = Bytes.create 8 in 158 | bytes_set_uint64_be buf 0 v; 159 | Bytes.unsafe_to_string buf 160 | 161 | module Format = struct 162 | open Encore 163 | open Syntax 164 | 165 | let uint16be = 166 | Bij.v ~fwd:(fun str -> string_get_uint16_be str 0) ~bwd:uint16_be_to_string 167 | 168 | let uint64be = 169 | Bij.v ~fwd:(fun str -> string_get_uint64_be str 0) ~bwd:uint64_be_to_string 170 | 171 | let version = uint16be <$> fixed 2 172 | 173 | let algorithm_and_arguments = 174 | choice [ const pbkdf2 <*> (uint64be <$> fixed 8) ] 175 | 176 | let safe f x = try f x with _ -> raise Bij.Bijection 177 | 178 | let cipher = 179 | let cipher = Bij.v ~fwd:(safe cipher_of_int) ~bwd:int_of_cipher in 180 | Bij.compose uint16be cipher <$> fixed 2 181 | 182 | let ciphers = cipher <*> cipher 183 | 184 | let hash = 185 | let hash = 186 | Bij.v ~fwd:(safe hash_of_int) ~bwd:(fun (Hash hash) -> int_of_hash hash) 187 | in 188 | Bij.compose uint16be hash <$> fixed 2 189 | 190 | let salt = fixed 16 191 | 192 | let scalar = 193 | let scalar = 194 | Bij.v ~fwd:(fun str -> Scalar str) ~bwd:(fun (Scalar str) -> str) 195 | in 196 | scalar <$> fixed 32 197 | 198 | let secret = 199 | Bij.obj5 200 | <$> (version <*> algorithm_and_arguments <*> ciphers <*> hash <*> salt) 201 | <*> (Bij.obj4 <$> (scalar <*> scalar <*> fixed 32 <*> scalar)) 202 | 203 | let public = 204 | Bij.obj5 205 | <$> (version <*> algorithm_and_arguments <*> ciphers <*> hash <*> salt) 206 | 207 | let secret_to_string v = 208 | Encore.Lavoisier.emit_string v (Encore.to_lavoisier secret) 209 | 210 | let secret_of_string str = 211 | Angstrom.parse_string ~consume:All (Encore.to_angstrom secret) str 212 | 213 | let public_to_string v = 214 | Encore.Lavoisier.emit_string v (Encore.to_lavoisier public) 215 | 216 | let public_of_string str = 217 | Angstrom.parse_string ~consume:All (Encore.to_angstrom public) str 218 | end 219 | 220 | let generate : type a. 221 | ?hash:hash -> 222 | ?ciphers:cipher * cipher -> 223 | ?g:Random.State.t -> 224 | password:string -> 225 | algorithm:a algorithm -> 226 | a -> 227 | string * string = 228 | fun ?(hash = Hash Digestif.SHA256) 229 | ?(ciphers = (AEAD GCM, AEAD ChaCha20_Poly1305)) ?g ~password ~algorithm 230 | arguments -> 231 | let salt = random_bytes ?g 16 in 232 | let keys, arguments = keys ~salt ~hash password ~algorithm arguments in 233 | let (Hash hash) = hash in 234 | 235 | let secret = 236 | Format.secret_to_string 237 | ( (version, (pbkdf2, arguments), ciphers, Hash hash, salt), 238 | (keys._M, keys._N, keys.h_K, keys._L) ) 239 | in 240 | let public = 241 | Format.public_to_string 242 | (version, (pbkdf2, arguments), ciphers, Hash hash, salt) 243 | in 244 | (secret, public) 245 | 246 | let public_to_string str = str 247 | let public_of_string str = Ok str 248 | let public_of_secret secret = String.sub secret 0 34 249 | let zero = String.make 32 '\000' 250 | 251 | let random_scalar ?g () = 252 | let buf = Bytes.create 32 in 253 | let rec go () = 254 | random_buffer ?g buf; 255 | Bytes.set buf 0 (Char.chr (bytes_get_uint8 buf 0 land 248)); 256 | Bytes.set buf 31 (Char.chr (bytes_get_uint8 buf 31 land 127)); 257 | if Eqaf.compare_be (Bytes.unsafe_to_string buf) zero = 0 then go () 258 | in 259 | go (); 260 | Bytes.unsafe_to_string buf 261 | 262 | external spoke_ed25519_scalarmult_base_noclamp : 263 | bytes -> dst_off:int -> string -> src_off:int -> unit 264 | = "spoke_ed25519_scalarmult_base_noclamp" 265 | 266 | let ed25519_scalarmult_base_noclamp hash ~off = 267 | let buf = Bytes.create 32 in 268 | spoke_ed25519_scalarmult_base_noclamp buf ~src_off:0 hash ~dst_off:off; 269 | Scalar (Bytes.unsafe_to_string buf) 270 | 271 | external spoke_ed25519_add : bytes -> dst_off:int -> string -> string -> unit 272 | = "spoke_ed25519_add" 273 | 274 | let ed25519_add (Scalar f) (Scalar g) = 275 | let buf = Bytes.create 32 in 276 | spoke_ed25519_add buf ~dst_off:0 f g; 277 | Scalar (Bytes.unsafe_to_string buf) 278 | 279 | type client = { 280 | h_K : string; 281 | h_L : string; 282 | _N : scalar; 283 | x : string; 284 | _X : scalar; 285 | ciphers : cipher * cipher; 286 | } 287 | 288 | let ciphers_of_client { ciphers; _ } = ciphers 289 | 290 | let hello ?g ~public password = 291 | match Format.public_of_string public with 292 | | Error _ -> Error `Invalid_public_packet 293 | | Ok (_version, (algorithm, arguments), ciphers, Hash hash, salt) -> 294 | let keys, _arguments = 295 | match 296 | (algorithm_of_int (string_get_uint16_be algorithm 0), arguments) 297 | with 298 | | Algorithm Pbkdf2, count -> 299 | let count = Int64.to_int count in 300 | let algorithm = Pbkdf2 in 301 | keys ~salt ~hash:(Hash hash) password ~algorithm count 302 | in 303 | let x = random_scalar ?g () in 304 | let gx = ed25519_scalarmult_base_noclamp x ~off:0 in 305 | let _X = ed25519_add gx keys._M in 306 | Ok 307 | ( { h_K = keys.h_K; h_L = keys.h_L; _N = keys._N; x; _X; ciphers }, 308 | scalar _X ) 309 | 310 | let ciphers_of_public public = 311 | match Format.public_of_string public with 312 | | Error _ -> Error `Invalid_public_packet 313 | | Ok (_, _, ciphers, _, _) -> Ok ciphers 314 | 315 | let ciphers_of_secret secret = 316 | match Format.secret_of_string secret with 317 | | Error _ -> invalid_arg "Invalid secret value" 318 | | Ok ((_, _, ciphers, _, _), _) -> ciphers 319 | 320 | type error = 321 | [ `Point_is_not_on_prime_order_subgroup 322 | | `Invalid_client_validator 323 | | `Invalid_server_validator 324 | | `Invalid_public_packet 325 | | `Invalid_secret_packet ] 326 | 327 | let pp_error ppf = function 328 | | `Point_is_not_on_prime_order_subgroup -> 329 | Fmt.pf ppf "Point is not on prime-order subgroup" 330 | | `Invalid_client_validator -> Fmt.pf ppf "Invalid client validator" 331 | | `Invalid_server_validator -> Fmt.pf ppf "Invalid server validator" 332 | | `Invalid_public_packet -> Fmt.pf ppf "Invalid public packet" 333 | | `Invalid_secret_packet -> Fmt.pf ppf "Invalid secret packet" 334 | 335 | external spoke_ed25519_scalarmult_noclamp : 336 | bytes -> string -> src_off:int -> point:string -> bool 337 | = "spoke_ed25519_scalarmult_noclamp" 338 | 339 | let ed25519_scalarmult_noclamp hash ~off ~point:(Scalar point) = 340 | let buf = Bytes.create 32 in 341 | let res = spoke_ed25519_scalarmult_noclamp buf hash ~src_off:off ~point in 342 | if res then Ok (Scalar (Bytes.unsafe_to_string buf)) 343 | else Error `Point_is_not_on_prime_order_subgroup 344 | 345 | external spoke_ed25519_scalarmult : 346 | bytes -> string -> src_off:int -> point:string -> bool 347 | = "spoke_ed25519_scalarmult" 348 | 349 | let ed25519_scalarmult hash ~off ~point:(Scalar point) = 350 | let buf = Bytes.create 32 in 351 | let res = spoke_ed25519_scalarmult buf hash ~src_off:off ~point in 352 | if res then Ok (Scalar (Bytes.unsafe_to_string buf)) 353 | else Error `Point_is_not_on_prime_order_subgroup 354 | 355 | let subkey_from_key ~identity context main_key = 356 | if String.length context > 8 then 357 | Fmt.invalid_arg "Invalid context for key derivation"; 358 | let ctx = 359 | let buf = Bytes.make 16 '\000' in 360 | Bytes.blit_string context 0 buf 0 (String.length context); 361 | Bytes.unsafe_to_string buf 362 | in 363 | let salt = 364 | let buf = Bytes.make 16 '\000' in 365 | bytes_set_uint64 buf 0 identity; 366 | Bytes.unsafe_to_string buf 367 | in 368 | let module Hash = Digestif.BLAKE2B in 369 | Hash.Keyed.mac_string ~key:main_key (ctx ^ salt) |> Hash.to_raw_string 370 | (* XXX(dinosaure): [salt] and [ctx] can be a part of the BLAKE2B initialization. 371 | * However, [digestif] does not provide such API. *) 372 | 373 | let context = "SPOKE" 374 | 375 | let shared_keys_and_validators ~identity:(client, server) (Scalar _X) 376 | (Scalar _Y) (Scalar _Z) h_K (Scalar _V) = 377 | let module Hash = Digestif.BLAKE2B in 378 | let ctx = Hash.empty in 379 | let ctx = Hash.feed_string ctx version_string in 380 | let ctx = Hash.feed_string ctx client in 381 | let ctx = Hash.feed_string ctx server in 382 | let ctx = Hash.feed_string ctx _X in 383 | let ctx = Hash.feed_string ctx _Y in 384 | let ctx = Hash.feed_string ctx _Z in 385 | let ctx = Hash.feed_string ctx h_K in 386 | let ctx = Hash.feed_string ctx _V in 387 | let main_key = Hash.to_raw_string (Hash.get ctx) in 388 | let client_sk = subkey_from_key ~identity:0L context main_key in 389 | let server_sk = subkey_from_key ~identity:1L context main_key in 390 | let client_validator = subkey_from_key ~identity:2L context main_key in 391 | let server_validator = subkey_from_key ~identity:3L context main_key in 392 | ((client_sk, server_sk), (client_validator, server_validator)) 393 | 394 | external spoke_ed25519_sub : bytes -> dst_off:int -> string -> string -> unit 395 | = "spoke_ed25519_sub" 396 | 397 | let ed25519_sub (Scalar f) (Scalar g) = 398 | let buf = Bytes.create 32 in 399 | spoke_ed25519_sub buf ~dst_off:0 f g; 400 | Scalar (Bytes.unsafe_to_string buf) 401 | 402 | let ( let* ) = Result.bind 403 | 404 | type server = { 405 | validator : string; 406 | shared_keys : string * string; 407 | ciphers : cipher * cipher; 408 | } 409 | 410 | let server_compute ?g ~secret ~identity _X = 411 | match Format.secret_of_string secret with 412 | | Error _ -> Error `Invalid_secret_packet 413 | | Ok 414 | ( (_version, (_algorithm, _arguments), ciphers, _hash, _salt), 415 | (_M, _N, h_K, _L) ) -> 416 | let y = random_scalar ?g () in 417 | let gy = ed25519_scalarmult_base_noclamp y ~off:0 in 418 | let _Y = ed25519_add gy _N in 419 | let _X = Scalar _X in 420 | let gx = ed25519_sub _X _M in 421 | let* _Z = ed25519_scalarmult_noclamp y ~off:0 ~point:gx in 422 | let* _V = ed25519_scalarmult_noclamp y ~off:0 ~point:_L in 423 | let shared_keys, validators = 424 | shared_keys_and_validators ~identity _X _Y _Z h_K _V 425 | in 426 | Ok 427 | ( { shared_keys; validator = snd validators; ciphers }, 428 | (scalar _Y, fst validators) ) 429 | 430 | let client_compute ~client ~identity _Y client_validator = 431 | let _Y = Scalar _Y in 432 | let gy = ed25519_sub _Y client._N in 433 | let* _Z = ed25519_scalarmult_noclamp client.x ~off:0 ~point:gy in 434 | let* _V = ed25519_scalarmult client.h_L ~off:0 ~point:gy in 435 | let shared_keys, validators = 436 | shared_keys_and_validators ~identity client._X _Y _Z client.h_K _V 437 | in 438 | if Eqaf.compare_le (fst validators) client_validator = 0 then 439 | Ok (shared_keys, snd validators) 440 | else Error `Invalid_client_validator 441 | 442 | let server_finalize ~server server_validator = 443 | if Eqaf.compare_le server.validator server_validator = 0 then 444 | Ok server.shared_keys 445 | else Error `Invalid_server_validator 446 | -------------------------------------------------------------------------------- /bin/simulate.ml: -------------------------------------------------------------------------------- 1 | open Rresult 2 | open Lwt.Infix 3 | 4 | let ( >>? ) = Lwt_result.bind 5 | 6 | let client ~ctx fd fd_length = 7 | let queue, _ = Ke.Rke.Weighted.create ~capacity:0x1000 Bigarray.char in 8 | let buf = Bytes.create 0x1000 in 9 | let close = ref false in 10 | let mutex = Lwt_mutex.create () in 11 | let condition = Lwt_condition.create () in 12 | 13 | let rec producer flow = 14 | Lwt_unix.read fd buf 0 (Bytes.length buf) >>= function 15 | | 0 -> 16 | ( Lwt_mutex.with_lock mutex @@ fun () -> 17 | close := true; 18 | Lwt_condition.broadcast condition `Closed; 19 | Lwt.return_unit ) 20 | >>= fun () -> Lwt.return_ok () 21 | | len -> 22 | let rec fill (buf, off, max) = 23 | ( Lwt_mutex.with_lock mutex @@ fun () -> 24 | let blit src src_off dst dst_off len = 25 | Bigstringaf.blit_from_bytes src ~src_off dst ~dst_off ~len 26 | in 27 | match min len (Ke.Rke.Weighted.available queue) with 28 | | 0 -> 29 | Lwt_condition.signal condition `Full; 30 | Lwt.return (`Redo (buf, off, max)) 31 | | len -> 32 | let _ = 33 | Ke.Rke.Weighted.N.push_exn queue ~blit ~length:Bytes.length 34 | ~off ~len buf 35 | in 36 | Logs.debug (fun m -> m "Signal `Filled."); 37 | Lwt_condition.signal condition `Filled; 38 | if max - len = 0 then Lwt.return `Next 39 | else Lwt.return (`Redo (buf, off, max - len)) ) 40 | >>= function 41 | | `Redo v -> Lwt.pause () >>= fun () -> fill v 42 | | `Next -> Lwt.return_unit 43 | in 44 | Mimic.write flow (Cstruct.of_string (Bytes.sub_string buf 0 len)) 45 | >>? fun () -> 46 | fill (buf, 0, len) >>= fun () -> producer flow 47 | in 48 | 49 | let rec consumer flow checked = 50 | ( Lwt_mutex.with_lock mutex @@ fun () -> 51 | let rec wait res = 52 | if Ke.Rke.Weighted.is_empty queue && not !close then 53 | Lwt_condition.wait ~mutex condition >>= wait 54 | else Lwt.return res 55 | in 56 | Logs.debug (fun m -> m "Waiting for more data."); 57 | wait `Filled >>= function 58 | | (`Filled | `Full | `Closed) as state -> ( 59 | Mimic.read flow >>? function 60 | | `Eof -> 61 | if state = `Closed && Ke.Rke.Weighted.is_empty queue then 62 | Lwt.return_ok `Closed 63 | else Lwt.return_error (R.msgf "Remaining untrusted contents!") 64 | | `Data cs -> 65 | let str0 = Cstruct.to_string cs in 66 | let blit src src_off dst dst_off len = 67 | Bigstringaf.blit_to_bytes src ~src_off dst ~dst_off ~len 68 | in 69 | let len = String.length str0 in 70 | let buf = Bytes.create len in 71 | Ke.Rke.Weighted.N.keep_exn queue ~blit ~length:Bytes.length buf 72 | ~len; 73 | Ke.Rke.Weighted.N.shift_exn queue len; 74 | if Eqaf.compare_be str0 (Bytes.unsafe_to_string buf) = 0 then ( 75 | Logs.debug (fun m -> 76 | m "Block received (%d byte(s)) is integre." 77 | (Cstruct.length cs)); 78 | if checked + len = fd_length then Lwt.return_ok `Closed 79 | else Lwt.return_ok (`Continue (checked + len))) 80 | else Lwt.return_error (R.msgf "Contents are corrupted!")) ) 81 | >>? function 82 | | `Closed -> Lwt.return_ok () 83 | | `Continue checked -> Lwt.pause () >>= fun () -> consumer flow checked 84 | in 85 | 86 | Mimic.resolve ctx >>? fun flow -> 87 | Lwt.both (producer flow) (consumer flow 0) >>= fun res -> 88 | Logs.debug (fun m -> m "Close the connection with the server."); 89 | Mimic.close flow >>= fun () -> 90 | match res with 91 | | Ok (), Ok () -> Lwt.return_ok () 92 | | Error err, _ -> Lwt.return_error (R.msgf "%a" Mimic.pp_write_error err) 93 | | _, Error err -> Lwt.return_error (R.msgf "%a" Mimic.pp_error err) 94 | 95 | let handler flow = 96 | let queue, _ = Ke.Rke.Weighted.create ~capacity:0x1000 Bigarray.char in 97 | let block = Cstruct.create 0x1000 in 98 | let close = ref false in 99 | let mutex = Lwt_mutex.create () in 100 | let condition = Lwt_condition.create () in 101 | 102 | let rec producer flow = 103 | Mimic.read flow >>? function 104 | | `Eof -> 105 | ( Lwt_mutex.with_lock mutex @@ fun () -> 106 | close := true; 107 | Lwt_condition.broadcast condition `Closed; 108 | Lwt.return_unit ) 109 | >>= fun () -> Lwt.return_ok () 110 | | `Data cs -> 111 | Logs.debug (fun m -> 112 | m "Recv @[%a@]" 113 | (Hxd_string.pp Hxd.default) 114 | (Cstruct.to_string cs)); 115 | let rec fill cs = 116 | ( Lwt_mutex.with_lock mutex @@ fun () -> 117 | let blit src src_off dst dst_off len = 118 | let dst = Cstruct.of_bigarray dst ~off:dst_off ~len in 119 | Cstruct.blit src src_off dst 0 len 120 | in 121 | match min (Cstruct.length cs) (Ke.Rke.Weighted.available queue) with 122 | | 0 -> 123 | Lwt_condition.signal condition `Full; 124 | Lwt.return (`Redo cs) 125 | | len -> 126 | let _ = 127 | Ke.Rke.Weighted.N.push_exn queue ~blit ~length:Cstruct.length 128 | ~len cs 129 | in 130 | Lwt_condition.signal condition `Filled; 131 | if Cstruct.length cs - len = 0 then Lwt.return `Next 132 | else Lwt.return (`Redo (Cstruct.shift cs len)) ) 133 | >>= function 134 | | `Redo cs -> Lwt.pause () >>= fun () -> fill cs 135 | | `Next -> Lwt.return_unit 136 | in 137 | fill cs >>= fun () -> producer flow 138 | in 139 | 140 | let rec consumer flow = 141 | ( Lwt_mutex.with_lock mutex @@ fun () -> 142 | let rec wait res = 143 | if Ke.Rke.Weighted.is_empty queue && not !close then 144 | Lwt_condition.wait ~mutex condition >>= wait 145 | else Lwt.return res 146 | in 147 | wait `Filled >>= function 148 | | (`Full | `Filled | `Closed) as state -> ( 149 | let blit src src_off dst dst_off len = 150 | let src = Cstruct.of_bigarray src ~off:src_off ~len in 151 | Cstruct.blit src 0 dst dst_off len 152 | in 153 | let len = min (Ke.Rke.Weighted.length queue) (Cstruct.length block) in 154 | Ke.Rke.Weighted.N.keep_exn queue ~blit ~length:Cstruct.length block 155 | ~len; 156 | Ke.Rke.Weighted.N.shift_exn queue len; 157 | let block = Cstruct.sub block 0 len in 158 | Logs.debug (fun m -> 159 | m "Send @[%a@]" 160 | (Hxd_string.pp Hxd.default) 161 | (Cstruct.to_string block)); 162 | (if Cstruct.length block > 0 then Mimic.write flow block 163 | else Lwt.return_ok ()) 164 | >>? fun () -> 165 | match state with 166 | | `Closed -> 167 | Logs.debug (fun m -> m "The connection was closed by the client."); 168 | Lwt.return_ok `Closed 169 | | `Full | `Filled -> Lwt.return_ok `Continue) ) 170 | >>? function 171 | | `Closed -> Lwt.return_ok () 172 | | `Continue -> Lwt.pause () >>= fun () -> consumer flow 173 | in 174 | 175 | Lwt.both (producer flow) (consumer flow) >>= fun (p, c) -> 176 | Mimic.close flow >>= fun () -> 177 | match (p, c) with 178 | | Ok (), Ok () -> Lwt.return_ok () 179 | | Error err, _ -> Lwt.return_error (R.msgf "%a" Mimic.pp_error err) 180 | | _, Error err -> Lwt.return_error (R.msgf "%a" Mimic.pp_write_error err) 181 | 182 | let handler stop flow = 183 | handler flow >>= fun res -> 184 | Lwt_switch.turn_off stop >>= fun () -> 185 | match res with 186 | | Ok () -> Lwt.return_unit 187 | | Error err -> 188 | Fmt.epr "Got an error: %a.\n%!" Mimic.pp_error err; 189 | Lwt.return_unit 190 | 191 | module SPOKE = struct 192 | include Flow.Make (Tcpip_stack_socket.V4V6.TCP) 193 | 194 | type endpoint = { 195 | g : Random.State.t option; 196 | identity : string * string; 197 | password : string; 198 | tcp : Tcpip_stack_socket.V4V6.TCP.t; 199 | ipaddr : Ipaddr.t; 200 | port : int; 201 | } 202 | 203 | let connect { g; identity; password; tcp = stack; ipaddr; port } = 204 | let open Tcpip_stack_socket.V4V6 in 205 | TCP.create_connection stack (ipaddr, port) 206 | >|= R.reword_error (fun err -> `Flow err) 207 | >>? fun flow -> client_of_flow ?g ~identity ~password flow 208 | end 209 | 210 | type ('v, 'flow, 'err) service = { 211 | accept : 'v -> ('flow, 'err) result Lwt.t; 212 | close : 'v -> unit Lwt.t; 213 | } 214 | constraint 'err = [> `Closed ] 215 | 216 | let serve_when_ready ?stop ~handler { accept; close } service = 217 | `Initialized 218 | (let switched_off = 219 | let t, u = Lwt.wait () in 220 | Lwt_switch.add_hook stop (fun () -> 221 | Lwt.wakeup_later u (Ok `Stopped); 222 | Lwt.return_unit); 223 | t 224 | in 225 | let rec loop () = 226 | let accept = accept service >>? fun flow -> Lwt.return_ok (`Flow flow) in 227 | accept >>? function 228 | | `Flow flow -> 229 | Lwt.async (fun () -> handler flow); 230 | Lwt.pause () >>= loop 231 | in 232 | let stop_result = 233 | Lwt.pick [ switched_off; loop () ] >>= function 234 | | Ok `Stopped -> close service >>= fun () -> Lwt.return_ok () 235 | | Error _ as err -> close service >>= fun () -> Lwt.return err 236 | in 237 | stop_result >>= function Ok () | Error _ -> Lwt.return_unit) 238 | 239 | module TCP = struct 240 | type flow = Lwt_unix.file_descr 241 | type error = [ `Error of Unix.error * string * string ] 242 | type write_error = [ `Closed | `Error of Unix.error * string * string ] 243 | 244 | let pp_error ppf = function 245 | | `Error (err, f, v) -> 246 | Fmt.pf ppf "%s(%s) : %s" f v (Unix.error_message err) 247 | 248 | let pp_write_error ppf = function 249 | | #error as err -> pp_error ppf err 250 | | `Closed -> Fmt.pf ppf "Connection closed by peer" 251 | 252 | let read fd = 253 | let tmp = Bytes.create 0x1000 in 254 | let process () = 255 | Lwt_unix.read fd tmp 0 (Bytes.length tmp) >>= function 256 | | 0 -> Lwt.return_ok `Eof 257 | | len -> Lwt.return_ok (`Data (Cstruct.of_bytes ~off:0 ~len tmp)) 258 | in 259 | Lwt.catch process @@ function 260 | | Unix.Unix_error (e, f, v) -> Lwt.return_error (`Error (e, f, v)) 261 | | exn -> Lwt.fail exn 262 | 263 | let write fd ({ Cstruct.len; _ } as cs) = 264 | let rec process buf off max = 265 | Lwt_unix.write fd buf off max >>= fun len -> 266 | if max - len = 0 then Lwt.return_ok () 267 | else process buf (off + len) (max - len) 268 | in 269 | let buf = Cstruct.to_bytes cs in 270 | Lwt.catch (fun () -> process buf 0 len) @@ function 271 | | Unix.Unix_error (e, f, v) -> Lwt.return_error (`Error (e, f, v)) 272 | | exn -> Lwt.fail exn 273 | 274 | let rec writev fd = function 275 | | [] -> Lwt.return_ok () 276 | | x :: r -> write fd x >>? fun () -> writev fd r 277 | 278 | let close = Lwt_unix.close 279 | 280 | let shutdown fd = function 281 | | `read -> 282 | Lwt_unix.shutdown fd Unix.SHUTDOWN_RECEIVE; 283 | Lwt.return_unit 284 | | `write -> 285 | Lwt_unix.shutdown fd Unix.SHUTDOWN_SEND; 286 | Lwt.return_unit 287 | | `read_write -> 288 | Lwt_unix.shutdown fd Unix.SHUTDOWN_ALL; 289 | Lwt.return_unit 290 | end 291 | 292 | module SPOKEServer = struct 293 | include Flow.Make (TCP) 294 | 295 | type endpoint = | 296 | 297 | let connect : endpoint -> (flow, write_error) result Lwt.t = function _ -> . 298 | end 299 | 300 | let _, spoke_protocol = Mimic.register ~name:"spoke" (module SPOKEServer) 301 | 302 | let pp_sockaddr ppf = function 303 | | Unix.ADDR_UNIX unix_domain -> Fmt.string ppf unix_domain 304 | | Unix.ADDR_INET (inet_addr, port) -> 305 | let inet_addr = Unix.string_of_inet_addr inet_addr in 306 | Fmt.pf ppf "%s:%d" inet_addr port 307 | 308 | let service ?g password = 309 | let module REPR = (val Mimic.repr spoke_protocol) in 310 | let identity = Unix.gethostname () in 311 | let accept t = 312 | Lwt_unix.accept t >>= fun (fd, sockaddr) -> 313 | Logs.debug (fun m -> m "Incoming connection from: %a." pp_sockaddr sockaddr); 314 | SPOKEServer.server_of_flow ?g 315 | ~cfg:Spoke.(Cfg (Pbkdf2, 16)) 316 | ~identity:(identity, identity) ~password fd 317 | >>? fun fd -> 318 | Logs.debug (fun m -> m "Handshake done!"); 319 | Lwt.return_ok (REPR.T fd) 320 | in 321 | let close t = Lwt_unix.close t in 322 | { accept; close } 323 | 324 | let spoke_edn, _ = Mimic.register ~name:"spoke" (module SPOKE) 325 | let m_g = Mimic.make ~name:"g" 326 | let m_server_identity = Mimic.make ~name:"server-identity" 327 | let m_password = Mimic.make ~name:"password" 328 | let m_tcp = Mimic.make ~name:"tcp" 329 | let m_ipaddr = Mimic.make ~name:"ipaddr" 330 | let m_port = Mimic.make ~name:"port" 331 | 332 | let m_domain_name : [ `host ] Domain_name.t Mimic.value = 333 | Mimic.make ~name:"domain-name" 334 | 335 | let ctx ~port = 336 | let k0 domain_name = 337 | match Unix.gethostbyname (Domain_name.to_string domain_name) with 338 | | { Unix.h_addr_list; _ } when Array.length h_addr_list > 0 -> 339 | Lwt.return_some (Ipaddr_unix.of_inet_addr h_addr_list.(0)) 340 | | _ -> Lwt.return_none 341 | | exception _ -> Lwt.return_none 342 | in 343 | let k1 g server_identity password tcp ipaddr port = 344 | let client_identity = Unix.gethostname () in 345 | Lwt.return_some 346 | { 347 | SPOKE.g; 348 | identity = (client_identity, server_identity); 349 | password; 350 | tcp; 351 | ipaddr; 352 | port; 353 | } 354 | in 355 | let open Tcpip_stack_socket.V4V6 in 356 | TCP.connect ~ipv4_only:false ~ipv6_only:false Ipaddr.V4.Prefix.global None 357 | >>= fun tcp -> 358 | let ctx = Mimic.empty in 359 | let ctx = Mimic.add m_tcp tcp ctx in 360 | let ctx = Mimic.fold m_ipaddr Mimic.Fun.[ req m_domain_name ] ~k:k0 ctx in 361 | let ctx = 362 | Mimic.fold spoke_edn 363 | Mimic.Fun. 364 | [ 365 | opt m_g; 366 | req m_server_identity; 367 | req m_password; 368 | req m_tcp; 369 | req m_ipaddr; 370 | dft m_port port; 371 | ] 372 | ~k:k1 ctx 373 | in 374 | Lwt.return ctx 375 | 376 | let run filename (ipaddr, port) password = 377 | let client () = 378 | let g = Random.State.make_self_init () in 379 | ctx ~port >>= fun ctx -> 380 | let ctx = Mimic.add m_ipaddr ipaddr ctx in 381 | let ctx = Mimic.add m_g g ctx in 382 | let identity = Unix.gethostname () in 383 | let ctx = Mimic.add m_server_identity identity ctx in 384 | let ctx = Mimic.add m_password password ctx in 385 | Lwt_unix.openfile filename Unix.[ O_RDONLY ] 0o644 >>= fun fd -> 386 | Lwt_unix.stat filename >>= fun stat -> 387 | client ~ctx fd stat.Unix.st_size >>= function 388 | | Ok () -> Lwt.return_unit 389 | | Error err -> 390 | Fmt.epr "%a.\n%!" Mimic.pp_error err; 391 | Lwt.return_unit 392 | in 393 | let server () = 394 | let stop = Lwt_switch.create () in 395 | let g = Random.State.make_self_init () in 396 | let sockaddr = Unix.ADDR_INET (Ipaddr_unix.to_inet_addr ipaddr, port) in 397 | let domain = Unix.domain_of_sockaddr sockaddr in 398 | let socket = Lwt_unix.socket domain Unix.SOCK_STREAM 0 in 399 | Lwt_unix.bind socket sockaddr >>= fun () -> 400 | Lwt_unix.listen socket 40; 401 | let (`Initialized th) = 402 | serve_when_ready ~stop ~handler:(handler stop) (service ~g password) 403 | socket 404 | in 405 | th 406 | in 407 | Lwt.both (client ()) (server ()) >>= fun ((), ()) -> Lwt.return_unit 408 | 409 | let () = 410 | match Sys.argv with 411 | | [| _; filename; ipaddr; password |] when Sys.file_exists filename -> ( 412 | match Ipaddr.with_port_of_string ~default:9000 ipaddr with 413 | | Ok addr -> Lwt_main.run (run filename addr password) 414 | | Error _ -> 415 | Fmt.epr "%s [:] \n%!" Sys.argv.(0)) 416 | | _ -> Fmt.epr "%s [:] \n%!" Sys.argv.(0) 417 | -------------------------------------------------------------------------------- /lib/flow.ml: -------------------------------------------------------------------------------- 1 | let src = Logs.Src.create "spoke.flow" 2 | 3 | module Log = (val Logs.src_log src : Logs.LOG) 4 | 5 | type ctx = { 6 | a_buffer : bytes; 7 | mutable a_pos : int; 8 | mutable a_max : int; 9 | b_buffer : bytes; 10 | mutable b_pos : int; 11 | } 12 | 13 | let ctx () = 14 | { 15 | a_buffer = Bytes.create 128; 16 | a_pos = 0; 17 | a_max = 0; 18 | b_buffer = Bytes.create 128; 19 | b_pos = 0; 20 | } 21 | 22 | let remaining_bytes_of_ctx { a_pos; a_max; a_buffer; _ } = 23 | if a_pos >= a_max then None 24 | else Some (Bytes.sub_string a_buffer a_pos (a_max - a_pos)) 25 | 26 | type error = [ `Not_enough_space | `End_of_input | `Spoke of Spoke.error ] 27 | 28 | let pp_error ppf = function 29 | | `Not_enough_space -> Fmt.pf ppf "Not enough space" 30 | | `End_of_input -> Fmt.pf ppf "End of input" 31 | | `Spoke err -> Spoke.pp_error ppf err 32 | 33 | type 'a t = 34 | | Rd of { buf : bytes; off : int; len : int; k : 'a krd } 35 | | Wr of { str : string; off : int; len : int; k : 'a kwr } 36 | | Done of 'a 37 | | Fail of error 38 | 39 | and 'a krd = [ `End | `Len of int ] -> 'a t 40 | and 'a kwr = int -> 'a t 41 | 42 | exception Leave of error 43 | 44 | let leave_with _ctx error = raise (Leave error) 45 | let safe k ctx = try k ctx with Leave err -> Fail err 46 | let always x _ = x 47 | 48 | module Send = struct 49 | let flush k0 ctx = 50 | if ctx.b_pos > 0 then 51 | let rec k1 n = 52 | if n < ctx.b_pos then 53 | Wr 54 | { 55 | str = Bytes.unsafe_to_string ctx.b_buffer; 56 | off = n; 57 | len = ctx.b_pos - n; 58 | k = (fun m -> k1 (n + m)); 59 | } 60 | else ( 61 | ctx.b_pos <- 0; 62 | k0 ctx) 63 | in 64 | k1 0 65 | else k0 ctx 66 | 67 | let write str ctx = 68 | let max = Bytes.length ctx.b_buffer in 69 | let go j l ctx = 70 | let rem = max - ctx.b_pos in 71 | let len = if l > rem then rem else l in 72 | Bytes.blit_string str j ctx.b_buffer ctx.b_pos len; 73 | ctx.b_pos <- ctx.b_pos + len; 74 | if len < l then leave_with ctx `Not_enough_space 75 | in 76 | go 0 (String.length str) ctx 77 | 78 | let send ctx str = 79 | safe 80 | (fun ctx -> 81 | write str ctx; 82 | flush (always (Done ())) ctx) 83 | ctx 84 | end 85 | 86 | module Recv = struct 87 | let prompt ~required k ctx = 88 | if ctx.a_pos > 0 then ( 89 | let rest = ctx.a_max - ctx.a_pos in 90 | Bytes.blit ctx.a_buffer ctx.a_pos ctx.a_buffer 0 rest; 91 | ctx.a_max <- rest; 92 | ctx.a_pos <- 0); 93 | let rec go off = 94 | if off = Bytes.length ctx.a_buffer then Fail `Not_enough_space 95 | else if off - ctx.a_pos < required then 96 | let k = function 97 | | `Len len -> go (off + len) 98 | | `End -> Fail `End_of_input 99 | in 100 | Rd { buf = ctx.a_buffer; off; len = Bytes.length ctx.a_buffer - off; k } 101 | else ( 102 | ctx.a_max <- off; 103 | safe k ctx) 104 | in 105 | go ctx.a_max 106 | 107 | let recv ctx ~len = 108 | let k ctx = 109 | let str = Bytes.sub_string ctx.a_buffer ctx.a_pos len in 110 | ctx.a_pos <- ctx.a_pos + len; 111 | Done str 112 | in 113 | prompt ~required:len k ctx 114 | end 115 | 116 | let ( let* ) = 117 | let rec go f m len = 118 | match m len with 119 | | Done v -> f v 120 | | Fail err -> Fail err 121 | | Rd { buf; off; len; k } -> Rd { buf; off; len; k = go f k } 122 | | Wr { str; off; len; k } -> 123 | let k0 = function `End -> k 0 | `Len len -> k len in 124 | let k1 = function 0 -> go f k0 `End | len -> go f k0 (`Len len) in 125 | Wr { str; off; len; k = k1 } 126 | in 127 | fun m f -> 128 | match m with 129 | | Done v -> f v 130 | | Fail err -> Fail err 131 | | Rd { buf; off; len; k } -> Rd { buf; off; len; k = go f k } 132 | | Wr { str; off; len; k } -> 133 | let k0 = function `End -> k 0 | `Len len -> k len in 134 | let k1 = function 0 -> go f k0 `End | len -> go f k0 (`Len len) in 135 | Wr { str; off; len; k = k1 } 136 | 137 | let ( let+ ) x f = match x with Ok v -> f v | Error err -> Fail (`Spoke err) 138 | let send = Send.send 139 | let recv = Recv.recv 140 | let return v = Done v 141 | 142 | type cfg = Cfg : 'a Spoke.algorithm * 'a -> cfg 143 | 144 | let handshake_client ctx ?g ~identity password = 145 | let* public = recv ctx ~len:34 in 146 | let+ ciphers = Spoke.ciphers_of_public public in 147 | let+ client, packet = Spoke.hello ?g ~public password in 148 | let* () = send ctx packet in 149 | let* packet = recv ctx ~len:96 in 150 | let+ shared_keys, packet = 151 | Spoke.client_compute ~client ~identity (String.sub packet 0 32) 152 | (String.sub packet 32 64) 153 | in 154 | let* () = send ctx packet in 155 | return (ciphers, shared_keys) 156 | 157 | let handshake_server ctx ?g ~password ~identity (Cfg (algorithm, arguments)) = 158 | let ciphers = Spoke.(AEAD GCM, AEAD ChaCha20_Poly1305) in 159 | let secret, public = 160 | Spoke.generate ?g ~password ~ciphers ~algorithm arguments 161 | in 162 | let* () = send ctx (Spoke.public_to_string public) in 163 | let* packet = recv ctx ~len:32 in 164 | let+ server, (_Y, validator) = 165 | Spoke.server_compute ~secret ~identity packet 166 | in 167 | let* () = send ctx (_Y ^ validator) in 168 | let* packet = recv ctx ~len:64 in 169 | let+ shared_keys = Spoke.server_finalize ~server packet in 170 | return (ciphers, shared_keys) 171 | 172 | type 'k cipher_block = (module Mirage_crypto.AEAD with type key = 'k) 173 | 174 | let module_of : type k. k Spoke.aead -> k cipher_block = function 175 | | Spoke.GCM -> (module Mirage_crypto.AES.GCM) 176 | | Spoke.CCM16 -> (module Mirage_crypto.AES.CCM16) 177 | | Spoke.ChaCha20_Poly1305 -> (module Mirage_crypto.Chacha20) 178 | 179 | module Make (Flow : Mirage_flow.S) = struct 180 | open Lwt.Infix 181 | 182 | let ( >>? ) = Lwt_result.bind 183 | let reword_error f = function Ok v -> Ok v | Error err -> Error (f err) 184 | 185 | type symmetric = 186 | | Symmetric : { 187 | key : 'k; 188 | nonce : Cstruct.t; 189 | impl : 'k cipher_block; 190 | } 191 | -> symmetric 192 | 193 | external xor_into : 194 | Bigstringaf.t -> 195 | src_off:int -> 196 | Bigstringaf.t -> 197 | dst_off:int -> 198 | len:int -> 199 | unit = "spoke_xor_into_generic_bigarray" 200 | 201 | let xor src dst = 202 | let len = min (Cstruct.length src) (Cstruct.length dst) in 203 | xor_into (Cstruct.to_bigarray src) ~src_off:0 (Cstruct.to_bigarray dst) 204 | ~dst_off:0 ~len 205 | 206 | let xor a b = 207 | let len = min (Cstruct.length a) (Cstruct.length b) in 208 | let res = Cstruct.of_string (Cstruct.to_string b ~off:0 ~len) in 209 | xor a res; 210 | res 211 | 212 | let make_nonce nonce seq = 213 | let seq = 214 | let len = Cstruct.length nonce in 215 | let seq = 216 | let buf = Cstruct.create 8 in 217 | Cstruct.BE.set_uint64 buf 0 seq; 218 | buf 219 | in 220 | let pad = Cstruct.create (len - 8) in 221 | Cstruct.append pad seq 222 | in 223 | Cstruct.to_string (xor nonce seq) 224 | 225 | let make_adata len = 226 | let buf = Cstruct.create 4 in 227 | Cstruct.BE.set_uint16 buf 0 Spoke.version; 228 | Cstruct.BE.set_uint16 buf 2 len; 229 | Cstruct.to_string buf 230 | 231 | let encrypt (Symmetric { key; nonce; impl = (module Cipher_block) }) sequence 232 | buf = 233 | let nonce = make_nonce nonce sequence in 234 | let adata = make_adata (Cstruct.length buf) in 235 | Cipher_block.authenticate_encrypt ~key ~adata ~nonce (Cstruct.to_string buf) 236 | |> Cstruct.of_string 237 | 238 | let decrypt (Symmetric { key; nonce; impl = (module Cipher_block) }) sequence 239 | buf = 240 | let nonce = make_nonce nonce sequence in 241 | let adata = make_adata (Cstruct.length buf - Cipher_block.tag_size) in 242 | Cipher_block.authenticate_decrypt ~key ~adata ~nonce (Cstruct.to_string buf) 243 | |> Option.map Cstruct.of_string 244 | 245 | let symmetric_of_key_nonce_and_cipher key_nonce (Spoke.AEAD aead) = 246 | let key_len = 247 | match aead with 248 | | Spoke.GCM -> 32 249 | | Spoke.CCM16 -> 32 250 | | Spoke.ChaCha20_Poly1305 -> 32 251 | in 252 | let nonce_len = 253 | match aead with 254 | | Spoke.GCM -> 12 255 | | Spoke.CCM16 -> 12 256 | | Spoke.ChaCha20_Poly1305 -> 12 257 | in 258 | let module Cipher_block = (val module_of aead) in 259 | let key = String.sub key_nonce 0 key_len in 260 | Log.debug (fun m -> 261 | m "Private key: %s" (Base64.encode_exn (String.sub key_nonce 0 key_len))); 262 | let key = Cipher_block.of_secret key in 263 | let nonce = Cstruct.of_string ~off:key_len ~len:nonce_len key_nonce in 264 | Symmetric { key; nonce; impl = (module Cipher_block) } 265 | 266 | type flow = { 267 | flow : Flow.flow; 268 | recv : symmetric; 269 | send : symmetric; 270 | recv_record : Cstruct.t; 271 | send_record : Cstruct.t; 272 | mutable recv_seq : int64; 273 | mutable send_seq : int64; 274 | recv_queue : (char, Bigarray.int8_unsigned_elt) Ke.Rke.t; 275 | send_queue : (char, Bigarray.int8_unsigned_elt) Ke.Rke.t; 276 | } 277 | 278 | let blit0 src src_off dst dst_off len = 279 | let dst = Cstruct.of_bigarray dst ~off:dst_off ~len in 280 | Cstruct.blit src src_off dst 0 len 281 | 282 | let blit1 src src_off dst dst_off len = 283 | let src = Cstruct.of_bigarray src ~off:src_off ~len in 284 | Cstruct.blit_to_bytes src 0 dst dst_off len 285 | 286 | let run queue flow fiber = 287 | let cs_wr = Cstruct.create 128 in 288 | let allocator len = Cstruct.sub cs_wr 0 len in 289 | let rec go = function 290 | | Done v -> Lwt.return_ok v 291 | | Fail (#error as err) -> Lwt.return_error err 292 | | Rd { buf; off; len; k } as fiber -> 293 | if Ke.Rke.is_empty queue then ( 294 | Flow.read flow >|= reword_error (fun err -> `Flow err) >>? function 295 | | `Eof -> go (k `End) 296 | | `Data cs -> 297 | Ke.Rke.N.push queue ~blit:blit0 ~length:Cstruct.length cs; 298 | go fiber) 299 | else 300 | let len = min len (Ke.Rke.length queue) in 301 | Ke.Rke.N.keep_exn queue ~blit:blit1 ~length:Bytes.length ~off ~len 302 | buf; 303 | Ke.Rke.N.shift_exn queue len; 304 | go (k (`Len len)) 305 | | Wr { str; off; len; k } -> 306 | let cs = Cstruct.of_string ~allocator ~off ~len str in 307 | Flow.write flow cs >|= reword_error (fun err -> `Flow_write err) 308 | >>? fun () -> go (k len) 309 | in 310 | go fiber 311 | 312 | let max_record = 0xFFFF 313 | 314 | let client_of_flow ?g ~identity ~password flow = 315 | let ctx = ctx () in 316 | let queue = Ke.Rke.create ~capacity:128 Bigarray.char in 317 | run queue flow (handshake_client ctx ?g ~identity password) 318 | >>? fun ((cipher0, cipher1), (k0, k1)) -> 319 | let rem = remaining_bytes_of_ctx ctx in 320 | let rem = Option.value ~default:"" rem in 321 | let recv = symmetric_of_key_nonce_and_cipher k0 cipher0 in 322 | let send = symmetric_of_key_nonce_and_cipher k1 cipher1 in 323 | let recv_queue = Ke.Rke.create ~capacity:0x10000 Bigarray.char in 324 | let blit src src_off dst dst_off len = 325 | Bigstringaf.blit_from_string src ~src_off dst ~dst_off ~len 326 | in 327 | Ke.Rke.N.push recv_queue ~blit ~length:String.length rem; 328 | let send_queue = Ke.Rke.create ~capacity:0x10000 Bigarray.char in 329 | let recv_record = 330 | let (Symmetric { impl = (module Cipher_block); _ }) = recv in 331 | Cstruct.create (2 + max_record + Cipher_block.tag_size) 332 | in 333 | let send_record = 334 | let (Symmetric { impl = (module Cipher_block); _ }) = send in 335 | Cstruct.create (2 + max_record + Cipher_block.tag_size) 336 | in 337 | Lwt.return_ok 338 | { 339 | flow; 340 | recv; 341 | send; 342 | recv_record; 343 | send_record; 344 | recv_seq = 0L; 345 | send_seq = 0L; 346 | recv_queue; 347 | send_queue; 348 | } 349 | 350 | let server_of_flow ?g ~cfg ~identity ~password flow = 351 | let ctx = ctx () in 352 | let queue = Ke.Rke.create ~capacity:128 Bigarray.char in 353 | run queue flow (handshake_server ctx ?g ~identity ~password cfg) 354 | >>? fun ((cipher0, cipher1), (k0, k1)) -> 355 | let rem = remaining_bytes_of_ctx ctx in 356 | let rem = Option.value ~default:"" rem in 357 | Log.debug (fun m -> 358 | m "Remains %d byte(s) from the client." (String.length rem)); 359 | let recv = symmetric_of_key_nonce_and_cipher k1 cipher1 in 360 | let send = symmetric_of_key_nonce_and_cipher k0 cipher0 in 361 | let recv_queue = Ke.Rke.create ~capacity:0x10000 Bigarray.char in 362 | let blit src src_off dst dst_off len = 363 | Bigstringaf.blit_from_string src ~src_off dst ~dst_off ~len 364 | in 365 | Ke.Rke.N.push recv_queue ~blit ~length:String.length rem; 366 | let send_queue = Ke.Rke.create ~capacity:0x10000 Bigarray.char in 367 | let recv_record = 368 | let (Symmetric { impl = (module Cipher_block); _ }) = recv in 369 | Cstruct.create (2 + max_record + Cipher_block.tag_size) 370 | in 371 | let send_record = 372 | let (Symmetric { impl = (module Cipher_block); _ }) = send in 373 | Cstruct.create (2 + max_record + Cipher_block.tag_size) 374 | in 375 | Lwt.return_ok 376 | { 377 | flow; 378 | recv; 379 | send; 380 | recv_record; 381 | send_record; 382 | recv_seq = 0L; 383 | send_seq = 0L; 384 | recv_queue; 385 | send_queue; 386 | } 387 | 388 | type write_error = 389 | [ `Closed | `Flow of Flow.error | `Flow_write of Flow.write_error | error ] 390 | 391 | let pp_write_error ppf = function 392 | | `Closed -> Flow.pp_write_error ppf `Closed 393 | | `Flow err -> Flow.pp_error ppf err 394 | | `Flow_write err -> Flow.pp_write_error ppf err 395 | | #error as err -> pp_error ppf err 396 | 397 | type error = [ `Flow of Flow.error | `Corrupted ] 398 | 399 | let pp_error ppf = function 400 | | `Flow err -> Flow.pp_error ppf err 401 | | `Corrupted -> Fmt.pf ppf "Communication corrupted" 402 | 403 | let get_record record queue symmetric = 404 | let (Symmetric { impl = (module Cipher_block); _ }) = symmetric in 405 | match Ke.Rke.length queue with 406 | | 0 -> `Await_hdr 407 | | 1 -> `Await_rec 1 408 | | 2 | _ -> 409 | let blit src src_off dst dst_off len = 410 | let src = Cstruct.of_bigarray src ~off:src_off ~len in 411 | Cstruct.blit src 0 dst dst_off len 412 | in 413 | Ke.Rke.N.keep_exn queue ~blit ~length:Cstruct.length record ~len:2; 414 | let len = Cstruct.BE.get_uint16 record 0 in 415 | if Ke.Rke.length queue >= len then ( 416 | Ke.Rke.N.keep_exn queue ~blit ~length:Cstruct.length record ~len; 417 | Ke.Rke.N.shift_exn queue len; 418 | `Record (Cstruct.sub record 2 (len - 2))) 419 | else `Await_rec (len - Ke.Rke.length queue) 420 | 421 | let rec read flow = 422 | match get_record flow.recv_record flow.recv_queue flow.recv with 423 | | `Record buf -> ( 424 | match decrypt flow.recv flow.recv_seq buf with 425 | | Some buf (* copy *) -> 426 | flow.recv_seq <- Int64.succ flow.recv_seq; 427 | Lwt.return_ok (`Data buf) 428 | | None -> Lwt.return_error `Corrupted) 429 | | (`Await_hdr | `Await_rec _) as await -> ( 430 | Flow.read flow.flow >>= function 431 | | Error err -> Lwt.return_error (`Flow err) 432 | | Ok `Eof -> 433 | if await = `Await_hdr then Lwt.return_ok `Eof 434 | else Lwt.return_error `Corrupted 435 | | Ok (`Data buf) -> 436 | let blit src src_off dst dst_off len = 437 | let dst = Cstruct.of_bigarray dst ~off:dst_off ~len in 438 | Cstruct.blit src src_off dst 0 len 439 | in 440 | Ke.Rke.N.push flow.recv_queue ~blit ~length:Cstruct.length buf; 441 | read flow) 442 | 443 | let record ~dst ~sequence queue symmetric = 444 | let len = min max_record (Ke.Rke.length queue) in 445 | let blit src src_off dst dst_off len = 446 | let src = Cstruct.of_bigarray src ~off:src_off ~len in 447 | Cstruct.blit src 0 dst dst_off len 448 | in 449 | Ke.Rke.N.keep_exn queue ~length:Cstruct.length ~blit ~off:2 ~len dst; 450 | let buf (* copy *) = encrypt symmetric sequence (Cstruct.sub dst 2 len) in 451 | Ke.Rke.N.shift_exn queue len; 452 | let len = 2 + Cstruct.length buf in 453 | Cstruct.BE.set_uint16 dst 0 len; 454 | Cstruct.blit buf 0 dst 2 (Cstruct.length buf); 455 | Cstruct.sub dst 0 len 456 | 457 | let rec flush flow = 458 | if not (Ke.Rke.is_empty flow.send_queue) then ( 459 | let record = 460 | record ~dst:flow.send_record ~sequence:flow.send_seq flow.send_queue 461 | flow.send 462 | in 463 | flow.send_seq <- Int64.succ flow.send_seq; 464 | Flow.write flow.flow record >>? fun () -> 465 | (* XXX(dinosaure): reset [send_record]? *) 466 | flush flow) 467 | else Lwt.return_ok () 468 | 469 | let write flow data = 470 | Ke.Rke.N.push flow.send_queue ~blit:blit0 ~length:Cstruct.length data; 471 | flush flow >>= function 472 | | Ok () -> Lwt.return_ok () 473 | | Error err -> Lwt.return_error (`Flow_write err) 474 | 475 | let read flow = read flow 476 | let write flow data = write flow data 477 | 478 | let writev flow css = 479 | let rec go = function 480 | | [] -> Lwt.return_ok () 481 | | cs :: css -> ( 482 | write flow cs >>= function 483 | | Ok () -> go css 484 | | Error err -> Lwt.return_error err) 485 | in 486 | go css 487 | 488 | let close { flow; _ } = Flow.close flow 489 | let shutdown { flow; _ } value = Flow.shutdown flow value 490 | end 491 | -------------------------------------------------------------------------------- /lib/ed25519_ref10_fe_25_5.h: -------------------------------------------------------------------------------- 1 | /* 2 | * ISC License 3 | * 4 | * Copyright (c) 2013-2022 5 | * Frank Denis 6 | * 7 | * Permission to use, copy, modify, and/or distribute this software for any 8 | * purpose with or without fee is hereby granted, provided that the above 9 | * copyright notice and this permission notice appear in all copies. 10 | * 11 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 12 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 13 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 14 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 15 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 16 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 17 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 18 | */ 19 | 20 | #include 21 | #include "utils.h" 22 | 23 | /* 24 | h = 0 25 | */ 26 | 27 | static inline void 28 | fe25519_0(fe25519 h) 29 | { 30 | memset(&h[0], 0, 10 * sizeof h[0]); 31 | } 32 | 33 | /* 34 | h = 1 35 | */ 36 | 37 | static inline void 38 | fe25519_1(fe25519 h) 39 | { 40 | h[0] = 1; 41 | h[1] = 0; 42 | memset(&h[2], 0, 8 * sizeof h[0]); 43 | } 44 | 45 | /* 46 | h = f + g 47 | Can overlap h with f or g. 48 | * 49 | Preconditions: 50 | |f| bounded by 1.1*2^25,1.1*2^24,1.1*2^25,1.1*2^24,etc. 51 | |g| bounded by 1.1*2^25,1.1*2^24,1.1*2^25,1.1*2^24,etc. 52 | * 53 | Postconditions: 54 | |h| bounded by 1.1*2^26,1.1*2^25,1.1*2^26,1.1*2^25,etc. 55 | */ 56 | 57 | static inline void 58 | fe25519_add(fe25519 h, const fe25519 f, const fe25519 g) 59 | { 60 | int32_t h0 = f[0] + g[0]; 61 | int32_t h1 = f[1] + g[1]; 62 | int32_t h2 = f[2] + g[2]; 63 | int32_t h3 = f[3] + g[3]; 64 | int32_t h4 = f[4] + g[4]; 65 | int32_t h5 = f[5] + g[5]; 66 | int32_t h6 = f[6] + g[6]; 67 | int32_t h7 = f[7] + g[7]; 68 | int32_t h8 = f[8] + g[8]; 69 | int32_t h9 = f[9] + g[9]; 70 | 71 | h[0] = h0; 72 | h[1] = h1; 73 | h[2] = h2; 74 | h[3] = h3; 75 | h[4] = h4; 76 | h[5] = h5; 77 | h[6] = h6; 78 | h[7] = h7; 79 | h[8] = h8; 80 | h[9] = h9; 81 | } 82 | 83 | /* 84 | h = f - g 85 | Can overlap h with f or g. 86 | * 87 | Preconditions: 88 | |f| bounded by 1.1*2^25,1.1*2^24,1.1*2^25,1.1*2^24,etc. 89 | |g| bounded by 1.1*2^25,1.1*2^24,1.1*2^25,1.1*2^24,etc. 90 | * 91 | Postconditions: 92 | |h| bounded by 1.1*2^26,1.1*2^25,1.1*2^26,1.1*2^25,etc. 93 | */ 94 | 95 | static void 96 | fe25519_sub(fe25519 h, const fe25519 f, const fe25519 g) 97 | { 98 | int32_t h0 = f[0] - g[0]; 99 | int32_t h1 = f[1] - g[1]; 100 | int32_t h2 = f[2] - g[2]; 101 | int32_t h3 = f[3] - g[3]; 102 | int32_t h4 = f[4] - g[4]; 103 | int32_t h5 = f[5] - g[5]; 104 | int32_t h6 = f[6] - g[6]; 105 | int32_t h7 = f[7] - g[7]; 106 | int32_t h8 = f[8] - g[8]; 107 | int32_t h9 = f[9] - g[9]; 108 | 109 | h[0] = h0; 110 | h[1] = h1; 111 | h[2] = h2; 112 | h[3] = h3; 113 | h[4] = h4; 114 | h[5] = h5; 115 | h[6] = h6; 116 | h[7] = h7; 117 | h[8] = h8; 118 | h[9] = h9; 119 | } 120 | 121 | /* 122 | h = -f 123 | * 124 | Preconditions: 125 | |f| bounded by 1.1*2^25,1.1*2^24,1.1*2^25,1.1*2^24,etc. 126 | * 127 | Postconditions: 128 | |h| bounded by 1.1*2^25,1.1*2^24,1.1*2^25,1.1*2^24,etc. 129 | */ 130 | 131 | static inline void 132 | fe25519_neg(fe25519 h, const fe25519 f) 133 | { 134 | int32_t h0 = -f[0]; 135 | int32_t h1 = -f[1]; 136 | int32_t h2 = -f[2]; 137 | int32_t h3 = -f[3]; 138 | int32_t h4 = -f[4]; 139 | int32_t h5 = -f[5]; 140 | int32_t h6 = -f[6]; 141 | int32_t h7 = -f[7]; 142 | int32_t h8 = -f[8]; 143 | int32_t h9 = -f[9]; 144 | 145 | h[0] = h0; 146 | h[1] = h1; 147 | h[2] = h2; 148 | h[3] = h3; 149 | h[4] = h4; 150 | h[5] = h5; 151 | h[6] = h6; 152 | h[7] = h7; 153 | h[8] = h8; 154 | h[9] = h9; 155 | } 156 | 157 | /* 158 | Replace (f,g) with (g,g) if b == 1; 159 | replace (f,g) with (f,g) if b == 0. 160 | * 161 | Preconditions: b in {0,1}. 162 | */ 163 | 164 | static void 165 | fe25519_cmov(fe25519 f, const fe25519 g, unsigned int b) 166 | { 167 | uint32_t mask = (uint32_t) (-(int32_t) b); 168 | int32_t f0, f1, f2, f3, f4, f5, f6, f7, f8, f9; 169 | int32_t x0, x1, x2, x3, x4, x5, x6, x7, x8, x9; 170 | 171 | f0 = f[0]; 172 | f1 = f[1]; 173 | f2 = f[2]; 174 | f3 = f[3]; 175 | f4 = f[4]; 176 | f5 = f[5]; 177 | f6 = f[6]; 178 | f7 = f[7]; 179 | f8 = f[8]; 180 | f9 = f[9]; 181 | 182 | x0 = f0 ^ g[0]; 183 | x1 = f1 ^ g[1]; 184 | x2 = f2 ^ g[2]; 185 | x3 = f3 ^ g[3]; 186 | x4 = f4 ^ g[4]; 187 | x5 = f5 ^ g[5]; 188 | x6 = f6 ^ g[6]; 189 | x7 = f7 ^ g[7]; 190 | x8 = f8 ^ g[8]; 191 | x9 = f9 ^ g[9]; 192 | 193 | #ifdef HAVE_INLINE_ASM 194 | __asm__ __volatile__("" : "+r"(mask)); 195 | #endif 196 | 197 | x0 &= mask; 198 | x1 &= mask; 199 | x2 &= mask; 200 | x3 &= mask; 201 | x4 &= mask; 202 | x5 &= mask; 203 | x6 &= mask; 204 | x7 &= mask; 205 | x8 &= mask; 206 | x9 &= mask; 207 | 208 | f[0] = f0 ^ x0; 209 | f[1] = f1 ^ x1; 210 | f[2] = f2 ^ x2; 211 | f[3] = f3 ^ x3; 212 | f[4] = f4 ^ x4; 213 | f[5] = f5 ^ x5; 214 | f[6] = f6 ^ x6; 215 | f[7] = f7 ^ x7; 216 | f[8] = f8 ^ x8; 217 | f[9] = f9 ^ x9; 218 | } 219 | 220 | static void 221 | fe25519_cswap(fe25519 f, fe25519 g, unsigned int b) 222 | { 223 | uint32_t mask = (uint32_t) (-(int64_t) b); 224 | int32_t f0, f1, f2, f3, f4, f5, f6, f7, f8, f9; 225 | int32_t g0, g1, g2, g3, g4, g5, g6, g7, g8, g9; 226 | int32_t x0, x1, x2, x3, x4, x5, x6, x7, x8, x9; 227 | 228 | f0 = f[0]; 229 | f1 = f[1]; 230 | f2 = f[2]; 231 | f3 = f[3]; 232 | f4 = f[4]; 233 | f5 = f[5]; 234 | f6 = f[6]; 235 | f7 = f[7]; 236 | f8 = f[8]; 237 | f9 = f[9]; 238 | 239 | g0 = g[0]; 240 | g1 = g[1]; 241 | g2 = g[2]; 242 | g3 = g[3]; 243 | g4 = g[4]; 244 | g5 = g[5]; 245 | g6 = g[6]; 246 | g7 = g[7]; 247 | g8 = g[8]; 248 | g9 = g[9]; 249 | 250 | x0 = f0 ^ g0; 251 | x1 = f1 ^ g1; 252 | x2 = f2 ^ g2; 253 | x3 = f3 ^ g3; 254 | x4 = f4 ^ g4; 255 | x5 = f5 ^ g5; 256 | x6 = f6 ^ g6; 257 | x7 = f7 ^ g7; 258 | x8 = f8 ^ g8; 259 | x9 = f9 ^ g9; 260 | 261 | #ifdef HAVE_INLINE_ASM 262 | __asm__ __volatile__("" : "+r"(mask)); 263 | #endif 264 | 265 | x0 &= mask; 266 | x1 &= mask; 267 | x2 &= mask; 268 | x3 &= mask; 269 | x4 &= mask; 270 | x5 &= mask; 271 | x6 &= mask; 272 | x7 &= mask; 273 | x8 &= mask; 274 | x9 &= mask; 275 | 276 | f[0] = f0 ^ x0; 277 | f[1] = f1 ^ x1; 278 | f[2] = f2 ^ x2; 279 | f[3] = f3 ^ x3; 280 | f[4] = f4 ^ x4; 281 | f[5] = f5 ^ x5; 282 | f[6] = f6 ^ x6; 283 | f[7] = f7 ^ x7; 284 | f[8] = f8 ^ x8; 285 | f[9] = f9 ^ x9; 286 | 287 | g[0] = g0 ^ x0; 288 | g[1] = g1 ^ x1; 289 | g[2] = g2 ^ x2; 290 | g[3] = g3 ^ x3; 291 | g[4] = g4 ^ x4; 292 | g[5] = g5 ^ x5; 293 | g[6] = g6 ^ x6; 294 | g[7] = g7 ^ x7; 295 | g[8] = g8 ^ x8; 296 | g[9] = g9 ^ x9; 297 | } 298 | 299 | /* 300 | h = f 301 | */ 302 | 303 | static inline void 304 | fe25519_copy(fe25519 h, const fe25519 f) 305 | { 306 | memcpy(h, f, 10 * 4); 307 | } 308 | 309 | /* 310 | return 1 if f is in {1,3,5,...,q-2} 311 | return 0 if f is in {0,2,4,...,q-1} 312 | 313 | Preconditions: 314 | |f| bounded by 1.1*2^26,1.1*2^25,1.1*2^26,1.1*2^25,etc. 315 | */ 316 | 317 | static inline int 318 | fe25519_isnegative(const fe25519 f) 319 | { 320 | unsigned char s[32]; 321 | 322 | fe25519_tobytes(s, f); 323 | 324 | return s[0] & 1; 325 | } 326 | 327 | /* 328 | return 1 if f == 0 329 | return 0 if f != 0 330 | 331 | Preconditions: 332 | |f| bounded by 1.1*2^26,1.1*2^25,1.1*2^26,1.1*2^25,etc. 333 | */ 334 | 335 | static inline int 336 | fe25519_iszero(const fe25519 f) 337 | { 338 | unsigned char s[32]; 339 | 340 | fe25519_tobytes(s, f); 341 | 342 | return is_zero(s, 32); 343 | } 344 | 345 | /* 346 | h = f * g 347 | Can overlap h with f or g. 348 | * 349 | Preconditions: 350 | |f| bounded by 1.65*2^26,1.65*2^25,1.65*2^26,1.65*2^25,etc. 351 | |g| bounded by 1.65*2^26,1.65*2^25,1.65*2^26,1.65*2^25,etc. 352 | * 353 | Postconditions: 354 | |h| bounded by 1.01*2^25,1.01*2^24,1.01*2^25,1.01*2^24,etc. 355 | */ 356 | 357 | /* 358 | Notes on implementation strategy: 359 | * 360 | Using schoolbook multiplication. 361 | Karatsuba would save a little in some cost models. 362 | * 363 | Most multiplications by 2 and 19 are 32-bit precomputations; 364 | cheaper than 64-bit postcomputations. 365 | * 366 | There is one remaining multiplication by 19 in the carry chain; 367 | one *19 precomputation can be merged into this, 368 | but the resulting data flow is considerably less clean. 369 | * 370 | There are 12 carries below. 371 | 10 of them are 2-way parallelizable and vectorizable. 372 | Can get away with 11 carries, but then data flow is much deeper. 373 | * 374 | With tighter constraints on inputs can squeeze carries into int32. 375 | */ 376 | 377 | static void 378 | fe25519_mul(fe25519 h, const fe25519 f, const fe25519 g) 379 | { 380 | int32_t f0 = f[0]; 381 | int32_t f1 = f[1]; 382 | int32_t f2 = f[2]; 383 | int32_t f3 = f[3]; 384 | int32_t f4 = f[4]; 385 | int32_t f5 = f[5]; 386 | int32_t f6 = f[6]; 387 | int32_t f7 = f[7]; 388 | int32_t f8 = f[8]; 389 | int32_t f9 = f[9]; 390 | 391 | int32_t g0 = g[0]; 392 | int32_t g1 = g[1]; 393 | int32_t g2 = g[2]; 394 | int32_t g3 = g[3]; 395 | int32_t g4 = g[4]; 396 | int32_t g5 = g[5]; 397 | int32_t g6 = g[6]; 398 | int32_t g7 = g[7]; 399 | int32_t g8 = g[8]; 400 | int32_t g9 = g[9]; 401 | 402 | int32_t g1_19 = 19 * g1; /* 1.959375*2^29 */ 403 | int32_t g2_19 = 19 * g2; /* 1.959375*2^30; still ok */ 404 | int32_t g3_19 = 19 * g3; 405 | int32_t g4_19 = 19 * g4; 406 | int32_t g5_19 = 19 * g5; 407 | int32_t g6_19 = 19 * g6; 408 | int32_t g7_19 = 19 * g7; 409 | int32_t g8_19 = 19 * g8; 410 | int32_t g9_19 = 19 * g9; 411 | int32_t f1_2 = 2 * f1; 412 | int32_t f3_2 = 2 * f3; 413 | int32_t f5_2 = 2 * f5; 414 | int32_t f7_2 = 2 * f7; 415 | int32_t f9_2 = 2 * f9; 416 | 417 | int64_t f0g0 = f0 * (int64_t) g0; 418 | int64_t f0g1 = f0 * (int64_t) g1; 419 | int64_t f0g2 = f0 * (int64_t) g2; 420 | int64_t f0g3 = f0 * (int64_t) g3; 421 | int64_t f0g4 = f0 * (int64_t) g4; 422 | int64_t f0g5 = f0 * (int64_t) g5; 423 | int64_t f0g6 = f0 * (int64_t) g6; 424 | int64_t f0g7 = f0 * (int64_t) g7; 425 | int64_t f0g8 = f0 * (int64_t) g8; 426 | int64_t f0g9 = f0 * (int64_t) g9; 427 | int64_t f1g0 = f1 * (int64_t) g0; 428 | int64_t f1g1_2 = f1_2 * (int64_t) g1; 429 | int64_t f1g2 = f1 * (int64_t) g2; 430 | int64_t f1g3_2 = f1_2 * (int64_t) g3; 431 | int64_t f1g4 = f1 * (int64_t) g4; 432 | int64_t f1g5_2 = f1_2 * (int64_t) g5; 433 | int64_t f1g6 = f1 * (int64_t) g6; 434 | int64_t f1g7_2 = f1_2 * (int64_t) g7; 435 | int64_t f1g8 = f1 * (int64_t) g8; 436 | int64_t f1g9_38 = f1_2 * (int64_t) g9_19; 437 | int64_t f2g0 = f2 * (int64_t) g0; 438 | int64_t f2g1 = f2 * (int64_t) g1; 439 | int64_t f2g2 = f2 * (int64_t) g2; 440 | int64_t f2g3 = f2 * (int64_t) g3; 441 | int64_t f2g4 = f2 * (int64_t) g4; 442 | int64_t f2g5 = f2 * (int64_t) g5; 443 | int64_t f2g6 = f2 * (int64_t) g6; 444 | int64_t f2g7 = f2 * (int64_t) g7; 445 | int64_t f2g8_19 = f2 * (int64_t) g8_19; 446 | int64_t f2g9_19 = f2 * (int64_t) g9_19; 447 | int64_t f3g0 = f3 * (int64_t) g0; 448 | int64_t f3g1_2 = f3_2 * (int64_t) g1; 449 | int64_t f3g2 = f3 * (int64_t) g2; 450 | int64_t f3g3_2 = f3_2 * (int64_t) g3; 451 | int64_t f3g4 = f3 * (int64_t) g4; 452 | int64_t f3g5_2 = f3_2 * (int64_t) g5; 453 | int64_t f3g6 = f3 * (int64_t) g6; 454 | int64_t f3g7_38 = f3_2 * (int64_t) g7_19; 455 | int64_t f3g8_19 = f3 * (int64_t) g8_19; 456 | int64_t f3g9_38 = f3_2 * (int64_t) g9_19; 457 | int64_t f4g0 = f4 * (int64_t) g0; 458 | int64_t f4g1 = f4 * (int64_t) g1; 459 | int64_t f4g2 = f4 * (int64_t) g2; 460 | int64_t f4g3 = f4 * (int64_t) g3; 461 | int64_t f4g4 = f4 * (int64_t) g4; 462 | int64_t f4g5 = f4 * (int64_t) g5; 463 | int64_t f4g6_19 = f4 * (int64_t) g6_19; 464 | int64_t f4g7_19 = f4 * (int64_t) g7_19; 465 | int64_t f4g8_19 = f4 * (int64_t) g8_19; 466 | int64_t f4g9_19 = f4 * (int64_t) g9_19; 467 | int64_t f5g0 = f5 * (int64_t) g0; 468 | int64_t f5g1_2 = f5_2 * (int64_t) g1; 469 | int64_t f5g2 = f5 * (int64_t) g2; 470 | int64_t f5g3_2 = f5_2 * (int64_t) g3; 471 | int64_t f5g4 = f5 * (int64_t) g4; 472 | int64_t f5g5_38 = f5_2 * (int64_t) g5_19; 473 | int64_t f5g6_19 = f5 * (int64_t) g6_19; 474 | int64_t f5g7_38 = f5_2 * (int64_t) g7_19; 475 | int64_t f5g8_19 = f5 * (int64_t) g8_19; 476 | int64_t f5g9_38 = f5_2 * (int64_t) g9_19; 477 | int64_t f6g0 = f6 * (int64_t) g0; 478 | int64_t f6g1 = f6 * (int64_t) g1; 479 | int64_t f6g2 = f6 * (int64_t) g2; 480 | int64_t f6g3 = f6 * (int64_t) g3; 481 | int64_t f6g4_19 = f6 * (int64_t) g4_19; 482 | int64_t f6g5_19 = f6 * (int64_t) g5_19; 483 | int64_t f6g6_19 = f6 * (int64_t) g6_19; 484 | int64_t f6g7_19 = f6 * (int64_t) g7_19; 485 | int64_t f6g8_19 = f6 * (int64_t) g8_19; 486 | int64_t f6g9_19 = f6 * (int64_t) g9_19; 487 | int64_t f7g0 = f7 * (int64_t) g0; 488 | int64_t f7g1_2 = f7_2 * (int64_t) g1; 489 | int64_t f7g2 = f7 * (int64_t) g2; 490 | int64_t f7g3_38 = f7_2 * (int64_t) g3_19; 491 | int64_t f7g4_19 = f7 * (int64_t) g4_19; 492 | int64_t f7g5_38 = f7_2 * (int64_t) g5_19; 493 | int64_t f7g6_19 = f7 * (int64_t) g6_19; 494 | int64_t f7g7_38 = f7_2 * (int64_t) g7_19; 495 | int64_t f7g8_19 = f7 * (int64_t) g8_19; 496 | int64_t f7g9_38 = f7_2 * (int64_t) g9_19; 497 | int64_t f8g0 = f8 * (int64_t) g0; 498 | int64_t f8g1 = f8 * (int64_t) g1; 499 | int64_t f8g2_19 = f8 * (int64_t) g2_19; 500 | int64_t f8g3_19 = f8 * (int64_t) g3_19; 501 | int64_t f8g4_19 = f8 * (int64_t) g4_19; 502 | int64_t f8g5_19 = f8 * (int64_t) g5_19; 503 | int64_t f8g6_19 = f8 * (int64_t) g6_19; 504 | int64_t f8g7_19 = f8 * (int64_t) g7_19; 505 | int64_t f8g8_19 = f8 * (int64_t) g8_19; 506 | int64_t f8g9_19 = f8 * (int64_t) g9_19; 507 | int64_t f9g0 = f9 * (int64_t) g0; 508 | int64_t f9g1_38 = f9_2 * (int64_t) g1_19; 509 | int64_t f9g2_19 = f9 * (int64_t) g2_19; 510 | int64_t f9g3_38 = f9_2 * (int64_t) g3_19; 511 | int64_t f9g4_19 = f9 * (int64_t) g4_19; 512 | int64_t f9g5_38 = f9_2 * (int64_t) g5_19; 513 | int64_t f9g6_19 = f9 * (int64_t) g6_19; 514 | int64_t f9g7_38 = f9_2 * (int64_t) g7_19; 515 | int64_t f9g8_19 = f9 * (int64_t) g8_19; 516 | int64_t f9g9_38 = f9_2 * (int64_t) g9_19; 517 | 518 | int64_t h0 = f0g0 + f1g9_38 + f2g8_19 + f3g7_38 + f4g6_19 + f5g5_38 + 519 | f6g4_19 + f7g3_38 + f8g2_19 + f9g1_38; 520 | int64_t h1 = f0g1 + f1g0 + f2g9_19 + f3g8_19 + f4g7_19 + f5g6_19 + f6g5_19 + 521 | f7g4_19 + f8g3_19 + f9g2_19; 522 | int64_t h2 = f0g2 + f1g1_2 + f2g0 + f3g9_38 + f4g8_19 + f5g7_38 + f6g6_19 + 523 | f7g5_38 + f8g4_19 + f9g3_38; 524 | int64_t h3 = f0g3 + f1g2 + f2g1 + f3g0 + f4g9_19 + f5g8_19 + f6g7_19 + 525 | f7g6_19 + f8g5_19 + f9g4_19; 526 | int64_t h4 = f0g4 + f1g3_2 + f2g2 + f3g1_2 + f4g0 + f5g9_38 + f6g8_19 + 527 | f7g7_38 + f8g6_19 + f9g5_38; 528 | int64_t h5 = f0g5 + f1g4 + f2g3 + f3g2 + f4g1 + f5g0 + f6g9_19 + f7g8_19 + 529 | f8g7_19 + f9g6_19; 530 | int64_t h6 = f0g6 + f1g5_2 + f2g4 + f3g3_2 + f4g2 + f5g1_2 + f6g0 + 531 | f7g9_38 + f8g8_19 + f9g7_38; 532 | int64_t h7 = f0g7 + f1g6 + f2g5 + f3g4 + f4g3 + f5g2 + f6g1 + f7g0 + 533 | f8g9_19 + f9g8_19; 534 | int64_t h8 = f0g8 + f1g7_2 + f2g6 + f3g5_2 + f4g4 + f5g3_2 + f6g2 + f7g1_2 + 535 | f8g0 + f9g9_38; 536 | int64_t h9 = 537 | f0g9 + f1g8 + f2g7 + f3g6 + f4g5 + f5g4 + f6g3 + f7g2 + f8g1 + f9g0; 538 | 539 | int64_t carry0; 540 | int64_t carry1; 541 | int64_t carry2; 542 | int64_t carry3; 543 | int64_t carry4; 544 | int64_t carry5; 545 | int64_t carry6; 546 | int64_t carry7; 547 | int64_t carry8; 548 | int64_t carry9; 549 | 550 | /* 551 | |h0| <= (1.65*1.65*2^52*(1+19+19+19+19)+1.65*1.65*2^50*(38+38+38+38+38)) 552 | i.e. |h0| <= 1.4*2^60; narrower ranges for h2, h4, h6, h8 553 | |h1| <= (1.65*1.65*2^51*(1+1+19+19+19+19+19+19+19+19)) 554 | i.e. |h1| <= 1.7*2^59; narrower ranges for h3, h5, h7, h9 555 | */ 556 | 557 | carry0 = (h0 + (int64_t)(1L << 25)) >> 26; 558 | h1 += carry0; 559 | h0 -= carry0 * ((uint64_t) 1L << 26); 560 | carry4 = (h4 + (int64_t)(1L << 25)) >> 26; 561 | h5 += carry4; 562 | h4 -= carry4 * ((uint64_t) 1L << 26); 563 | /* |h0| <= 2^25 */ 564 | /* |h4| <= 2^25 */ 565 | /* |h1| <= 1.71*2^59 */ 566 | /* |h5| <= 1.71*2^59 */ 567 | 568 | carry1 = (h1 + (int64_t)(1L << 24)) >> 25; 569 | h2 += carry1; 570 | h1 -= carry1 * ((uint64_t) 1L << 25); 571 | carry5 = (h5 + (int64_t)(1L << 24)) >> 25; 572 | h6 += carry5; 573 | h5 -= carry5 * ((uint64_t) 1L << 25); 574 | /* |h1| <= 2^24; from now on fits into int32 */ 575 | /* |h5| <= 2^24; from now on fits into int32 */ 576 | /* |h2| <= 1.41*2^60 */ 577 | /* |h6| <= 1.41*2^60 */ 578 | 579 | carry2 = (h2 + (int64_t)(1L << 25)) >> 26; 580 | h3 += carry2; 581 | h2 -= carry2 * ((uint64_t) 1L << 26); 582 | carry6 = (h6 + (int64_t)(1L << 25)) >> 26; 583 | h7 += carry6; 584 | h6 -= carry6 * ((uint64_t) 1L << 26); 585 | /* |h2| <= 2^25; from now on fits into int32 unchanged */ 586 | /* |h6| <= 2^25; from now on fits into int32 unchanged */ 587 | /* |h3| <= 1.71*2^59 */ 588 | /* |h7| <= 1.71*2^59 */ 589 | 590 | carry3 = (h3 + (int64_t)(1L << 24)) >> 25; 591 | h4 += carry3; 592 | h3 -= carry3 * ((uint64_t) 1L << 25); 593 | carry7 = (h7 + (int64_t)(1L << 24)) >> 25; 594 | h8 += carry7; 595 | h7 -= carry7 * ((uint64_t) 1L << 25); 596 | /* |h3| <= 2^24; from now on fits into int32 unchanged */ 597 | /* |h7| <= 2^24; from now on fits into int32 unchanged */ 598 | /* |h4| <= 1.72*2^34 */ 599 | /* |h8| <= 1.41*2^60 */ 600 | 601 | carry4 = (h4 + (int64_t)(1L << 25)) >> 26; 602 | h5 += carry4; 603 | h4 -= carry4 * ((uint64_t) 1L << 26); 604 | carry8 = (h8 + (int64_t)(1L << 25)) >> 26; 605 | h9 += carry8; 606 | h8 -= carry8 * ((uint64_t) 1L << 26); 607 | /* |h4| <= 2^25; from now on fits into int32 unchanged */ 608 | /* |h8| <= 2^25; from now on fits into int32 unchanged */ 609 | /* |h5| <= 1.01*2^24 */ 610 | /* |h9| <= 1.71*2^59 */ 611 | 612 | carry9 = (h9 + (int64_t)(1L << 24)) >> 25; 613 | h0 += carry9 * 19; 614 | h9 -= carry9 * ((uint64_t) 1L << 25); 615 | /* |h9| <= 2^24; from now on fits into int32 unchanged */ 616 | /* |h0| <= 1.1*2^39 */ 617 | 618 | carry0 = (h0 + (int64_t)(1L << 25)) >> 26; 619 | h1 += carry0; 620 | h0 -= carry0 * ((uint64_t) 1L << 26); 621 | /* |h0| <= 2^25; from now on fits into int32 unchanged */ 622 | /* |h1| <= 1.01*2^24 */ 623 | 624 | h[0] = (int32_t) h0; 625 | h[1] = (int32_t) h1; 626 | h[2] = (int32_t) h2; 627 | h[3] = (int32_t) h3; 628 | h[4] = (int32_t) h4; 629 | h[5] = (int32_t) h5; 630 | h[6] = (int32_t) h6; 631 | h[7] = (int32_t) h7; 632 | h[8] = (int32_t) h8; 633 | h[9] = (int32_t) h9; 634 | } 635 | 636 | /* 637 | h = f * f 638 | Can overlap h with f. 639 | * 640 | Preconditions: 641 | |f| bounded by 1.65*2^26,1.65*2^25,1.65*2^26,1.65*2^25,etc. 642 | * 643 | Postconditions: 644 | |h| bounded by 1.01*2^25,1.01*2^24,1.01*2^25,1.01*2^24,etc. 645 | */ 646 | 647 | static void 648 | fe25519_sq(fe25519 h, const fe25519 f) 649 | { 650 | int32_t f0 = f[0]; 651 | int32_t f1 = f[1]; 652 | int32_t f2 = f[2]; 653 | int32_t f3 = f[3]; 654 | int32_t f4 = f[4]; 655 | int32_t f5 = f[5]; 656 | int32_t f6 = f[6]; 657 | int32_t f7 = f[7]; 658 | int32_t f8 = f[8]; 659 | int32_t f9 = f[9]; 660 | 661 | int32_t f0_2 = 2 * f0; 662 | int32_t f1_2 = 2 * f1; 663 | int32_t f2_2 = 2 * f2; 664 | int32_t f3_2 = 2 * f3; 665 | int32_t f4_2 = 2 * f4; 666 | int32_t f5_2 = 2 * f5; 667 | int32_t f6_2 = 2 * f6; 668 | int32_t f7_2 = 2 * f7; 669 | int32_t f5_38 = 38 * f5; /* 1.959375*2^30 */ 670 | int32_t f6_19 = 19 * f6; /* 1.959375*2^30 */ 671 | int32_t f7_38 = 38 * f7; /* 1.959375*2^30 */ 672 | int32_t f8_19 = 19 * f8; /* 1.959375*2^30 */ 673 | int32_t f9_38 = 38 * f9; /* 1.959375*2^30 */ 674 | 675 | int64_t f0f0 = f0 * (int64_t) f0; 676 | int64_t f0f1_2 = f0_2 * (int64_t) f1; 677 | int64_t f0f2_2 = f0_2 * (int64_t) f2; 678 | int64_t f0f3_2 = f0_2 * (int64_t) f3; 679 | int64_t f0f4_2 = f0_2 * (int64_t) f4; 680 | int64_t f0f5_2 = f0_2 * (int64_t) f5; 681 | int64_t f0f6_2 = f0_2 * (int64_t) f6; 682 | int64_t f0f7_2 = f0_2 * (int64_t) f7; 683 | int64_t f0f8_2 = f0_2 * (int64_t) f8; 684 | int64_t f0f9_2 = f0_2 * (int64_t) f9; 685 | int64_t f1f1_2 = f1_2 * (int64_t) f1; 686 | int64_t f1f2_2 = f1_2 * (int64_t) f2; 687 | int64_t f1f3_4 = f1_2 * (int64_t) f3_2; 688 | int64_t f1f4_2 = f1_2 * (int64_t) f4; 689 | int64_t f1f5_4 = f1_2 * (int64_t) f5_2; 690 | int64_t f1f6_2 = f1_2 * (int64_t) f6; 691 | int64_t f1f7_4 = f1_2 * (int64_t) f7_2; 692 | int64_t f1f8_2 = f1_2 * (int64_t) f8; 693 | int64_t f1f9_76 = f1_2 * (int64_t) f9_38; 694 | int64_t f2f2 = f2 * (int64_t) f2; 695 | int64_t f2f3_2 = f2_2 * (int64_t) f3; 696 | int64_t f2f4_2 = f2_2 * (int64_t) f4; 697 | int64_t f2f5_2 = f2_2 * (int64_t) f5; 698 | int64_t f2f6_2 = f2_2 * (int64_t) f6; 699 | int64_t f2f7_2 = f2_2 * (int64_t) f7; 700 | int64_t f2f8_38 = f2_2 * (int64_t) f8_19; 701 | int64_t f2f9_38 = f2 * (int64_t) f9_38; 702 | int64_t f3f3_2 = f3_2 * (int64_t) f3; 703 | int64_t f3f4_2 = f3_2 * (int64_t) f4; 704 | int64_t f3f5_4 = f3_2 * (int64_t) f5_2; 705 | int64_t f3f6_2 = f3_2 * (int64_t) f6; 706 | int64_t f3f7_76 = f3_2 * (int64_t) f7_38; 707 | int64_t f3f8_38 = f3_2 * (int64_t) f8_19; 708 | int64_t f3f9_76 = f3_2 * (int64_t) f9_38; 709 | int64_t f4f4 = f4 * (int64_t) f4; 710 | int64_t f4f5_2 = f4_2 * (int64_t) f5; 711 | int64_t f4f6_38 = f4_2 * (int64_t) f6_19; 712 | int64_t f4f7_38 = f4 * (int64_t) f7_38; 713 | int64_t f4f8_38 = f4_2 * (int64_t) f8_19; 714 | int64_t f4f9_38 = f4 * (int64_t) f9_38; 715 | int64_t f5f5_38 = f5 * (int64_t) f5_38; 716 | int64_t f5f6_38 = f5_2 * (int64_t) f6_19; 717 | int64_t f5f7_76 = f5_2 * (int64_t) f7_38; 718 | int64_t f5f8_38 = f5_2 * (int64_t) f8_19; 719 | int64_t f5f9_76 = f5_2 * (int64_t) f9_38; 720 | int64_t f6f6_19 = f6 * (int64_t) f6_19; 721 | int64_t f6f7_38 = f6 * (int64_t) f7_38; 722 | int64_t f6f8_38 = f6_2 * (int64_t) f8_19; 723 | int64_t f6f9_38 = f6 * (int64_t) f9_38; 724 | int64_t f7f7_38 = f7 * (int64_t) f7_38; 725 | int64_t f7f8_38 = f7_2 * (int64_t) f8_19; 726 | int64_t f7f9_76 = f7_2 * (int64_t) f9_38; 727 | int64_t f8f8_19 = f8 * (int64_t) f8_19; 728 | int64_t f8f9_38 = f8 * (int64_t) f9_38; 729 | int64_t f9f9_38 = f9 * (int64_t) f9_38; 730 | 731 | int64_t h0 = f0f0 + f1f9_76 + f2f8_38 + f3f7_76 + f4f6_38 + f5f5_38; 732 | int64_t h1 = f0f1_2 + f2f9_38 + f3f8_38 + f4f7_38 + f5f6_38; 733 | int64_t h2 = f0f2_2 + f1f1_2 + f3f9_76 + f4f8_38 + f5f7_76 + f6f6_19; 734 | int64_t h3 = f0f3_2 + f1f2_2 + f4f9_38 + f5f8_38 + f6f7_38; 735 | int64_t h4 = f0f4_2 + f1f3_4 + f2f2 + f5f9_76 + f6f8_38 + f7f7_38; 736 | int64_t h5 = f0f5_2 + f1f4_2 + f2f3_2 + f6f9_38 + f7f8_38; 737 | int64_t h6 = f0f6_2 + f1f5_4 + f2f4_2 + f3f3_2 + f7f9_76 + f8f8_19; 738 | int64_t h7 = f0f7_2 + f1f6_2 + f2f5_2 + f3f4_2 + f8f9_38; 739 | int64_t h8 = f0f8_2 + f1f7_4 + f2f6_2 + f3f5_4 + f4f4 + f9f9_38; 740 | int64_t h9 = f0f9_2 + f1f8_2 + f2f7_2 + f3f6_2 + f4f5_2; 741 | 742 | int64_t carry0; 743 | int64_t carry1; 744 | int64_t carry2; 745 | int64_t carry3; 746 | int64_t carry4; 747 | int64_t carry5; 748 | int64_t carry6; 749 | int64_t carry7; 750 | int64_t carry8; 751 | int64_t carry9; 752 | 753 | carry0 = (h0 + (int64_t)(1L << 25)) >> 26; 754 | h1 += carry0; 755 | h0 -= carry0 * ((uint64_t) 1L << 26); 756 | carry4 = (h4 + (int64_t)(1L << 25)) >> 26; 757 | h5 += carry4; 758 | h4 -= carry4 * ((uint64_t) 1L << 26); 759 | 760 | carry1 = (h1 + (int64_t)(1L << 24)) >> 25; 761 | h2 += carry1; 762 | h1 -= carry1 * ((uint64_t) 1L << 25); 763 | carry5 = (h5 + (int64_t)(1L << 24)) >> 25; 764 | h6 += carry5; 765 | h5 -= carry5 * ((uint64_t) 1L << 25); 766 | 767 | carry2 = (h2 + (int64_t)(1L << 25)) >> 26; 768 | h3 += carry2; 769 | h2 -= carry2 * ((uint64_t) 1L << 26); 770 | carry6 = (h6 + (int64_t)(1L << 25)) >> 26; 771 | h7 += carry6; 772 | h6 -= carry6 * ((uint64_t) 1L << 26); 773 | 774 | carry3 = (h3 + (int64_t)(1L << 24)) >> 25; 775 | h4 += carry3; 776 | h3 -= carry3 * ((uint64_t) 1L << 25); 777 | carry7 = (h7 + (int64_t)(1L << 24)) >> 25; 778 | h8 += carry7; 779 | h7 -= carry7 * ((uint64_t) 1L << 25); 780 | 781 | carry4 = (h4 + (int64_t)(1L << 25)) >> 26; 782 | h5 += carry4; 783 | h4 -= carry4 * ((uint64_t) 1L << 26); 784 | carry8 = (h8 + (int64_t)(1L << 25)) >> 26; 785 | h9 += carry8; 786 | h8 -= carry8 * ((uint64_t) 1L << 26); 787 | 788 | carry9 = (h9 + (int64_t)(1L << 24)) >> 25; 789 | h0 += carry9 * 19; 790 | h9 -= carry9 * ((uint64_t) 1L << 25); 791 | 792 | carry0 = (h0 + (int64_t)(1L << 25)) >> 26; 793 | h1 += carry0; 794 | h0 -= carry0 * ((uint64_t) 1L << 26); 795 | 796 | h[0] = (int32_t) h0; 797 | h[1] = (int32_t) h1; 798 | h[2] = (int32_t) h2; 799 | h[3] = (int32_t) h3; 800 | h[4] = (int32_t) h4; 801 | h[5] = (int32_t) h5; 802 | h[6] = (int32_t) h6; 803 | h[7] = (int32_t) h7; 804 | h[8] = (int32_t) h8; 805 | h[9] = (int32_t) h9; 806 | } 807 | 808 | /* 809 | h = 2 * f * f 810 | Can overlap h with f. 811 | * 812 | Preconditions: 813 | |f| bounded by 1.65*2^26,1.65*2^25,1.65*2^26,1.65*2^25,etc. 814 | * 815 | Postconditions: 816 | |h| bounded by 1.01*2^25,1.01*2^24,1.01*2^25,1.01*2^24,etc. 817 | */ 818 | 819 | static void 820 | fe25519_sq2(fe25519 h, const fe25519 f) 821 | { 822 | int32_t f0 = f[0]; 823 | int32_t f1 = f[1]; 824 | int32_t f2 = f[2]; 825 | int32_t f3 = f[3]; 826 | int32_t f4 = f[4]; 827 | int32_t f5 = f[5]; 828 | int32_t f6 = f[6]; 829 | int32_t f7 = f[7]; 830 | int32_t f8 = f[8]; 831 | int32_t f9 = f[9]; 832 | 833 | int32_t f0_2 = 2 * f0; 834 | int32_t f1_2 = 2 * f1; 835 | int32_t f2_2 = 2 * f2; 836 | int32_t f3_2 = 2 * f3; 837 | int32_t f4_2 = 2 * f4; 838 | int32_t f5_2 = 2 * f5; 839 | int32_t f6_2 = 2 * f6; 840 | int32_t f7_2 = 2 * f7; 841 | int32_t f5_38 = 38 * f5; /* 1.959375*2^30 */ 842 | int32_t f6_19 = 19 * f6; /* 1.959375*2^30 */ 843 | int32_t f7_38 = 38 * f7; /* 1.959375*2^30 */ 844 | int32_t f8_19 = 19 * f8; /* 1.959375*2^30 */ 845 | int32_t f9_38 = 38 * f9; /* 1.959375*2^30 */ 846 | 847 | int64_t f0f0 = f0 * (int64_t) f0; 848 | int64_t f0f1_2 = f0_2 * (int64_t) f1; 849 | int64_t f0f2_2 = f0_2 * (int64_t) f2; 850 | int64_t f0f3_2 = f0_2 * (int64_t) f3; 851 | int64_t f0f4_2 = f0_2 * (int64_t) f4; 852 | int64_t f0f5_2 = f0_2 * (int64_t) f5; 853 | int64_t f0f6_2 = f0_2 * (int64_t) f6; 854 | int64_t f0f7_2 = f0_2 * (int64_t) f7; 855 | int64_t f0f8_2 = f0_2 * (int64_t) f8; 856 | int64_t f0f9_2 = f0_2 * (int64_t) f9; 857 | int64_t f1f1_2 = f1_2 * (int64_t) f1; 858 | int64_t f1f2_2 = f1_2 * (int64_t) f2; 859 | int64_t f1f3_4 = f1_2 * (int64_t) f3_2; 860 | int64_t f1f4_2 = f1_2 * (int64_t) f4; 861 | int64_t f1f5_4 = f1_2 * (int64_t) f5_2; 862 | int64_t f1f6_2 = f1_2 * (int64_t) f6; 863 | int64_t f1f7_4 = f1_2 * (int64_t) f7_2; 864 | int64_t f1f8_2 = f1_2 * (int64_t) f8; 865 | int64_t f1f9_76 = f1_2 * (int64_t) f9_38; 866 | int64_t f2f2 = f2 * (int64_t) f2; 867 | int64_t f2f3_2 = f2_2 * (int64_t) f3; 868 | int64_t f2f4_2 = f2_2 * (int64_t) f4; 869 | int64_t f2f5_2 = f2_2 * (int64_t) f5; 870 | int64_t f2f6_2 = f2_2 * (int64_t) f6; 871 | int64_t f2f7_2 = f2_2 * (int64_t) f7; 872 | int64_t f2f8_38 = f2_2 * (int64_t) f8_19; 873 | int64_t f2f9_38 = f2 * (int64_t) f9_38; 874 | int64_t f3f3_2 = f3_2 * (int64_t) f3; 875 | int64_t f3f4_2 = f3_2 * (int64_t) f4; 876 | int64_t f3f5_4 = f3_2 * (int64_t) f5_2; 877 | int64_t f3f6_2 = f3_2 * (int64_t) f6; 878 | int64_t f3f7_76 = f3_2 * (int64_t) f7_38; 879 | int64_t f3f8_38 = f3_2 * (int64_t) f8_19; 880 | int64_t f3f9_76 = f3_2 * (int64_t) f9_38; 881 | int64_t f4f4 = f4 * (int64_t) f4; 882 | int64_t f4f5_2 = f4_2 * (int64_t) f5; 883 | int64_t f4f6_38 = f4_2 * (int64_t) f6_19; 884 | int64_t f4f7_38 = f4 * (int64_t) f7_38; 885 | int64_t f4f8_38 = f4_2 * (int64_t) f8_19; 886 | int64_t f4f9_38 = f4 * (int64_t) f9_38; 887 | int64_t f5f5_38 = f5 * (int64_t) f5_38; 888 | int64_t f5f6_38 = f5_2 * (int64_t) f6_19; 889 | int64_t f5f7_76 = f5_2 * (int64_t) f7_38; 890 | int64_t f5f8_38 = f5_2 * (int64_t) f8_19; 891 | int64_t f5f9_76 = f5_2 * (int64_t) f9_38; 892 | int64_t f6f6_19 = f6 * (int64_t) f6_19; 893 | int64_t f6f7_38 = f6 * (int64_t) f7_38; 894 | int64_t f6f8_38 = f6_2 * (int64_t) f8_19; 895 | int64_t f6f9_38 = f6 * (int64_t) f9_38; 896 | int64_t f7f7_38 = f7 * (int64_t) f7_38; 897 | int64_t f7f8_38 = f7_2 * (int64_t) f8_19; 898 | int64_t f7f9_76 = f7_2 * (int64_t) f9_38; 899 | int64_t f8f8_19 = f8 * (int64_t) f8_19; 900 | int64_t f8f9_38 = f8 * (int64_t) f9_38; 901 | int64_t f9f9_38 = f9 * (int64_t) f9_38; 902 | 903 | int64_t h0 = f0f0 + f1f9_76 + f2f8_38 + f3f7_76 + f4f6_38 + f5f5_38; 904 | int64_t h1 = f0f1_2 + f2f9_38 + f3f8_38 + f4f7_38 + f5f6_38; 905 | int64_t h2 = f0f2_2 + f1f1_2 + f3f9_76 + f4f8_38 + f5f7_76 + f6f6_19; 906 | int64_t h3 = f0f3_2 + f1f2_2 + f4f9_38 + f5f8_38 + f6f7_38; 907 | int64_t h4 = f0f4_2 + f1f3_4 + f2f2 + f5f9_76 + f6f8_38 + f7f7_38; 908 | int64_t h5 = f0f5_2 + f1f4_2 + f2f3_2 + f6f9_38 + f7f8_38; 909 | int64_t h6 = f0f6_2 + f1f5_4 + f2f4_2 + f3f3_2 + f7f9_76 + f8f8_19; 910 | int64_t h7 = f0f7_2 + f1f6_2 + f2f5_2 + f3f4_2 + f8f9_38; 911 | int64_t h8 = f0f8_2 + f1f7_4 + f2f6_2 + f3f5_4 + f4f4 + f9f9_38; 912 | int64_t h9 = f0f9_2 + f1f8_2 + f2f7_2 + f3f6_2 + f4f5_2; 913 | 914 | int64_t carry0; 915 | int64_t carry1; 916 | int64_t carry2; 917 | int64_t carry3; 918 | int64_t carry4; 919 | int64_t carry5; 920 | int64_t carry6; 921 | int64_t carry7; 922 | int64_t carry8; 923 | int64_t carry9; 924 | 925 | h0 += h0; 926 | h1 += h1; 927 | h2 += h2; 928 | h3 += h3; 929 | h4 += h4; 930 | h5 += h5; 931 | h6 += h6; 932 | h7 += h7; 933 | h8 += h8; 934 | h9 += h9; 935 | 936 | carry0 = (h0 + (int64_t)(1L << 25)) >> 26; 937 | h1 += carry0; 938 | h0 -= carry0 * ((uint64_t) 1L << 26); 939 | carry4 = (h4 + (int64_t)(1L << 25)) >> 26; 940 | h5 += carry4; 941 | h4 -= carry4 * ((uint64_t) 1L << 26); 942 | 943 | carry1 = (h1 + (int64_t)(1L << 24)) >> 25; 944 | h2 += carry1; 945 | h1 -= carry1 * ((uint64_t) 1L << 25); 946 | carry5 = (h5 + (int64_t)(1L << 24)) >> 25; 947 | h6 += carry5; 948 | h5 -= carry5 * ((uint64_t) 1L << 25); 949 | 950 | carry2 = (h2 + (int64_t)(1L << 25)) >> 26; 951 | h3 += carry2; 952 | h2 -= carry2 * ((uint64_t) 1L << 26); 953 | carry6 = (h6 + (int64_t)(1L << 25)) >> 26; 954 | h7 += carry6; 955 | h6 -= carry6 * ((uint64_t) 1L << 26); 956 | 957 | carry3 = (h3 + (int64_t)(1L << 24)) >> 25; 958 | h4 += carry3; 959 | h3 -= carry3 * ((uint64_t) 1L << 25); 960 | carry7 = (h7 + (int64_t)(1L << 24)) >> 25; 961 | h8 += carry7; 962 | h7 -= carry7 * ((uint64_t) 1L << 25); 963 | 964 | carry4 = (h4 + (int64_t)(1L << 25)) >> 26; 965 | h5 += carry4; 966 | h4 -= carry4 * ((uint64_t) 1L << 26); 967 | carry8 = (h8 + (int64_t)(1L << 25)) >> 26; 968 | h9 += carry8; 969 | h8 -= carry8 * ((uint64_t) 1L << 26); 970 | 971 | carry9 = (h9 + (int64_t)(1L << 24)) >> 25; 972 | h0 += carry9 * 19; 973 | h9 -= carry9 * ((uint64_t) 1L << 25); 974 | 975 | carry0 = (h0 + (int64_t)(1L << 25)) >> 26; 976 | h1 += carry0; 977 | h0 -= carry0 * ((uint64_t) 1L << 26); 978 | 979 | h[0] = (int32_t) h0; 980 | h[1] = (int32_t) h1; 981 | h[2] = (int32_t) h2; 982 | h[3] = (int32_t) h3; 983 | h[4] = (int32_t) h4; 984 | h[5] = (int32_t) h5; 985 | h[6] = (int32_t) h6; 986 | h[7] = (int32_t) h7; 987 | h[8] = (int32_t) h8; 988 | h[9] = (int32_t) h9; 989 | } 990 | 991 | static inline void 992 | fe25519_mul32(fe25519 h, const fe25519 f, uint32_t n) 993 | { 994 | int64_t sn = (int64_t) n; 995 | int32_t f0 = f[0]; 996 | int32_t f1 = f[1]; 997 | int32_t f2 = f[2]; 998 | int32_t f3 = f[3]; 999 | int32_t f4 = f[4]; 1000 | int32_t f5 = f[5]; 1001 | int32_t f6 = f[6]; 1002 | int32_t f7 = f[7]; 1003 | int32_t f8 = f[8]; 1004 | int32_t f9 = f[9]; 1005 | int64_t h0 = f0 * sn; 1006 | int64_t h1 = f1 * sn; 1007 | int64_t h2 = f2 * sn; 1008 | int64_t h3 = f3 * sn; 1009 | int64_t h4 = f4 * sn; 1010 | int64_t h5 = f5 * sn; 1011 | int64_t h6 = f6 * sn; 1012 | int64_t h7 = f7 * sn; 1013 | int64_t h8 = f8 * sn; 1014 | int64_t h9 = f9 * sn; 1015 | int64_t carry0, carry1, carry2, carry3, carry4, carry5, carry6, carry7, 1016 | carry8, carry9; 1017 | 1018 | carry9 = (h9 + ((int64_t) 1 << 24)) >> 25; 1019 | h0 += carry9 * 19; 1020 | h9 -= carry9 * ((int64_t) 1 << 25); 1021 | carry1 = (h1 + ((int64_t) 1 << 24)) >> 25; 1022 | h2 += carry1; 1023 | h1 -= carry1 * ((int64_t) 1 << 25); 1024 | carry3 = (h3 + ((int64_t) 1 << 24)) >> 25; 1025 | h4 += carry3; 1026 | h3 -= carry3 * ((int64_t) 1 << 25); 1027 | carry5 = (h5 + ((int64_t) 1 << 24)) >> 25; 1028 | h6 += carry5; 1029 | h5 -= carry5 * ((int64_t) 1 << 25); 1030 | carry7 = (h7 + ((int64_t) 1 << 24)) >> 25; 1031 | h8 += carry7; 1032 | h7 -= carry7 * ((int64_t) 1 << 25); 1033 | 1034 | carry0 = (h0 + ((int64_t) 1 << 25)) >> 26; 1035 | h1 += carry0; 1036 | h0 -= carry0 * ((int64_t) 1 << 26); 1037 | carry2 = (h2 + ((int64_t) 1 << 25)) >> 26; 1038 | h3 += carry2; 1039 | h2 -= carry2 * ((int64_t) 1 << 26); 1040 | carry4 = (h4 + ((int64_t) 1 << 25)) >> 26; 1041 | h5 += carry4; 1042 | h4 -= carry4 * ((int64_t) 1 << 26); 1043 | carry6 = (h6 + ((int64_t) 1 << 25)) >> 26; 1044 | h7 += carry6; 1045 | h6 -= carry6 * ((int64_t) 1 << 26); 1046 | carry8 = (h8 + ((int64_t) 1 << 25)) >> 26; 1047 | h9 += carry8; 1048 | h8 -= carry8 * ((int64_t) 1 << 26); 1049 | 1050 | h[0] = (int32_t) h0; 1051 | h[1] = (int32_t) h1; 1052 | h[2] = (int32_t) h2; 1053 | h[3] = (int32_t) h3; 1054 | h[4] = (int32_t) h4; 1055 | h[5] = (int32_t) h5; 1056 | h[6] = (int32_t) h6; 1057 | h[7] = (int32_t) h7; 1058 | h[8] = (int32_t) h8; 1059 | h[9] = (int32_t) h9; 1060 | } 1061 | --------------------------------------------------------------------------------