swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

20
unikernel/duniverse/mirage-crypto/.cirrus.yml Normal file
View file

@ -0,0 +1,20 @@
freebsd_instance:
image_family: freebsd-14-2
freebsd_task:
env:
matrix:
- OCAML_VERSION: 4.14.2
pkg_install_script: pkg install -y ocaml-opam gmp gmake pkgconf bash
ocaml_script:
- opam init -a --comp=$OCAML_VERSION
- opam env
pin_packages_script:
- opam install -y --deps-only -t ./mirage-crypto.opam ./mirage-crypto-rng.opam ./mirage-crypto-rng-mirage.opam ./mirage-crypto-ec.opam ./mirage-crypto-pk.opam
test_script: opam exec -- dune runtest -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-mirage,mirage-crypto-pk,mirage-crypto-ec
test_mirage_script: eval `opam env` && ./.test-mirage.sh

4
unikernel/duniverse/mirage-crypto/.gitattributes vendored Normal file
View file

@ -0,0 +1,4 @@
*.ml linguist-language=OCaml
# Shell scripts are required to be LF
*.sh text eol=lf

69
unikernel/duniverse/mirage-crypto/.github/workflows/test.yml vendored Normal file
View file

@ -0,0 +1,69 @@
name: Crypto
on: [push, pull_request]
jobs:
tests:
name: Tests
strategy:
fail-fast: false
matrix:
ocaml-version: ["4.14.2"]
operating-system: [macos-latest, ubuntu-latest]
runs-on: ${{ matrix.operating-system }}
steps:
- name: Checkout code
uses: actions/checkout@v4
- name: Use OCaml ${{ matrix.ocaml-version }}
uses: ocaml/setup-ocaml@v3
with:
opam-local-packages: |
*.opam
!mirage-crypto-rng-miou-unix.opam
ocaml-compiler: ${{ matrix.ocaml-version }}
- name: Install dependencies
run: opam install --deps-only -t mirage-crypto mirage-crypto-rng mirage-crypto-rng-mirage mirage-crypto-pk mirage-crypto-ec
- name: Build
run: opam exec -- dune build -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-mirage,mirage-crypto-pk,mirage-crypto-ec
- name: Test
run: opam exec -- dune runtest -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-mirage,mirage-crypto-pk,mirage-crypto-ec
build-test-ocaml-5:
name : Tests with OCaml 5
strategy:
fail-fast: false
matrix:
ocaml-version: ["5.2.1"]
operating-system: [macos-latest, ubuntu-latest]
runs-on: ${{ matrix.operating-system }}
steps:
- name: Checkout code
uses: actions/checkout@v4
- name: Use OCaml ${{ matrix.ocaml-version }}
uses: ocaml/setup-ocaml@v3
with:
opam-local-packages: |
mirage-crypto.opam
mirage-crypto-rng.opam
mirage-crypto-rng-miou-unix.opam
ocaml-compiler: ${{ matrix.ocaml-version }}
- name: Install dependencies
run: opam install --deps-only -t mirage-crypto mirage-crypto-rng mirage-crypto-rng-miou-unix
- name: Build
run: opam exec -- dune build -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-miou-unix
- name: Test
run: opam exec -- dune runtest -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-miou-unix

39
unikernel/duniverse/mirage-crypto/.github/workflows/windows.yml vendored Normal file
View file

@ -0,0 +1,39 @@
name: Crypto
on: [push, pull_request]
jobs:
tests:
name: Tests
strategy:
fail-fast: false
matrix:
ocaml-version: ["4.14.2"]
operating-system: [windows-latest]
runs-on: ${{ matrix.operating-system }}
steps:
- name: Checkout code
uses: actions/checkout@v4
- name: Use OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v3
with:
opam-repositories: |
opam-repository-mingw: https://github.com/ocaml-opam/opam-repository-mingw.git#sunset
default: https://github.com/ocaml/opam-repository.git
opam-local-packages: |
*.opam
!mirage-crypto-rng-miou-unix.opam
ocaml-compiler: ${{ matrix.ocaml-version }}
- name: Install dependencies
run: opam install --deps-only -t mirage-crypto mirage-crypto-rng mirage-crypto-rng-mirage mirage-crypto-pk mirage-crypto-ec
- name: Build
run: opam exec -- dune build -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-mirage,mirage-crypto-pk,mirage-crypto-ec
- name: Test
run: opam exec -- dune runtest -p mirage-crypto,mirage-crypto-rng,mirage-crypto-rng-mirage,mirage-crypto-pk,mirage-crypto-ec

18
unikernel/duniverse/mirage-crypto/.gitignore vendored Normal file
View file

@ -0,0 +1,18 @@
_build
.merlin
.*.swp
mirage/Makefile
mirage/crypto_test*
mirage/dune
mirage/dune-project
mirage/dune.build
mirage/dune.config
mirage/key_gen.ml
mirage/main.ml
mirage/main.native
mirage/*opam
mirage/myocamlbuild.ml
mirage/.mirage.config
_opam
*.install
.opam/

17
unikernel/duniverse/mirage-crypto/.test-mirage.sh Executable file
View file

@ -0,0 +1,17 @@
#!/bin/sh
set -ex
opam install --confirm-level=unsafe-yes "mirage>4"
# to satisfy hardcoded version constraints in mirage, we need to be < 0.12.0
# and "dune subst" doesn't work on these PR checkouts
version='version: "2.99.0~dev"'
echo $version >> mirage-crypto-rng-mirage.opam
echo $version >> mirage-crypto-rng.opam
echo $version >> mirage-crypto.opam
echo $version >> mirage-crypto-pk.opam
(mirage configure -t unix -f mirage/config.ml && gmake depend && dune build --root . mirage/dist/ && mirage/dist/crypto-test) || exit 1
(mirage configure -t hvt -f mirage/config.ml && gmake depend && dune build --root . mirage/dist/) || exit 1
if [ $(uname -m) = "amd64" ] || [ $(uname -m) = "x86_64" ]; then
(mirage configure -t xen -f mirage/config.ml && gmake depend && dune build --root . mirage/dist/) || exit 1
fi

1195
unikernel/duniverse/mirage-crypto/CHANGES.md Normal file
View file

File diff suppressed because it is too large Load diff

13
unikernel/duniverse/mirage-crypto/LICENSE.md Normal file
View file

@ -0,0 +1,13 @@
Copyright (c) 2014-2016 David Kaloper Meršinjak
Permission to use, copy, modify, and/or distribute this software for any
purpose with or without fee is hereby granted, provided that the above
copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

49
unikernel/duniverse/mirage-crypto/LICENSE.md.mirage-crypto-ec Normal file
View file

@ -0,0 +1,49 @@
The MIT License
Copyright (c) 2019 Etienne Millon, 2021 Hannes Mehnert
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
C stubs in `*_32.h` and `*_64.h` were generated using
Fiat (https://github.com/mit-plv/fiat-crypto) and thus these files are
licensed under the MIT license with the following copyright :
----------------------------
Copyright (c) 2015-2020 Andres Erbsen <andreser@mit.edu>
Google Inc.
Jade Philipoom <jadep@mit.edu> <jade.philipoom@gmail.com>
Massachusetts Institute of Technology
Zoe Paraskevopoulou <zoe.paraskevopoulou@gmail.com>
The code in curve25519_stubs.c and point_operations.h are from BoringSSL with
the following license:
Copyright (c) 2020, Google Inc.
Permission to use, copy, modify, and/or distribute this software for any
purpose with or without fee is hereby granted, provided that the above
copyright notice and this permission notice appear in all copies.
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

23
unikernel/duniverse/mirage-crypto/LICENSE.md.mirage-crypto-rng-mirage Normal file
View file

@ -0,0 +1,23 @@
Copyright (c) 2014-2016, Hannes Mehnert, Anil Madhavapeddy, David Kaloper Meršinjak
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

44
unikernel/duniverse/mirage-crypto/README.md Normal file
View file

@ -0,0 +1,44 @@
# mirage-crypto - Cryptographic primitives for MirageOS
v2.0.2
mirage-crypto is a small cryptographic library that puts emphasis on the
applicative style and ease of use. It includes basic ciphers (AES, 3DES, RC4,
ChaCha20/Poly1305), AEAD primitives (AES-GCM, AES-CCM, ChaCha20/Poly1305),
public-key primitives (RSA, DSA, DH), elliptic curves (NIST P-256, P-384, P-521,
and curve 25519), and a strong RNG (Fortuna).
RSA timing attacks are countered by blinding. AES timing attacks are avoided by
delegating to AES-NI.
Mirage-crypto is a fork of the
[ocaml-nocrypto](https://github.com/mirleft/ocaml-nocrypto) written by David
Kaloper. It was forked with the permission of the original author in order to
facilitate changes (e.g. build system) required by Mirage that the upstream
didn't have time to keep up with.
Mirage-crypto-rng embeds the former mirage-entropy opam package, which
implements various entropy sources:
- non-deterministic execution time (used at initial seeding, see the [whirlwind RNG paper](https://www.ieee-security.org/TC/SP2014/papers/Not-So-RandomNumbersinVirtualizedLinuxandtheWhirlwindRNG.pdf))
- a hook into the Lwt event loop that collects a timestamp of each event
- rdseed and rdrand (x86/x86-64 only)
[API documentation online](https://mirage.github.io/mirage-crypto/doc)
## Build
```bash
dune build
dune runtest
```
## FAQ
#### RNG seeding
If RNG fails with `Fatal error: exception Unseeded_generator`, you need to
seed it.
```OCaml
let () = Mirage_crypto_rng_unix.use_default ()
```

12
unikernel/duniverse/mirage-crypto/bench/dune Normal file
View file

@ -0,0 +1,12 @@
(executables
(names speed)
(modules speed)
(libraries mirage-crypto mirage-crypto-rng mirage-crypto-rng.unix
mirage-crypto-pk mirage-crypto-ec))
; marking as "(optional)" leads to OCaml-CI failures
; marking with "(package mirage-crypto-rng-miou-unix)" only has an effect with a "public_name"
;(executables
; (names miou)
; (modules miou)
; (libraries mirage-crypto-rng-miou-unix))

91
unikernel/duniverse/mirage-crypto/bench/miou.ml Normal file
View file

@ -0,0 +1,91 @@
open Mirage_crypto
module Time = struct
let time ~n f a =
let t1 = Sys.time () in
for _ = 1 to n do ignore (f a) done ;
let t2 = Sys.time () in
(t2 -. t1)
let warmup () =
let x = ref 0 in
let rec go start =
if Sys.time () -. start < 1. then begin
for i = 0 to 10000 do x := !x + i done ;
go start
end in
go (Sys.time ())
end
let burn_period = 2.0
let sizes = [16; 64; 256; 1024; 8192]
(* let sizes = [16] *)
let burn f n =
let buf = Mirage_crypto_rng.generate n in
let (t1, i1) =
let rec loop it =
let t = Time.time ~n:it f buf in
if t > 0.2 then (t, it) else loop (it * 10) in
loop 10 in
let iters = int_of_float (float i1 *. burn_period /. t1) in
let time = Time.time ~n:iters f buf in
(iters, time, float (n * iters) /. time)
let mb = 1024. *. 1024.
let throughput title f =
Printf.printf "\n* [%s]\n%!" title ;
sizes |> List.iter @@ fun size ->
Gc.full_major () ;
let (iters, time, bw) = burn f size in
Printf.printf " % 5d: %04f MB/s (%d iters in %.03f s)\n%!"
size (bw /. mb) iters time
let bm name f = (name, fun () -> f name)
let benchmarks = [
bm "pfortuna" (fun name ->
let open Mirage_crypto_rng_miou_unix.Pfortuna in
Miou_unix.run ~domains:2 @@ fun () ->
let rng = Mirage_crypto_rng_miou_unix.(initialize (module Pfortuna)) in
let g = create () in
reseed ~g "abcd" ;
throughput name (fun buf ->
let buf = Bytes.unsafe_of_string buf in
generate_into ~g buf ~off:0 (Bytes.length buf));
Mirage_crypto_rng_miou_unix.kill rng) ;
]
let help () =
Printf.printf "available benchmarks:\n ";
List.iter (fun (n, _) -> Printf.printf "%s " n) benchmarks ;
Printf.printf "\n%!"
let runv fs =
Format.printf "accel: %a\n%!"
(fun ppf -> List.iter @@ fun x ->
Format.fprintf ppf "%s " @@
match x with `XOR -> "XOR" | `AES -> "AES" | `GHASH -> "GHASH")
accelerated;
Time.warmup () ;
List.iter (fun f -> f ()) fs
let () =
let seed = "abcd" in
let g = Mirage_crypto_rng.(create ~seed (module Fortuna)) in
Mirage_crypto_rng.set_default_generator g;
match Array.to_list Sys.argv with
| _::(_::_ as args) -> begin
try
let fs =
args |> List.map @@ fun n ->
snd (benchmarks |> List.find @@ fun (n1, _) -> n = n1) in
runv fs
with Not_found -> help ()
end
| _ -> help ()

531
unikernel/duniverse/mirage-crypto/bench/speed.ml Normal file
View file

@ -0,0 +1,531 @@
open Mirage_crypto
module Time = struct
let time ~n f a =
let t1 = Sys.time () in
for _ = 1 to n do ignore (f a) done ;
let t2 = Sys.time () in
(t2 -. t1)
let warmup () =
let x = ref 0 in
let rec go start =
if Sys.time () -. start < 1. then begin
for i = 0 to 10000 do x := !x + i done ;
go start
end in
go (Sys.time ())
end
let burn_period = 2.0
let sizes = [16; 64; 256; 1024; 8192]
(* let sizes = [16] *)
let burn f n =
let buf = Mirage_crypto_rng.generate n in
let (t1, i1) =
let rec loop it =
let t = Time.time ~n:it f buf in
if t > 0.2 then (t, it) else loop (it * 10) in
loop 10 in
let iters = int_of_float (float i1 *. burn_period /. t1) in
let time = Time.time ~n:iters f buf in
(iters, time, float (n * iters) /. time)
let mb = 1024. *. 1024.
let throughput title f =
Printf.printf "\n* [%s]\n%!" title ;
sizes |> List.iter @@ fun size ->
Gc.full_major () ;
let (iters, time, bw) = burn f size in
Printf.printf " % 5d: %04f MB/s (%d iters in %.03f s)\n%!"
size (bw /. mb) iters time
let throughput_into ?(add = 0) title f =
Printf.printf "\n* [%s]\n%!" title ;
sizes |> List.iter @@ fun size ->
Gc.full_major () ;
let dst = Bytes.create (size + add) in
let (iters, time, bw) = burn (f dst) size in
Printf.printf " % 5d: %04f MB/s (%d iters in %.03f s)\n%!"
size (bw /. mb) iters time
let count_period = 10.
let count f n =
ignore (f n);
let i1 = 5 in
let t1 = Time.time ~n:i1 f n in
let iters = int_of_float (float i1 *. count_period /. t1) in
let time = Time.time ~n:iters f n in
(iters, time)
let count title f to_str args =
Printf.printf "\n* [%s]\n%!" title ;
args |> List.iter @@ fun arg ->
Gc.full_major () ;
let iters, time = count f arg in
Printf.printf " %s: %.03f ops per second (%d iters in %.03f)\n%!"
(to_str arg) (float iters /. time) iters time
let msg_str = String.make 100 '\xAA'
let msg_str_32 = String.sub msg_str 0 32
let msg_str_48 = String.sub msg_str 0 48
let msg_str_65 = String.sub msg_str 0 65
module PSS = Mirage_crypto_pk.Rsa.PSS(Digestif.SHA256)
let rsa_1024 =
let p = Z.of_string "10798561676627454710140432432014696449593673631094049392368450463276546091610832740190717321579865870896133380991892468262437092547408603618427685009427773"
and q = Z.of_string "10400664760062606994038747844895625872750212488858602663971334563613232045185857177383833781411830934303117994128623611996670112272953487791473086751129863"
and e = Z.of_string "65537"
in
match Mirage_crypto_pk.Rsa.priv_of_primes ~e ~p ~q with Ok r -> r | _ -> assert false
let enc_1024 = Mirage_crypto_pk.Rsa.(encrypt ~key:(pub_of_priv rsa_1024) msg_str)
let pkcs1_sig_1024 () =
Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:`SHA256 ~key:rsa_1024 (`Message msg_str)
let pkcs1_enc_1024 () =
Mirage_crypto_pk.Rsa.(PKCS1.encrypt ~key:(pub_of_priv rsa_1024) msg_str)
let pss_sig_1024 () = PSS.sign ~key:rsa_1024 (`Message msg_str)
let rsa_2048 =
let p = Z.of_string "146881832325800831419400417618624202055588545997890787121932184528831630537012732415698782899346395306540669232648045731896347007978622067056705527305566180903122107927148832001099595387953189273726394573803912262323600581299712943797238366745329534148223987933536186022708693674753193534229263584177098260169"
and q = Z.of_string "146461957885839900502732892013745315236120923895767594427579857452138451155393985820080680192640369593315439290134409437965406213465262989382655388410330601076036910359057156988645246773259111682038096388585157599977808854893528900530706460128823381760931962351810679571404043148961709991714582814015259432029"
and e = Z.of_string "65537"
in
match Mirage_crypto_pk.Rsa.priv_of_primes ~e ~p ~q with Ok r -> r | _ -> assert false
let enc_2048 = Mirage_crypto_pk.Rsa.(encrypt ~key:(pub_of_priv rsa_2048) msg_str)
let pkcs1_sig_2048 () =
Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:`SHA256 ~key:rsa_2048 (`Message msg_str)
let pkcs1_enc_2048 () =
Mirage_crypto_pk.Rsa.(PKCS1.encrypt ~key:(pub_of_priv rsa_2048) msg_str)
let pss_sig_2048 () = PSS.sign ~key:rsa_2048 (`Message msg_str)
let rsa_4096 =
let p = Z.of_string "30773596934476715066776070065844902670036493980016387964275170019397018472432997910667589359581914549510631424565206701540136804180560112829236103459317928059975099687383138310206374921731816027058152009810073337617754052401932141110921176212810704858018214605862299356217860547747262170495777126218319842708093667844701139914958775637423731967187071886349669479192453619522943080948061657926138418380417577129184420732857906610804965319661598089231703183044642635889126023201809407430354992888247464125783088294095728916671050049684448794153783082653555256735912037270303014887722063417225893745458164718800442738569"
and q = Z.of_string "25905916162566396401205858643227945415345838368190515936191926936462899261314859092468495558719305083654714669527919862817831941531613073577910643681172802147392797914485263753968375221243705167910636382434485717071007054833155618588980128488599406663210791261135710551020276087851551652652612955553056226986980360600996201307035494196112173475664509878923172924086102889718336621725968169373963280305056864698229857913526607314633711315503607289470716733189135747457446349029256257187264165837635026903463931381823712962360342258652047970731347111703873301687821992467888598546386551115261010493902143134851640738743"
and e = Z.of_string "65537"
in
match Mirage_crypto_pk.Rsa.priv_of_primes ~e ~p ~q with Ok r -> r | _ -> assert false
let enc_4096 = Mirage_crypto_pk.Rsa.(encrypt ~key:(pub_of_priv rsa_4096) msg_str)
let pkcs1_sig_4096 () =
Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:`SHA256 ~key:rsa_4096 (`Message msg_str)
let pkcs1_enc_4096 () =
Mirage_crypto_pk.Rsa.(PKCS1.encrypt ~key:(pub_of_priv rsa_4096) msg_str)
let pss_sig_4096 () = PSS.sign ~key:rsa_4096 (`Message msg_str)
let dsa_1024 =
let p = Z.of_string "115320471016337933377056549329182706825658339080795846324118938187917903660539570102468495091957028599543345588517799627361082806070282899880721557018345825086927289316756283826093243695405203187016738458545513419551779925532261196890562077023934735570005318513791942265699098088390517334916527653326493928799"
and q = Z.of_string "823267969559752761552104454322087597915195665001"
and gg = Z.of_string "107937769619514611906619060647411205822947624664377868769814121409943849987480570028955037310439082345400300825969182219850876363034452830224901430080806055218560008392720388910894912162956691999057850754409178667408425482805161601110189024138168750376391340697351250728689008407981372513900837280131855895453"
and x = Z.of_string "33269272469299670210735451373406214067383586377"
and y = Z.of_string "43917635707590891841908570055721669604556135044554274942460553515946670787931699807386932177837523342760860376770220825997328312057886461226985675983491441562087492365801663397409369541614646669226917344513472367438132106373179011858311945451923744651780314133078253880297369792145807736223662521868826642853"
in
match Mirage_crypto_pk.Dsa.priv ~fips:true ~p ~q ~gg ~x ~y () with Ok p -> p | _ -> assert false
let dsa_sig_1024 () = Mirage_crypto_pk.Dsa.sign ~key:dsa_1024 msg_str
let dsa_2048 =
let p = Z.of_string "27787495469795504213817302334103600594688179071059183073859876165757248559489321478170600304273914000462158587756787453177210321379060448141559798652196363556897576291878245650614903612762833777567911000834171168229784178643222849655095281437320492725855855778320111645629834980350492228611813830302209080760811887894272862901026864911346096471199762409562102789142939773632891860019140618313962854554152891445175391927591825205548689170996430765723064763763481336517107917261869303217480777161449935319930795628114622197586510378927239068257979584784079128534248603619156372913573809491691986354447396965646770535701"
and q = Z.of_string "69694877308167037149745913456421442195328554169759046914164177549875778020469"
and gg = Z.of_string "16749627588066214399529603991445197534749244283120164288067836662918885787186948571007751498897778360267876697044209030527058098259975959998878027668545429739993477399366554325353523024222400972678469229055566504457717513550553993631550406867067991877458269091177591866978827953084168571646688881904998325355571633065354963580984543158204292013550690051754036914978697535194466008409541982818422484127204033337933785318568157008881227465007133605041651516579370726984057624602011504585990465767875831799514375203088558577008613314886723862237337922917306616319550969129882699756566436846243489458865623046875627558535"
and x = Z.of_string "52860861934156228997899838985740859941028688506510055821449681896336427977580"
and y = Z.of_string "16697822339875604612001674517725789858937385326266245308648897963274039128000291572870559603618903431422492771498840266582664620626826186158140214481920146230768719356298465470274085841064126012204317638870338958089054809559680905413861272320951150917299685355736888023985398767858005440235842845908452598291689850063919053521400020402671375982259094019780813889586357332424647365679629398571364161673401249910198031061651183589601097975488702613291524957230624044246866866974886847601585171352897595544769649242723658395277456627024303041369757410970512818793143517329469213213147704583953410882515213978051041273924"
in
match Mirage_crypto_pk.Dsa.priv ~fips:true ~p ~q ~gg ~x ~y () with Ok p -> p | _ -> assert false
let dsa_sig_2048 () = Mirage_crypto_pk.Dsa.sign ~key:dsa_2048 msg_str
let dsa_3072 =
let p = Z.of_string "4944862491052787177238323499959371418651354629231656321315236369672827559263545931134286049323485061071828187289578269594065783019111035804017538871324004047710342711620233110167493989997579634523303899794913823240058891327833786211541568251787338957336540247816021098378292806006955851897646808403078979142749428669072523191276645021175423303816467433407072660616741824124536840773744646488191896772232795413707995397140064396495425700133866462410490239713815308709711960470201906326732033816522202617817869465691798938486540955726912350768931476362143768721380759395525951947017232778140349423557015356082357043807910825817719748257213281893007933859227824276579765323175836008193865064772817200047353825332039369252224256435661514851653526942065285711420907389170574343434449883875510985495078384130667046036846831401643151166834922210257258578675547742596423035828159461629721005113634334227074529533688136165903014911127"
and q = Z.of_string "72036757532428134359049138716615314032674441223147930984416116642785279309001"
and gg = Z.of_string "988301665281495772390013694627509692333967846948672137624515090935924385717634154201978961497509784579332702743535206413508559565302483922898459454403718843912379531742192312937734625047119678718271184170003455506604118936761508195594240052138536667234693864514877750501896049675764191029147963148241546820518065141123555298022010467792468407477159110344370654433269478015817957411602389410658876373667769353995724289566719120654426746425129842353040271693696527020500630012804936844492302532860691617810440827122662134370347136275931360845416833023047973072799739252681873195380321841873819721774703093238289342578739869306714624065593724407718101053836638039267362740083113357679437895609399028133545708736803196232072972950098992845234240283344492163375862712470338417546036591824286944195749933069780384676421299008472374982388004050973085425949637720603596481254386896408204626665775305048865550117840561595366712598318"
and x = Z.of_string "57079433780483458942713357293831115449694380253611914431677328021806898761674"
and y = Z.of_string "2872172233173100601346399502391482510148300641600207189246652621232656647081281141886455256814187251102030580186748870087277263359506423691023579912476503628426574690699263443704236625550832436226673947182294798279064154375422081421444400893924415563728656687773617245084962617886701420982288621397340217078717788290878177343138178149109067141997920049624616209300715994802074480057682676445987819355778630849636079364539062466859717465892222793824712941403252645431023939220711618233660062829520555618350855085688062241702521140104357981881833598269736147371800258828202964600523335598361833482597511071900975835195171061421945579132277176597724513608746614358311884564512362186106480065540201711903122228315570389409204443391052987813355120223856839756971514334338065850104261467285471383663470187296456006848469765768400814476981451863643010333596484259098557995874127140419649424228480234701334240448168704764430867915060"
in
match Mirage_crypto_pk.Dsa.priv ~fips:true ~p ~q ~gg ~x ~y () with Ok p -> p | _ -> assert false
let dsa_sig_3072 () = Mirage_crypto_pk.Dsa.sign ~key:dsa_3072 msg_str
let dh_groups =
["oakley5 (1536)",Mirage_crypto_pk.Dh.Group.oakley_5;
"oakley14 (2048)",Mirage_crypto_pk.Dh.Group.oakley_14;
"ffdhe2048",Mirage_crypto_pk.Dh.Group.ffdhe2048;
"ffdhe3072",Mirage_crypto_pk.Dh.Group.ffdhe3072;
"ffdhe4096",Mirage_crypto_pk.Dh.Group.ffdhe4096;
"ffdhe6144",Mirage_crypto_pk.Dh.Group.ffdhe6144]
let dh_secrets =
List.map2 (fun (n, group) s ->
(n, group), Mirage_crypto_pk.Dh.key_of_secret group ~s)
dh_groups
(List.map (fun s -> Z.of_string s |> Mirage_crypto_pk.Z_extra.to_octets_be)
[
"31271182055444024732867835946284871743952969208281694762833912267184" ;
"27594341083884344999714422172371027333192426063917478556668524561591" ;
"49745209598738800585479479877345156590922715411063492309021724116430" ;
"54263413298355776701974737228250185414758929445654879795198916482466337662578919821" ;
"38599161911587526396222063388324161227700603198435442693976375015855884010520671067171149524070089" ;
"60057457975706301816395663645420233759377744187465730049174048360108513636349450241008234412972340882517684187851" ;
])
let ecdsa_p256 =
Result.get_ok
(Mirage_crypto_ec.P256.Dsa.priv_of_octets
"\x08\x9f\x4f\xfc\xcc\xf9\xba\x13\xfe\xdd\x09\x42\xef\x08\xcf\x2d\x90\x9f\x32\xe2\x93\x4a\xb5\xc9\x3b\x6c\x99\xbe\x5a\x9f\xf5\x27")
let ecdsa_p256_sig () = Mirage_crypto_ec.P256.Dsa.sign ~key:ecdsa_p256 msg_str_32
let ecdsa_p384 =
Result.get_ok
(Mirage_crypto_ec.P384.Dsa.priv_of_octets
"\xf5\xc0\xc9\xfb\x95\x17\x86\x41\xaf\x76\xf3\x83\x1f\x41\xe2\xd3\x7c\xfa\xaf\xff\xc7\xe6\x01\x72\xcf\xb0\x89\xfe\x60\x4b\x56\xa6\x1c\x7c\x31\xa6\x90\x4b\x3b\x5d\x08\x20\x7a\x4b\x81\xe2\x5e\xa5")
let ecdsa_p384_sig () = Mirage_crypto_ec.P384.Dsa.sign ~key:ecdsa_p384 msg_str_48
let ecdsa_p521 =
Result.get_ok
(Mirage_crypto_ec.P521.Dsa.priv_of_octets
"\x00\xb1\x8f\x60\xc0\x35\x2a\xd8\xe3\xef\x98\x2f\x1d\xdf\xcf\x6e\xec\x7f\xa6\xca\xf0\xe6\xf3\x68\x35\x4a\x8b\x02\xb2\xd8\xac\x1e\x05\x9e\x30\x98\x91\xe2\xbf\xa8\x57\x91\xa5\xe7\x1b\x40\xbd\xec\xbf\x90\x2b\xf2\x43\xdc\x3b\x00\x80\x49\x5c\xf4\xd9\x1c\x78\x72\x8b\xd5")
let ecdsa_p521_sig () = Mirage_crypto_ec.P521.Dsa.sign ~key:ecdsa_p521 msg_str_65
let ed25519 =
Result.get_ok (Mirage_crypto_ec.Ed25519.priv_of_octets
"\x3e\x0a\xb6\x82\x17\x12\x75\xc5\x69\xfc\xe9\xca\x8b\xcc\xd2\xd2\x77\x14\x54\xa2\x30\x0c\x35\x29\xf7\xa4\xd8\x0b\x84\x38\x83\xbc")
let ed25519_sig () = Mirage_crypto_ec.Ed25519.sign ~key:ed25519 msg_str
let ecdsas = [
("P256", `P256 (ecdsa_p256, ecdsa_p256_sig ()));
("P384", `P384 (ecdsa_p384, ecdsa_p384_sig ()));
("P521", `P521 (ecdsa_p521, ecdsa_p521_sig ()));
("Ed25519", `Ed25519 (ed25519, ed25519_sig ()));
]
let ecdh_shares =
[
("P256", `P256 (Mirage_crypto_ec.P256.Dh.secret_of_octets "\x47\x0d\x57\x70\x6c\x77\x06\xb6\x8a\x3f\x42\x3a\xea\xf4\xff\x7f\xdd\x02\x49\x4a\x10\xd3\xe3\x81\xc3\xc1\x1f\x72\x76\x80\x2c\xdc" |> Result.get_ok |> fst,
"\x04\x11\xb3\xfc\x82\x72\x1c\x26\x9a\x19\x90\x9a\x3b\x2f\xc2\x6d\x98\x95\x82\x6d\x0c\xfc\xbc\x1f\x76\x26\xe4\x88\xf0\x1f\x4c\xa6\xb5\xc5\xed\x76\xad\xee\x7a\xf8\x1b\xb2\x0b\x17\xcf\x23\x1c\xbf\x0c\x67\xdb\x02\x95\xd6\x8d\x1d\x92\xc2\xd2\xa5\xa8\x06\x38\xd7\x8d"));
("P384", `P384 (Mirage_crypto_ec.P384.Dh.secret_of_octets "\xee\x55\xe2\x9b\x61\x75\x2d\x5a\x3e\x52\x56\x56\xdb\x8b\xd8\xfe\x6f\x94\xfa\xb8\xaa\xcc\x9e\x92\xac\xff\x4c\x48\x12\xbf\x7a\x61\x87\xab\xa4\x6c\xc6\x0a\xb8\xf0\x8e\xfc\xf2\xd5\x74\x58\x4b\x74" |> Result.get_ok |> fst,
"\x04\x04\x89\xcf\x24\xbc\x80\xbf\x89\xfd\xfe\x9c\x05\xec\xc3\x9f\x69\x16\xad\x45\x09\xd9\x39\x85\x97\x95\x0d\x3d\x24\xe8\x28\xf6\xbf\x56\xba\x4a\xd6\xd2\x1e\xd7\x86\x3b\xed\x68\xe4\x13\x36\x4b\xd4\xc7\xb1\xe9\x04\x7d\x36\x12\x4c\x69\x53\xbe\x7c\x61\x20\x9c\xb3\xfc\x56\x45\x2f\x73\x05\x29\x37\x83\xc7\xc0\xed\x92\x9d\x6c\x98\xc7\xbc\x97\xf6\x0a\x72\xed\x22\x69\xa8\xeb\x19\xbb\x7e\xe1\x31"));
("P521", `P521 (Mirage_crypto_ec.P521.Dh.secret_of_octets "\x00\xaa\x47\x0b\xa1\xcc\x84\x3b\xa3\x14\x82\x1e\x72\xde\x4c\xd2\x99\xae\xc1\xf2\x6e\x9d\x64\xa0\xd8\x7d\xb1\x8a\x3d\xa9\xf6\x5c\x45\xec\xfc\xc5\x61\x7f\xf0\xd7\x3b\x2e\x0e\x1c\xdf\xf8\x04\x8e\x01\xbe\x5e\x20\x14\x94\x12\xe7\xdb\xfa\xb7\xfe\xae\x24\x9b\x1b\xfa\x4d" |> Result.get_ok |> fst,
"\x04\x00\x1d\x16\x29\xee\xb1\xc4\x25\xf9\x04\xd7\x55\x33\x00\x79\xd1\x3c\x77\xda\x92\x1e\x01\xcf\x50\xd7\x17\xe0\xd6\x85\x0a\x81\xa3\x90\x2b\xb9\x2a\x03\xfa\xea\xcb\xd6\x28\x9c\x15\x90\x68\x5a\x60\x44\xb5\xe9\x4d\xcf\xc4\x1d\xeb\x6a\x88\xdb\x62\xa8\x91\xb0\xb8\x93\xbb\x00\xe4\x2a\x66\xb2\xf0\x13\xbd\xd0\xd2\x7d\x8e\x07\xcb\x35\xfc\x3e\x2c\x2b\x22\xf9\x3e\xcf\xd5\xea\xb7\x88\x61\x97\xca\x07\x3c\x2c\x5e\x68\x31\xd6\x5e\x2d\x0b\x8a\xa4\x08\x43\x8e\x49\x54\x2f\x05\xf4\x1c\x57\x6d\xf7\x0e\x3c\xaf\x5b\xb8\x22\x7d\x48\x30\x94\xae\x58"));
("X25519", `X25519 (Mirage_crypto_ec.X25519.secret_of_octets "\x4c\x6d\xb7\xcf\x93\x5b\xcf\x84\x02\x61\x78\xd4\x0c\x95\x6a\xf0\x9d\x8e\x36\x32\x03\x49\x0d\x2c\x41\x62\x5a\xcb\x68\xb9\x31\xa4" |> Result.get_ok |> fst,
"\xca\x19\x19\x3c\xf5\xc0\xb3\x8c\x61\xaa\x01\xc1\x72\xb2\xe9\x3d\x16\xf7\x50\xd0\x84\x62\x77\xad\x32\x2d\xe5\xe4\xfb\x33\x24\x29"));
]
let bm name f = (name, fun () -> f name)
let benchmarks = [
bm "rsa-generate" (fun name ->
count name (fun bits -> Mirage_crypto_pk.Rsa.generate ~bits ())
string_of_int [1024;2048;4096]) ;
bm "rsa-encrypt" (fun name ->
count name (fun key -> Mirage_crypto_pk.Rsa.(encrypt ~key:(pub_of_priv key) msg_str))
(fun k -> string_of_int (Mirage_crypto_pk.Rsa.priv_bits k))
[rsa_1024;rsa_2048;rsa_4096]) ;
bm "rsa-decrypt" (fun name ->
count name (fun (key, msg) -> Mirage_crypto_pk.Rsa.(decrypt ~key msg))
(fun (k, _) -> string_of_int (Mirage_crypto_pk.Rsa.priv_bits k))
[rsa_1024,enc_1024 ; rsa_2048,enc_2048 ; rsa_4096,enc_4096]) ;
bm "rsa-pkcs1-encrypt" (fun name ->
count name (fun key -> Mirage_crypto_pk.Rsa.(PKCS1.encrypt ~key:(pub_of_priv key) msg_str))
(fun k -> string_of_int (Mirage_crypto_pk.Rsa.priv_bits k))
[rsa_1024;rsa_2048;rsa_4096]) ;
bm "rsa-pkcs1-decrypt" (fun name ->
count name (fun (key, msg) -> Mirage_crypto_pk.Rsa.(PKCS1.decrypt ~key msg))
(fun (k, _) -> string_of_int (Mirage_crypto_pk.Rsa.priv_bits k))
[rsa_1024,pkcs1_enc_1024 () ; rsa_2048,pkcs1_enc_2048 () ; rsa_4096,pkcs1_enc_4096 ()]) ;
bm "rsa-pkcs1-sign" (fun name ->
count name (fun key -> Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:`SHA256 ~key (`Message msg_str))
(fun k -> string_of_int (Mirage_crypto_pk.Rsa.priv_bits k))
[rsa_1024;rsa_2048;rsa_4096]) ;
bm "rsa-pkcs1-verify" (fun name ->
count name (fun (key, signature) ->
Mirage_crypto_pk.Rsa.(PKCS1.verify ~hashp:(fun _ -> true) ~key:(pub_of_priv key) ~signature (`Message msg_str)))
(fun (k, _) -> string_of_int (Mirage_crypto_pk.Rsa.priv_bits k))
[rsa_1024,pkcs1_sig_1024 () ; rsa_2048,pkcs1_sig_2048 () ; rsa_4096,pkcs1_sig_4096 ()]) ;
bm "rsa-pss-sign" (fun name ->
count name (fun key -> PSS.sign ~key (`Message msg_str))
(fun k -> string_of_int (Mirage_crypto_pk.Rsa.priv_bits k))
[rsa_1024;rsa_2048;rsa_4096]) ;
bm "rsa-pss-verify" (fun name ->
count name (fun (key, signature) ->
PSS.verify ~key:(Mirage_crypto_pk.Rsa.pub_of_priv key) ~signature (`Message msg_str))
(fun (k, _) -> string_of_int (Mirage_crypto_pk.Rsa.priv_bits k))
[rsa_1024,pss_sig_1024 () ; rsa_2048,pss_sig_2048 () ; rsa_4096,pss_sig_4096 ()]) ;
bm "dsa-generate" (fun name ->
count name (fun ks -> Mirage_crypto_pk.Dsa.generate ks)
(function `Fips1024 -> "1024" | `Fips2048 -> "2048" | `Fips3072 -> "3072" | `Exactly (l, _) -> string_of_int l)
[`Fips1024;`Fips2048;`Fips3072]);
bm "dsa-sign" (fun name ->
count name (fun key -> Mirage_crypto_pk.Dsa.sign ~key msg_str)
(fun k -> string_of_int (Z.numbits k.p))
[dsa_1024;dsa_2048;dsa_3072]);
bm "dsa-verify" (fun name ->
count name (fun (key, signature) ->
Mirage_crypto_pk.Dsa.(verify ~key:(pub_of_priv key) signature msg_str))
(fun (k, _) -> string_of_int (Z.numbits k.p))
[dsa_1024,dsa_sig_1024 () ; dsa_2048,dsa_sig_2048 () ; dsa_3072,dsa_sig_3072 ()]);
bm "ecdsa-generate" (fun name ->
let open Mirage_crypto_ec in
count name
(fun (_, x) -> match x with
| `P256 _ -> P256.Dsa.generate () |> ignore
| `P384 _ -> P384.Dsa.generate () |> ignore
| `P521 _ -> P521.Dsa.generate () |> ignore
| `Ed25519 _ -> Ed25519.generate () |> ignore
)
fst ecdsas);
bm "ecdsa-sign" (fun name ->
let open Mirage_crypto_ec in
count name (fun (_, x) -> match x with
| `P256 (key, _) -> P256.Dsa.sign ~key msg_str_32
| `P384 (key, _) -> P384.Dsa.sign ~key msg_str_48
| `P521 (key, _) -> P521.Dsa.sign ~key msg_str_65
| `Ed25519 (key, _) -> Ed25519.sign ~key msg_str, ""
)
fst ecdsas);
bm "ecdsa-verify" (fun name ->
let open Mirage_crypto_ec in
count name (fun (_, x) -> match x with
| `P256 (key, signature) -> P256.Dsa.(verify ~key:(pub_of_priv key) signature msg_str_32)
| `P384 (key, signature) -> P384.Dsa.(verify ~key:(pub_of_priv key) signature msg_str_48)
| `P521 (key, signature) -> P521.Dsa.(verify ~key:(pub_of_priv key) signature msg_str_65)
| `Ed25519 (key, signature) -> Ed25519.(verify ~key:(pub_of_priv key) signature ~msg:msg_str)
) fst ecdsas);
bm "dh-secret" (fun name ->
count name (fun (_, group) -> Mirage_crypto_pk.Dh.gen_key group)
fst dh_groups);
bm "dh-share" (fun name ->
count name (fun (_, (sec, share)) ->
Mirage_crypto_pk.Dh.shared sec share)
(fun ((g, _), _) -> g) dh_secrets);
bm "ecdh-secret" (fun name ->
let open Mirage_crypto_ec in
count name (fun (_, x) -> match x with
| `P256 _ -> P256.Dh.gen_key () |> ignore
| `P384 _ -> P384.Dh.gen_key () |> ignore
| `P521 _ -> P521.Dh.gen_key () |> ignore
| `X25519 _ -> X25519.gen_key () |> ignore)
fst ecdh_shares);
bm "ecdh-share" (fun name ->
let open Mirage_crypto_ec in
count name (fun (_, x) -> match x with
| `P256 (sec, share) -> P256.Dh.key_exchange sec share |> Result.get_ok |> ignore
| `P384 (sec, share) -> P384.Dh.key_exchange sec share |> Result.get_ok |> ignore
| `P521 (sec, share) -> P521.Dh.key_exchange sec share |> Result.get_ok |> ignore
| `X25519 (sec, share) -> X25519.key_exchange sec share |> Result.get_ok |> ignore)
fst ecdh_shares);
bm "chacha20-poly1305" (fun name ->
let key = Chacha20.of_secret (Mirage_crypto_rng.generate 32)
and nonce = Mirage_crypto_rng.generate 8 in
throughput_into ~add:Chacha20.tag_size name
(fun dst cs -> Chacha20.authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs))) ;
bm "chacha20-poly1305-unsafe" (fun name ->
let key = Chacha20.of_secret (Mirage_crypto_rng.generate 32)
and nonce = Mirage_crypto_rng.generate 8 in
throughput_into ~add:Chacha20.tag_size name
(fun dst cs -> Chacha20.unsafe_authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs))) ;
bm "aes-128-ecb" (fun name ->
let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 16) in
throughput_into name
(fun dst cs -> AES.ECB.encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-192-ecb" (fun name ->
let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 24) in
throughput_into name (fun dst cs -> AES.ECB.encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-192-ecb-unsafe" (fun name ->
let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 24) in
throughput_into name (fun dst cs -> AES.ECB.unsafe_encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-256-ecb" (fun name ->
let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 32) in
throughput_into name (fun dst cs -> AES.ECB.encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-256-ecb-unsafe" (fun name ->
let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 32) in
throughput_into name (fun dst cs -> AES.ECB.unsafe_encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-128-ecb-unsafe" (fun name ->
let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 16) in
throughput_into name
(fun dst cs -> AES.ECB.unsafe_encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-128-cbc-e" (fun name ->
let key = AES.CBC.of_secret (Mirage_crypto_rng.generate 16)
and iv = Mirage_crypto_rng.generate 16 in
throughput_into name
(fun dst cs -> AES.CBC.encrypt_into ~key ~iv cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-128-cbc-e-unsafe" (fun name ->
let key = AES.CBC.of_secret (Mirage_crypto_rng.generate 16)
and iv = Mirage_crypto_rng.generate 16 in
throughput_into name
(fun dst cs -> AES.CBC.unsafe_encrypt_into ~key ~iv cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-128-cbc-e-unsafe-inplace" (fun name ->
let key = AES.CBC.of_secret (Mirage_crypto_rng.generate 16)
and iv = Mirage_crypto_rng.generate 16 in
throughput name
(fun cs ->
let b = Bytes.unsafe_of_string cs in
AES.CBC.unsafe_encrypt_into_inplace ~key ~iv b ~dst_off:0 (String.length cs))) ;
bm "aes-128-cbc-d" (fun name ->
let key = AES.CBC.of_secret (Mirage_crypto_rng.generate 16)
and iv = Mirage_crypto_rng.generate 16 in
throughput_into name
(fun dst cs -> AES.CBC.decrypt_into ~key ~iv cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-128-cbc-d-unsafe" (fun name ->
let key = AES.CBC.of_secret (Mirage_crypto_rng.generate 16)
and iv = Mirage_crypto_rng.generate 16 in
throughput_into name
(fun dst cs -> AES.CBC.unsafe_decrypt_into ~key ~iv cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-128-ctr" (fun name ->
let key = Mirage_crypto_rng.generate 16 |> AES.CTR.of_secret
and ctr = Mirage_crypto_rng.generate 16 |> AES.CTR.ctr_of_octets in
throughput_into name (fun dst cs -> AES.CTR.encrypt_into ~key ~ctr cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-128-ctr-unsafe" (fun name ->
let key = Mirage_crypto_rng.generate 16 |> AES.CTR.of_secret
and ctr = Mirage_crypto_rng.generate 16 |> AES.CTR.ctr_of_octets in
throughput_into name (fun dst cs -> AES.CTR.unsafe_encrypt_into ~key ~ctr cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "aes-128-gcm" (fun name ->
let key = AES.GCM.of_secret (Mirage_crypto_rng.generate 16)
and nonce = Mirage_crypto_rng.generate 12 in
throughput_into ~add:AES.GCM.tag_size name
(fun dst cs -> AES.GCM.authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs)));
bm "aes-128-gcm-unsafe" (fun name ->
let key = AES.GCM.of_secret (Mirage_crypto_rng.generate 16)
and nonce = Mirage_crypto_rng.generate 12 in
throughput_into ~add:AES.GCM.tag_size name
(fun dst cs -> AES.GCM.unsafe_authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs)));
bm "aes-128-ghash" (fun name ->
let key = AES.GCM.of_secret (Mirage_crypto_rng.generate 16)
and nonce = Mirage_crypto_rng.generate 12 in
throughput_into ~add:AES.GCM.tag_size name
(fun dst cs -> AES.GCM.authenticate_encrypt_into ~key ~nonce ~adata:cs "" ~src_off:0 dst ~dst_off:0 ~tag_off:0 0));
bm "aes-128-ghash-unsafe" (fun name ->
let key = AES.GCM.of_secret (Mirage_crypto_rng.generate 16)
and nonce = Mirage_crypto_rng.generate 12 in
throughput_into ~add:AES.GCM.tag_size name
(fun dst cs -> AES.GCM.unsafe_authenticate_encrypt_into ~key ~nonce ~adata:cs "" ~src_off:0 dst ~dst_off:0 ~tag_off:0 0));
bm "aes-128-ccm" (fun name ->
let key = AES.CCM16.of_secret (Mirage_crypto_rng.generate 16)
and nonce = Mirage_crypto_rng.generate 10 in
throughput_into ~add:AES.CCM16.tag_size name
(fun dst cs -> AES.CCM16.authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs)));
bm "aes-128-ccm-unsafe" (fun name ->
let key = AES.CCM16.of_secret (Mirage_crypto_rng.generate 16)
and nonce = Mirage_crypto_rng.generate 10 in
throughput_into ~add:AES.CCM16.tag_size name
(fun dst cs -> AES.CCM16.unsafe_authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs)));
bm "d3des-ecb" (fun name ->
let key = DES.ECB.of_secret (Mirage_crypto_rng.generate 24) in
throughput_into name (fun dst cs -> DES.ECB.encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "d3des-ecb-unsafe" (fun name ->
let key = DES.ECB.of_secret (Mirage_crypto_rng.generate 24) in
throughput_into name (fun dst cs -> DES.ECB.unsafe_encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ;
bm "fortuna" (fun name ->
begin[@alert "-deprecated"]
Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna);
throughput name (fun buf ->
let buf = Bytes.unsafe_of_string buf in
Mirage_crypto_rng.generate_into buf ~off:0 (Bytes.length buf))
end);
bm "getentropy" (fun name ->
Mirage_crypto_rng_unix.use_getentropy ();
throughput name (fun buf ->
let buf = Bytes.unsafe_of_string buf in
Mirage_crypto_rng.generate_into buf ~off:0 (Bytes.length buf))) ;
bm "urandom" (fun name ->
Mirage_crypto_rng_unix.use_dev_urandom ();
throughput name (fun buf ->
let buf = Bytes.unsafe_of_string buf in
Mirage_crypto_rng.generate_into buf ~off:0 (Bytes.length buf))) ;
]
let help () =
Printf.printf "available benchmarks:\n ";
List.iter (fun (n, _) -> Printf.printf "%s " n) benchmarks ;
Printf.printf "\n%!"
let runv fs =
Format.printf "accel: %a\n%!"
(fun ppf -> List.iter @@ fun x ->
Format.fprintf ppf "%s " @@
match x with `XOR -> "XOR" | `AES -> "AES" | `GHASH -> "GHASH")
accelerated;
Time.warmup () ;
List.iter (fun f -> f ()) fs
let () =
let seed = "abcd" in
let g = Mirage_crypto_rng.(create ~seed (module Fortuna)) in
Mirage_crypto_rng.set_default_generator g;
match Array.to_list Sys.argv with
| _::(_::_ as args) -> begin
try
let fs =
args |> List.map @@ fun n ->
snd (benchmarks |> List.find @@ fun (n1, _) -> n = n1) in
runv fs
with Not_found -> help ()
end
| _ -> help ()

72
unikernel/duniverse/mirage-crypto/config/cfg.ml Normal file
View file

@ -0,0 +1,72 @@
let () =
let c = Configurator.V1.create "mirage-crypto" in
let ccomp_type_opt = Configurator.V1.ocaml_config_var c "ccomp_type" in
let arch =
let defines =
Configurator.V1.C_define.import
c
~includes:[]
[("__x86_64__", Switch); ("__i386__", Switch); ("__powerpc64__", Switch);
("__s390x__", Switch); ("__aarch64__", Switch);
("_WIN64", Switch); ("_WIN32", Switch)]
in
match defines with
| (_, Switch true) :: _ -> `x86_64
| _ :: (_, Switch true) :: _ -> `x86
| _ :: _ :: (_, Switch true) :: _ -> `ppc64
| _ :: _ :: _ :: (_, Switch true) :: _ -> `s390x
| _ :: _ :: _ :: _ :: (_, Switch true) :: _ -> `arm64
| _ :: _ :: _ :: _ :: _ :: (_, Switch true) :: _ -> `x86_64
| _ :: _ :: _ :: _ :: _ :: _ :: (_, Switch true) :: _ -> `x86
| _ -> `unknown
in
let os =
let defines =
Configurator.V1.C_define.import
c
~includes:[]
[("__APPLE__", Switch)]
in
match defines with
| (_, Switch true) :: _ -> `macos
| _ -> `unknown
in
let accelerate_flags =
match arch, ccomp_type_opt with
| `x86_64, Some "msvc" -> [ "-DACCELERATE" ]
| `x86_64, _ -> [ "-DACCELERATE"; "-mssse3"; "-maes"; "-mpclmul" ]
| _ -> []
in
let ent_flags =
match arch, ccomp_type_opt with
| (`x86_64 | `x86), Some "msvc" -> [ "-DENTROPY" ]
| (`x86_64 | `x86), _ -> [ "-DENTROPY"; "-mrdrnd"; "-mrdseed" ]
| _ -> []
in
let std_flags =
match ccomp_type_opt with
| Some "msvc" -> ["/Wall"]
| _ -> ["--std=c11"; "-Wall"; "-Wextra"; "-Wpedantic"; "-O3"]
in
let warn_flags =
(* See #178, there may be false positives on ppc&s390 with no-stringop-overflow *)
match arch, ccomp_type_opt with
| _, Some "msvc" -> [ "/WX" ]
| (`ppc64, _) | (`s390x, _) -> [ "-Wno-stringop-overflow"; "-Werror" ]
| _ -> [ "-Werror" ]
in
let no_instcombine_on_macos = match arch, os with
| `arm64, `macos ->
let res = Configurator.V1.Process.run c "cc" ["-dumpversion"] in
if String.trim res.stdout = "14.0.3" then
["-mllvm"; "--instcombine-max-iterations=0"]
(* macOS instcombine miscompilation with clang 14.0.3 *)
else
[]
| _ -> []
in
let flags = std_flags @ no_instcombine_on_macos @ ent_flags in
let opt_flags = flags @ accelerate_flags in
Configurator.V1.Flags.write_sexp "cflags_optimized.sexp" opt_flags;
Configurator.V1.Flags.write_sexp "cflags.sexp" flags;
Configurator.V1.Flags.write_sexp "cflags_warn.sexp" warn_flags

3
unikernel/duniverse/mirage-crypto/config/dune Normal file
View file

@ -0,0 +1,3 @@
(executables
(names cfg)
(libraries dune-configurator))

4
unikernel/duniverse/mirage-crypto/dune-project Normal file
View file

@ -0,0 +1,4 @@
(lang dune 2.7)
(name mirage-crypto)
(version v2.0.2)
(formatting disabled)

23
unikernel/duniverse/mirage-crypto/ec/dune Normal file
View file

@ -0,0 +1,23 @@
(library
(name mirage_crypto_ec)
(public_name mirage-crypto-ec)
(libraries eqaf mirage-crypto-rng digestif)
(foreign_stubs
(language c)
(names p256_stubs np256_stubs p384_stubs np384_stubs p521_stubs np521_stubs
curve25519_stubs)
(include_dirs ../src/native)
(flags
(:standard -DNDEBUG)
(:include cflags_optimized.sexp))))
(env
(dev
(c_flags (:include cflags_warn.sexp))))
(include_subdirs unqualified)
(rule
(targets cflags_optimized.sexp cflags_warn.sexp)
(action
(run ../config/cfg.exe)))

4
unikernel/duniverse/mirage-crypto/ec/gen_tables/dune Normal file
View file

@ -0,0 +1,4 @@
(include_subdirs no)
(executable
(name gen_tables)
(libraries mirage_crypto_ec))

112
unikernel/duniverse/mirage-crypto/ec/gen_tables/gen_tables.ml Normal file
View file

@ -0,0 +1,112 @@
open Format
let print_header name =
printf
{|
/*
Pre-computed %d-bit multiples of the generator point G for the curve %s,
used for speeding up its scalar multiplication in point_operations.h.
Generated by %s
*/|}
Sys.word_size name Sys.argv.(0)
let pp_array elem_fmt fmt arr =
let fout = fprintf fmt in
let len = Array.length arr in
fout "@[<2>{@\n";
for i = 0 to len - 1 do
elem_fmt fmt arr.(i);
if i < len - 1 then printf ",@ " else printf ""
done;
fout "@]@,}"
let div_round_up a b = (a / b) + if a mod b = 0 then 0 else 1
let pp_string_words ~wordsize fmt str =
assert (String.length str * 8 mod wordsize = 0);
let limbs = String.length str * 8 / wordsize in
(* Truncate at the beginning (little-endian) *)
let bytes = Bytes.unsafe_of_string str in
(* let bytes = rev_str_bytes str in *)
fprintf fmt "@[<2>{@\n";
for i = 0 to limbs - 1 do
let index = i * (wordsize / 8) in
(if wordsize = 64 then
let w = Bytes.get_int64_le bytes index in
fprintf fmt "%#016Lx" w
else
let w = Bytes.get_int32_le bytes index in
fprintf fmt "%#08lx" w);
if i < limbs - 1 then printf ",@ " else printf ""
done;
fprintf fmt "@]@,}"
let check_shape tables =
let fe_len = String.length tables.(0).(0).(0) in
let table_len = fe_len * 2 in
assert (Array.length tables = table_len);
Array.iter
(fun x ->
assert (Array.length x = 15);
Array.iter
(fun x ->
assert (Array.length x = 3);
Array.iter (fun x -> assert (String.length x = fe_len)) x)
x)
tables
let print_tables tables ~wordsize =
let fe_len = String.length tables.(0).(0).(0) in
printf "@[<2>static WORD generator_table[%d][15][3][LIMBS] = @," (fe_len * 2);
pp_array
(pp_array (pp_array (pp_string_words ~wordsize)))
std_formatter tables;
printf "@];@,"
let print_toplevel name wordsize (module P : Mirage_crypto_ec.Dh_dsa) =
let tables = P.Dsa.Precompute.generator_tables () in
assert (wordsize = Sys.word_size);
check_shape tables;
print_header name;
if wordsize = 64 then
printf
"@[<v>#ifndef ARCH_64BIT@,\
#error \"Cannot use 64-bit tables on a 32-bit architecture\"@,\
#endif@,\
@]"
else
printf
"@[<v>#ifdef ARCH_64BIT@,\
#error \"Cannot use 32-bit tables on a 64-bit architecture\"@,\
#endif@,\
@]";
print_tables ~wordsize tables
let curves =
Mirage_crypto_ec.
[
("p256", (module P256 : Dh_dsa));
("p384", (module P384));
("p521", (module P521));
]
let usage () =
printf "Usage: gen_tables [%a] [64 | 32]@."
(pp_print_list
~pp_sep:(fun fmt () -> pp_print_string fmt " | ")
pp_print_string)
(List.map fst curves)
let go =
let name, curve, wordsize =
try
let name, curve =
List.find (fun (name, _) -> name = Sys.argv.(1)) curves
in
(name, curve, int_of_string Sys.argv.(2))
with _ ->
usage ();
exit 1
in
print_toplevel name wordsize curve

82
unikernel/duniverse/mirage-crypto/ec/implementation.mld Normal file
View file

@ -0,0 +1,82 @@
{1 Implementation }
The goal of this document is to describe how the library is implemented.
{2 Field operations}
These are implemented in [Field_element], which is a binding over
[p256_{32,64}.h]. These are files extracted from Coq code in
{{:https://github.com/mit-plv/fiat-crypto}this repository}.
This module uses
{{:https://en.wikipedia.org/wiki/Montgomery_modular_multiplication} Montgomery
Modular Multiplication}. Instead of storing a number [a], operations are done
on [aR] where R = 2{^256}.
It is possible to check that these files correspond to the extracted ones in
the upstream repository by running [dune build @check_vendors].
These files are part of the trusted computing base. That is, using this package
relies on the fact that they implemented the correct algorithms. To go further,
one can re-run the extraction process from Coq sources, see
{{:https://github.com/mirage/fiat/issues/41}#41}.
{2 Point operations}
Points (see the [Point] module) are stored using projective coordinates (X : Y
: Z):
- Z=0 corresponds to the point at infinity
- for Z≠0, this corresponds to a point with affine coordinates (X/Z{^2},
Y/Z{^3})
Doubling and addition are implemented as C stubs in [p256_stubs.c] using code
that comes from BoringSSL, Google's fork of OpenSSL. Fiat code has been design
in part to be included in BoringSSL, so this does not require any particular
glue code.
Some operations are implemented manually, in particular:
- conversion to affine coordinates, as described above. This relies on a field
inversion primitive from BoringSSL, that is exposed in [Field_element].
- point verification (bound checking and making sure that the equation is
satisfied).
There is no automated way to check that the BoringSSL part is identical to that
in the upstream repository (nor to update it).
{2 Scalar multiplication}
Implemented by hand using the
{{:https://cr.yp.to/bib/2003/joye-ladder.pdf}Montgomery Powering Ladder}.
Instead of branching based on key bits, constant-time selection (as defined in
fiat code) is used.
The following references discuss this algorithm:
- {{:https://cryptojedi.org/peter/data/eccss-20130911b.pdf}Scalar-multiplication algorithms, Peter Schwabe, ECC 2013 Summer School}
- {{:https://eprint.iacr.org/2017/293.pdf}Montgomery curves and the Montgomery
ladder, Daniel J. Bernstein and Tanja Lange}
For the special case of base scalar multiplication (where the generator point of
the curve specifically is multiplied by a scalar), instead an algorithm
(implemented by hand in C) using pre-computed tables of point doubling is used
(tables are in `native/p*_tables_32|64.c`).
The key for this algorithm being constant-time is the function selecting values
from the tables, which conceals what value it selects by exploring the whole
table in the same order no matter the input, using const-time selection (as
defined in fiat code). See `native/point_operations.h`.
{2 Key exchange}
Key exchange consists in
- validating the public key as described in
{{:https://tools.ietf.org/html/rfc8446#section-4.2.8.2}RFC 8446 §4.2.8.2};
- computing scalar multiplication;
- returning the encoded x coordinate of the result.
This is implemented by hand and checked against common errors using test
vectors from {{:https://github.com/google/wycheproof}project Wycheproof}.

1090
unikernel/duniverse/mirage-crypto/ec/mirage_crypto_ec.ml Normal file
View file

File diff suppressed because it is too large Load diff

224
unikernel/duniverse/mirage-crypto/ec/mirage_crypto_ec.mli Normal file
View file

@ -0,0 +1,224 @@
(** {1 Elliptic curve cryptography} *)
(** Mirage-crypto-ec implements public key cryptography with named elliptic
curves. Ephemeral key exchanges with {{!Dh}Diffie-Hellman} and
{{!Dsa}digital signatures (ECDSA)} are implemented.
The arithmetic operations uses code generated by
{{:https://github.com/mit-plv/fiat-crypto}fiat-crypto} which is proven to
consume a constant amount of time, independent of the input values.
*)
type error = [
| `Invalid_range
| `Invalid_format
| `Invalid_length
| `Not_on_curve
| `At_infinity
| `Low_order
]
(** The type for errors. *)
val pp_error : Format.formatter -> error -> unit
(** Pretty printer for errors *)
exception Message_too_long
(** Raised if the provided message is too long for the curve. *)
(** Diffie-Hellman key exchange. *)
module type Dh = sig
type secret
(** Type for private keys. *)
val secret_of_octets : ?compress:bool -> string ->
(secret * string, error) result
(** [secret_of_octets ~compress secret] decodes the provided buffer as
{!secret}. If [compress] is provided and [true] (defaults to [false]),
the shared part will be compressed. May result in an error if the buffer
had an invalid length or was not in bounds. *)
val secret_to_octets : secret -> string
(** [secret_to_octets secret] encodes the provided secret into a freshly
allocated buffer. *)
val gen_key : ?compress:bool -> ?g:Mirage_crypto_rng.g -> unit ->
secret * string
(** [gen_key ~compress ~g ()] generates a private and a public key for
Ephemeral Diffie-Hellman. If [compress] is provided and [true] (defaults
to [false]), the shared part will be compressed. The returned key pair
MUST only be used for a single key exchange.
The generated private key is checked to be greater than zero and lower
than the group order meaning the public key cannot be the point at
inifinity. *)
val key_exchange : secret -> string -> (string, error) result
(** [key_exchange secret received_public_key] performs Diffie-Hellman key
exchange using your secret and the data received from the other party.
Returns the shared secret or an error if the received data is wrongly
encoded, doesn't represent a point on the curve or represent the point
at infinity.
The shared secret is returned as is i.e. not stripped from leading 0x00
bytes.
The public key encoding is described
{{:http://www.secg.org/sec1-v2.pdf}in SEC 1} from SECG. *)
end
(** Digital signature algorithm. *)
module type Dsa = sig
type priv
(** The type for private keys. *)
type pub
(** The type for public keys. *)
val byte_length : int
(** [byte_length] is the size of a ECDSA signature in bytes. *)
val bit_length : int
(** [bit_length] is the number of significant bits in a ECDSA signature *)
(** {2 Serialisation} *)
val priv_of_octets : string -> (priv, error) result
(** [priv_of_octets buf] decodes a private key from the buffer [buf]. If the
provided data is invalid, an error is returned. *)
val priv_to_octets : priv -> string
(** [priv_to_octets p] encode the private key [p] to a buffer. *)
val pub_of_octets : string -> (pub, error) result
(** [pub_of_octets buf] decodes a public key from the buffer [buf]. If the
provided data is invalid, an error is returned. *)
val pub_to_octets : ?compress:bool -> pub -> string
(** [pub_to_octets ~compress p] encodes the public key [p] into a buffer.
If [compress] is provided and [true] (default [false]), the compressed
representation is returned. *)
(** {2 Deriving the public key} *)
val pub_of_priv : priv -> pub
(** [pub_of_priv p] extracts the public key from the private key [p]. *)
(** {2 Key generation} *)
val generate : ?g:Mirage_crypto_rng.g -> unit -> priv * pub
(** [generate ~g ()] generates a key pair. *)
(** {2 Cryptographic operations} *)
val sign : key:priv -> ?k:string -> string -> string * string
(** [sign ~key ~k digest] signs the message [digest] using the private
[key]. The [digest] is not processed further - it should be the hash of
the message to sign. If [k] is not provided, it is computed using the
deterministic construction from RFC 6979. The result is a pair of [r]
and [s].
Warning: there {{:https://www.hertzbleed.com/2h2b.pdf}are}
{{:https://www.hertzbleed.com/hertzbleed.pdf}attacks} that recover the
private key from a power and timing analysis of the RFC 6979 computation
of [k] - thus it is advised to provide a good nonce ([k]) explicitly,
which is independent of key and digest.
@raise Invalid_argument if [k] is not suitable or not in range.
@raise Message_too_long if the bit size of [msg] exceeds the curve. *)
val verify : key:pub -> string * string -> string -> bool
(** [verify ~key (r, s) digest] verifies the signature [r, s] on the message
[digest] with the public [key]. The return value is [true] if verification
was successful, [false] otherwise. If the message has more bits than the
group order, the result is false. *)
(** [K_gen] can be instantiated over a hashing module to obtain an RFC6979
compliant [k]-generator for that hash. *)
module K_gen (H : Digestif.S) : sig
val generate : key:priv -> string -> string
(** [generate ~key digest] deterministically takes the given private key
and message digest to a [k] suitable for seeding the signing process. *)
end
(** {2 Misc} *)
(** Operations to precompute useful data meant to be hardcoded in
[mirage-crypto-ec] before compilation *)
module Precompute : sig
val generator_tables : unit -> string array array array
(** Return an array of shape (Fe_length * 2, 15, 3) containing multiples of
the generator point for the curve. Useful only to bootstrap tables
necessary for scalar multiplication. *)
end
end
(** Elliptic curve with Diffie-Hellman and DSA. *)
module type Dh_dsa = sig
(** Diffie-Hellman key exchange. *)
module Dh : Dh
(** Digital signature algorithm. *)
module Dsa : Dsa
end
(** The NIST P-256 curve, also known as SECP256R1. *)
module P256 : Dh_dsa
(** The NIST P-384 curve, also known as SECP384R1. *)
module P384 : Dh_dsa
(** The NIST P-521 curve, also known as SECP521R1. *)
module P521 : Dh_dsa
(** Curve 25519 Diffie-Hellman, also known as X25519. *)
module X25519 : Dh
(** Curve 25519 DSA, also known as Ed25519. *)
module Ed25519 : sig
type priv
(** The type for private keys. *)
type pub
(** The type for public keys. *)
(** {2 Serialisation} *)
val priv_of_octets : string -> (priv, error) result
(** [priv_of_octets buf] decodes a private key from the buffer [buf]. If the
provided data is invalid, an error is returned. *)
val priv_to_octets : priv -> string
(** [priv_to_octets p] encode the private key [p] to a buffer. *)
val pub_of_octets : string -> (pub, error) result
(** [pub_of_octets buf] decodes a public key from the buffer [buf]. If the
provided data is invalid, an error is returned. *)
val pub_to_octets : pub -> string
(** [pub_to_octets p] encodes the public key [p] into a buffer. *)
(** {2 Deriving the public key} *)
val pub_of_priv : priv -> pub
(** [pub_of_priv p] extracts the public key from the private key [p]. *)
(** {2 Key generation} *)
val generate : ?g:Mirage_crypto_rng.g -> unit -> priv * pub
(** [generate ~g ()] generates a key pair. *)
(** {2 Cryptographic operations} *)
val sign : key:priv -> string -> string
(** [sign ~key msg] signs the message [msg] using the private [key]. The
result is the concatenation of [r] and [s], as specified in RFC 8032. *)
val verify : key:pub -> string -> msg:string -> bool
(** [verify ~key signature msg] verifies the [signature] on the message
[msg] with the public [key]. The return value is [true] if verification
was successful, [false] otherwise. *)
end

152
unikernel/duniverse/mirage-crypto/ec/native/GNUmakefile Normal file
View file

@ -0,0 +1,152 @@
# This file is part of mirage-crypto-ec, and used to generate C files
# As a prerequisite, fiat-crypto (https://github.com/mit-plv/fiat-crypto)
# needs to be cloned and "make standalone-ocaml" invoked
# The lowest bound of fiat-crypto is git commit
# dabaf4b3132e8bb4a3f5fcd8366eec6ac9bb4232 (July 16th 2021)
# Generated on FreeBSD 12.2p2 with coq 8.13.1 (OCaml 4.12.0)
# with fiat-crypto 2a07751f37af74edeac47b19bd51810bc99b91a1 (May 29th 2022)
WBW_MONT ?= ../../../fiat-crypto/src/ExtractionOCaml/word_by_word_montgomery --static --use-value-barrier --inline-internal
UNSAT_SOLINAS ?= ../../../fiat-crypto/src/ExtractionOCaml/unsaturated_solinas --static --use-value-barrier --inline-internal
N_FUNCS=mul add opp from_montgomery to_montgomery one msat divstep_precomp divstep to_bytes from_bytes selectznz
GEN_TABLE=../../_build/default/ec/gen_tables/gen_tables.exe
# The NIST curve P-256 (AKA SECP256R1)
P256="2^256 - 2^224 + 2^192 + 2^96 - 1"
.PHONY: p256_64.h
p256_64.h:
$(WBW_MONT) p256 64 $(P256) > $@
.PHONY: p256_32.h
p256_32.h:
$(WBW_MONT) p256 32 $(P256) > $@
# The group order N of P-256
P256N="0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551"
.PHONY: np256_64.h
np256_64.h:
$(WBW_MONT) np256 64 $(P256N) $(N_FUNCS) > $@
.PHONY: np256_32.h
np256_32.h:
$(WBW_MONT) np256 32 $(P256N) $(N_FUNCS) > $@
.PHONY: p256_tables_64.h
p256_tables_64.h:
$(GEN_TABLE) p256 64 > $@
.PHONY: p256_tables_32.h
p256_tables_32.h:
$(GEN_TABLE) p256 32 > $@
.PHONY: p256
p256: p256_64.h p256_32.h np256_64.h np256_32.h
p256_tables: p256_tables_64.h p256_tables_32.h
# The NIST curve P-384 (AKA SECP384R1)
P384="2^384 - 2^128 - 2^96 + 2^32 - 1"
.PHONY: p384_64.h
p384_64.h:
$(WBW_MONT) p384 64 $(P384) > $@
.PHONY: p384_32.h
p384_32.h:
$(WBW_MONT) p384 32 $(P384) > $@
# The group order N of P-384
P384N="0xffffffffffffffffffffffffffffffffffffffffffffffffc7634d81f4372ddf581a0db248b0a77aecec196accc52973"
.PHONY: np384_64.h
np384_64.h:
$(WBW_MONT) np384 64 $(P384N) $(N_FUNCS) > $@
.PHONY: np384_32.h
np384_32.h:
$(WBW_MONT) np384 32 $(P384N) $(N_FUNCS) > $@
.PHONY: p384_tables_64.h
p384_tables_64.h:
$(GEN_TABLE) p384 64 > $@
.PHONY: p384_tables_32.h
p384_tables_32.h:
$(GEN_TABLE) p384 32 > $@
.PHONY: p384
p384: p384_64.h p384_32.h np384_64.h np384_32.h
p384_tables: p384_tables_64.h p384_tables_32.h
# The NIST curve P-521 (AKA SECP521R1)
P521="2^521 - 1"
.PHONY: p521_64.h
p521_64.h:
$(WBW_MONT) p521 64 $(P521) > $@
.PHONY: p521_32.h
p521_32.h:
$(WBW_MONT) p521 32 $(P521) > $@
# The group order N of P-521
P521N="0x01FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA51868783BF2F966B7FCC0148F709A5D03BB5C9B8899C47AEBB6FB71E91386409"
.PHONY: np521_64.h
np521_64.h:
$(WBW_MONT) np521 64 $(P521N) $(N_FUNCS) > $@
.PHONY: np521_32.h
np521_32.h:
$(WBW_MONT) np521 32 $(P521N) $(N_FUNCS) > $@
.PHONY: p521_tables_64.h
p521_tables_64.h:
$(GEN_TABLE) p521 64 > $@
.PHONY: p521_tables_32.h
p521_tables_32.h:
$(GEN_TABLE) p521 32 > $@
.PHONY: p521
p521: p521_64.h p521_32.h np521_64.h np521_32.h
p521_tables: p521_tables_64.h p521_tables_32.h
# 25519
25519="2^255 - 19"
25519_FUNS=carry_mul carry_square carry add sub opp selectznz to_bytes from_bytes carry_scmul121666
.PHONY: curve25519_64.h
curve25519_64.h:
$(UNSAT_SOLINAS) 25519 64 '(auto)' $(25519) $(25519_FUNS) > $@
.PHONY: curve25519_32.h
curve25519_32.h:
$(UNSAT_SOLINAS) 25519 32 '(auto)' $(25519) $(25519_FUNS) > $@
.PHONY: curve25519
curve25519: curve25519_64.h curve25519_32.h
.PHONY: tables
tables: p256_tables p384_tables p521_tables
.PHONY: clean
clean:
$(RM) p256_32.h p256_64.h np256_32.h np256_64.h
$(RM) p384_32.h p384_64.h np384_32.h np384_64.h
$(RM) p521_32.h p521_64.h np521_32.h np521_64.h
$(RM) curve25519_32.h curve25519_64.h
.PHONY: clean_tables
clean_tables:
$(RM) p256_tables_32.h p256_tables_64.h
$(RM) p384_tables_32.h p384_tables_64.h
$(RM) p521_tables_32.h p521_tables_64.h
.PHONY: all
all: p256 p384 p521 curve25519

23
unikernel/duniverse/mirage-crypto/ec/native/README.md Normal file
View file

@ -0,0 +1,23 @@
# Generated code from fiat
This directory includes several files ("p*.h") that are generated by
[fiat](https://github.com/mit-plv/fiat-crypto). The GNUmakefile provides
targets to generate these files.
The file "inversion_template.h" is copied from the fiat-crypto repository
at e31a36d5f1b20134e67ccc5339d88f0ff3cb0f86 (inversion-c/inversion_template.c),
and has some modifications: the "inversion" function is declared "static",
and the convenience function "inversion" is provided.
The "*_stubs.c" files are handcrafted.
The "p*_tables_32/64.c" are generated from `../gen_tables` (see each file's
header) and contain pre-computed data to speed up scalar multiplication for
ECDSA. The 64- and 32-bit tables must be respectively generated from a 64-bit or
32-bit build of `gen_tables`.
# Code from BoringSSL
The code in "curve25519_tables.h", and large parts of
"curve25519_stubs.c" and "point_operations.h" (excluding scalar multiplication)
originate from BoringSSL. Minor adjustments have been done manually.

1525
unikernel/duniverse/mirage-crypto/ec/native/curve25519_32.h Normal file
View file

File diff suppressed because it is too large Load diff

947
unikernel/duniverse/mirage-crypto/ec/native/curve25519_64.h Normal file
View file

@ -0,0 +1,947 @@
/* Autogenerated: '../fiat-crypto/src/ExtractionOCaml/unsaturated_solinas' --static --use-value-barrier --inline-internal 25519 64 '(auto)' '2^255 - 19' carry_mul carry_square carry add sub opp selectznz to_bytes from_bytes carry_scmul121666 */
/* curve description: 25519 */
/* machine_wordsize = 64 (from "64") */
/* requested operations: carry_mul, carry_square, carry, add, sub, opp, selectznz, to_bytes, from_bytes, carry_scmul121666 */
/* n = 5 (from "(auto)") */
/* s-c = 2^255 - [(1, 19)] (from "2^255 - 19") */
/* tight_bounds_multiplier = 1 (from "") */
/* */
/* Computed values: */
/* carry_chain = [0, 1, 2, 3, 4, 0, 1] */
/* eval z = z[0] + (z[1] << 51) + (z[2] << 102) + (z[3] << 153) + (z[4] << 204) */
/* bytes_eval z = z[0] + (z[1] << 8) + (z[2] << 16) + (z[3] << 24) + (z[4] << 32) + (z[5] << 40) + (z[6] << 48) + (z[7] << 56) + (z[8] << 64) + (z[9] << 72) + (z[10] << 80) + (z[11] << 88) + (z[12] << 96) + (z[13] << 104) + (z[14] << 112) + (z[15] << 120) + (z[16] << 128) + (z[17] << 136) + (z[18] << 144) + (z[19] << 152) + (z[20] << 160) + (z[21] << 168) + (z[22] << 176) + (z[23] << 184) + (z[24] << 192) + (z[25] << 200) + (z[26] << 208) + (z[27] << 216) + (z[28] << 224) + (z[29] << 232) + (z[30] << 240) + (z[31] << 248) */
/* balance = [0xfffffffffffda, 0xffffffffffffe, 0xffffffffffffe, 0xffffffffffffe, 0xffffffffffffe] */
#include <stdint.h>
typedef unsigned char fiat_25519_uint1;
typedef signed char fiat_25519_int1;
#if defined(__GNUC__) || defined(__clang__)
# define FIAT_25519_FIAT_EXTENSION __extension__
# define FIAT_25519_FIAT_INLINE __inline__
#else
# define FIAT_25519_FIAT_EXTENSION
# define FIAT_25519_FIAT_INLINE
#endif
FIAT_25519_FIAT_EXTENSION typedef signed __int128 fiat_25519_int128;
FIAT_25519_FIAT_EXTENSION typedef unsigned __int128 fiat_25519_uint128;
/* The type fiat_25519_loose_field_element is a field element with loose bounds. */
/* Bounds: [[0x0 ~> 0x18000000000000], [0x0 ~> 0x18000000000000], [0x0 ~> 0x18000000000000], [0x0 ~> 0x18000000000000], [0x0 ~> 0x18000000000000]] */
typedef uint64_t fiat_25519_loose_field_element[5];
/* The type fiat_25519_tight_field_element is a field element with tight bounds. */
/* Bounds: [[0x0 ~> 0x8000000000000], [0x0 ~> 0x8000000000000], [0x0 ~> 0x8000000000000], [0x0 ~> 0x8000000000000], [0x0 ~> 0x8000000000000]] */
typedef uint64_t fiat_25519_tight_field_element[5];
#if (-1 & 3) != 3
#error "This code only works on a two's complement system"
#endif
#if !defined(FIAT_25519_NO_ASM) && (defined(__GNUC__) || defined(__clang__))
static __inline__ uint64_t fiat_25519_value_barrier_u64(uint64_t a) {
__asm__("" : "+r"(a) : /* no inputs */);
return a;
}
#else
# define fiat_25519_value_barrier_u64(x) (x)
#endif
/*
* The function fiat_25519_addcarryx_u51 is an addition with carry.
*
* Postconditions:
* out1 = (arg1 + arg2 + arg3) mod 2^51
* out2 = ⌊(arg1 + arg2 + arg3) / 2^51⌋
*
* Input Bounds:
* arg1: [0x0 ~> 0x1]
* arg2: [0x0 ~> 0x7ffffffffffff]
* arg3: [0x0 ~> 0x7ffffffffffff]
* Output Bounds:
* out1: [0x0 ~> 0x7ffffffffffff]
* out2: [0x0 ~> 0x1]
*/
static FIAT_25519_FIAT_INLINE void fiat_25519_addcarryx_u51(uint64_t* out1, fiat_25519_uint1* out2, fiat_25519_uint1 arg1, uint64_t arg2, uint64_t arg3) {
uint64_t x1;
uint64_t x2;
fiat_25519_uint1 x3;
x1 = ((arg1 + arg2) + arg3);
x2 = (x1 & UINT64_C(0x7ffffffffffff));
x3 = (fiat_25519_uint1)(x1 >> 51);
*out1 = x2;
*out2 = x3;
}
/*
* The function fiat_25519_subborrowx_u51 is a subtraction with borrow.
*
* Postconditions:
* out1 = (-arg1 + arg2 + -arg3) mod 2^51
* out2 = -⌊(-arg1 + arg2 + -arg3) / 2^51⌋
*
* Input Bounds:
* arg1: [0x0 ~> 0x1]
* arg2: [0x0 ~> 0x7ffffffffffff]
* arg3: [0x0 ~> 0x7ffffffffffff]
* Output Bounds:
* out1: [0x0 ~> 0x7ffffffffffff]
* out2: [0x0 ~> 0x1]
*/
static FIAT_25519_FIAT_INLINE void fiat_25519_subborrowx_u51(uint64_t* out1, fiat_25519_uint1* out2, fiat_25519_uint1 arg1, uint64_t arg2, uint64_t arg3) {
int64_t x1;
fiat_25519_int1 x2;
uint64_t x3;
x1 = ((int64_t)(arg2 - (int64_t)arg1) - (int64_t)arg3);
x2 = (fiat_25519_int1)(x1 >> 51);
x3 = (x1 & UINT64_C(0x7ffffffffffff));
*out1 = x3;
*out2 = (fiat_25519_uint1)(0x0 - x2);
}
/*
* The function fiat_25519_cmovznz_u64 is a single-word conditional move.
*
* Postconditions:
* out1 = (if arg1 = 0 then arg2 else arg3)
*
* Input Bounds:
* arg1: [0x0 ~> 0x1]
* arg2: [0x0 ~> 0xffffffffffffffff]
* arg3: [0x0 ~> 0xffffffffffffffff]
* Output Bounds:
* out1: [0x0 ~> 0xffffffffffffffff]
*/
static FIAT_25519_FIAT_INLINE void fiat_25519_cmovznz_u64(uint64_t* out1, fiat_25519_uint1 arg1, uint64_t arg2, uint64_t arg3) {
fiat_25519_uint1 x1;
uint64_t x2;
uint64_t x3;
x1 = (!(!arg1));
x2 = ((fiat_25519_int1)(0x0 - x1) & UINT64_C(0xffffffffffffffff));
x3 = ((fiat_25519_value_barrier_u64(x2) & arg3) | (fiat_25519_value_barrier_u64((~x2)) & arg2));
*out1 = x3;
}
/*
* The function fiat_25519_carry_mul multiplies two field elements and reduces the result.
*
* Postconditions:
* eval out1 mod m = (eval arg1 * eval arg2) mod m
*
*/
static void fiat_25519_carry_mul(fiat_25519_tight_field_element out1, const fiat_25519_loose_field_element arg1, const fiat_25519_loose_field_element arg2) {
fiat_25519_uint128 x1;
fiat_25519_uint128 x2;
fiat_25519_uint128 x3;
fiat_25519_uint128 x4;
fiat_25519_uint128 x5;
fiat_25519_uint128 x6;
fiat_25519_uint128 x7;
fiat_25519_uint128 x8;
fiat_25519_uint128 x9;
fiat_25519_uint128 x10;
fiat_25519_uint128 x11;
fiat_25519_uint128 x12;
fiat_25519_uint128 x13;
fiat_25519_uint128 x14;
fiat_25519_uint128 x15;
fiat_25519_uint128 x16;
fiat_25519_uint128 x17;
fiat_25519_uint128 x18;
fiat_25519_uint128 x19;
fiat_25519_uint128 x20;
fiat_25519_uint128 x21;
fiat_25519_uint128 x22;
fiat_25519_uint128 x23;
fiat_25519_uint128 x24;
fiat_25519_uint128 x25;
fiat_25519_uint128 x26;
uint64_t x27;
uint64_t x28;
fiat_25519_uint128 x29;
fiat_25519_uint128 x30;
fiat_25519_uint128 x31;
fiat_25519_uint128 x32;
fiat_25519_uint128 x33;
uint64_t x34;
uint64_t x35;
fiat_25519_uint128 x36;
uint64_t x37;
uint64_t x38;
fiat_25519_uint128 x39;
uint64_t x40;
uint64_t x41;
fiat_25519_uint128 x42;
uint64_t x43;
uint64_t x44;
uint64_t x45;
uint64_t x46;
uint64_t x47;
uint64_t x48;
uint64_t x49;
fiat_25519_uint1 x50;
uint64_t x51;
uint64_t x52;
x1 = ((fiat_25519_uint128)(arg1[4]) * ((arg2[4]) * UINT8_C(0x13)));
x2 = ((fiat_25519_uint128)(arg1[4]) * ((arg2[3]) * UINT8_C(0x13)));
x3 = ((fiat_25519_uint128)(arg1[4]) * ((arg2[2]) * UINT8_C(0x13)));
x4 = ((fiat_25519_uint128)(arg1[4]) * ((arg2[1]) * UINT8_C(0x13)));
x5 = ((fiat_25519_uint128)(arg1[3]) * ((arg2[4]) * UINT8_C(0x13)));
x6 = ((fiat_25519_uint128)(arg1[3]) * ((arg2[3]) * UINT8_C(0x13)));
x7 = ((fiat_25519_uint128)(arg1[3]) * ((arg2[2]) * UINT8_C(0x13)));
x8 = ((fiat_25519_uint128)(arg1[2]) * ((arg2[4]) * UINT8_C(0x13)));
x9 = ((fiat_25519_uint128)(arg1[2]) * ((arg2[3]) * UINT8_C(0x13)));
x10 = ((fiat_25519_uint128)(arg1[1]) * ((arg2[4]) * UINT8_C(0x13)));
x11 = ((fiat_25519_uint128)(arg1[4]) * (arg2[0]));
x12 = ((fiat_25519_uint128)(arg1[3]) * (arg2[1]));
x13 = ((fiat_25519_uint128)(arg1[3]) * (arg2[0]));
x14 = ((fiat_25519_uint128)(arg1[2]) * (arg2[2]));
x15 = ((fiat_25519_uint128)(arg1[2]) * (arg2[1]));
x16 = ((fiat_25519_uint128)(arg1[2]) * (arg2[0]));
x17 = ((fiat_25519_uint128)(arg1[1]) * (arg2[3]));
x18 = ((fiat_25519_uint128)(arg1[1]) * (arg2[2]));
x19 = ((fiat_25519_uint128)(arg1[1]) * (arg2[1]));
x20 = ((fiat_25519_uint128)(arg1[1]) * (arg2[0]));
x21 = ((fiat_25519_uint128)(arg1[0]) * (arg2[4]));
x22 = ((fiat_25519_uint128)(arg1[0]) * (arg2[3]));
x23 = ((fiat_25519_uint128)(arg1[0]) * (arg2[2]));
x24 = ((fiat_25519_uint128)(arg1[0]) * (arg2[1]));
x25 = ((fiat_25519_uint128)(arg1[0]) * (arg2[0]));
x26 = (x25 + (x10 + (x9 + (x7 + x4))));
x27 = (uint64_t)(x26 >> 51);
x28 = (uint64_t)(x26 & UINT64_C(0x7ffffffffffff));
x29 = (x21 + (x17 + (x14 + (x12 + x11))));
x30 = (x22 + (x18 + (x15 + (x13 + x1))));
x31 = (x23 + (x19 + (x16 + (x5 + x2))));
x32 = (x24 + (x20 + (x8 + (x6 + x3))));
x33 = (x27 + x32);
x34 = (uint64_t)(x33 >> 51);
x35 = (uint64_t)(x33 & UINT64_C(0x7ffffffffffff));
x36 = (x34 + x31);
x37 = (uint64_t)(x36 >> 51);
x38 = (uint64_t)(x36 & UINT64_C(0x7ffffffffffff));
x39 = (x37 + x30);
x40 = (uint64_t)(x39 >> 51);
x41 = (uint64_t)(x39 & UINT64_C(0x7ffffffffffff));
x42 = (x40 + x29);
x43 = (uint64_t)(x42 >> 51);
x44 = (uint64_t)(x42 & UINT64_C(0x7ffffffffffff));
x45 = (x43 * UINT8_C(0x13));
x46 = (x28 + x45);
x47 = (x46 >> 51);
x48 = (x46 & UINT64_C(0x7ffffffffffff));
x49 = (x47 + x35);
x50 = (fiat_25519_uint1)(x49 >> 51);
x51 = (x49 & UINT64_C(0x7ffffffffffff));
x52 = (x50 + x38);
out1[0] = x48;
out1[1] = x51;
out1[2] = x52;
out1[3] = x41;
out1[4] = x44;
}
/*
* The function fiat_25519_carry_square squares a field element and reduces the result.
*
* Postconditions:
* eval out1 mod m = (eval arg1 * eval arg1) mod m
*
*/
static void fiat_25519_carry_square(fiat_25519_tight_field_element out1, const fiat_25519_loose_field_element arg1) {
uint64_t x1;
uint64_t x2;
uint64_t x3;
uint64_t x4;
uint64_t x5;
uint64_t x6;
uint64_t x7;
uint64_t x8;
fiat_25519_uint128 x9;
fiat_25519_uint128 x10;
fiat_25519_uint128 x11;
fiat_25519_uint128 x12;
fiat_25519_uint128 x13;
fiat_25519_uint128 x14;
fiat_25519_uint128 x15;
fiat_25519_uint128 x16;
fiat_25519_uint128 x17;
fiat_25519_uint128 x18;
fiat_25519_uint128 x19;
fiat_25519_uint128 x20;
fiat_25519_uint128 x21;
fiat_25519_uint128 x22;
fiat_25519_uint128 x23;
fiat_25519_uint128 x24;
uint64_t x25;
uint64_t x26;
fiat_25519_uint128 x27;
fiat_25519_uint128 x28;
fiat_25519_uint128 x29;
fiat_25519_uint128 x30;
fiat_25519_uint128 x31;
uint64_t x32;
uint64_t x33;
fiat_25519_uint128 x34;
uint64_t x35;
uint64_t x36;
fiat_25519_uint128 x37;
uint64_t x38;
uint64_t x39;
fiat_25519_uint128 x40;
uint64_t x41;
uint64_t x42;
uint64_t x43;
uint64_t x44;
uint64_t x45;
uint64_t x46;
uint64_t x47;
fiat_25519_uint1 x48;
uint64_t x49;
uint64_t x50;
x1 = ((arg1[4]) * UINT8_C(0x13));
x2 = (x1 * 0x2);
x3 = ((arg1[4]) * 0x2);
x4 = ((arg1[3]) * UINT8_C(0x13));
x5 = (x4 * 0x2);
x6 = ((arg1[3]) * 0x2);
x7 = ((arg1[2]) * 0x2);
x8 = ((arg1[1]) * 0x2);
x9 = ((fiat_25519_uint128)(arg1[4]) * x1);
x10 = ((fiat_25519_uint128)(arg1[3]) * x2);
x11 = ((fiat_25519_uint128)(arg1[3]) * x4);
x12 = ((fiat_25519_uint128)(arg1[2]) * x2);
x13 = ((fiat_25519_uint128)(arg1[2]) * x5);
x14 = ((fiat_25519_uint128)(arg1[2]) * (arg1[2]));
x15 = ((fiat_25519_uint128)(arg1[1]) * x2);
x16 = ((fiat_25519_uint128)(arg1[1]) * x6);
x17 = ((fiat_25519_uint128)(arg1[1]) * x7);
x18 = ((fiat_25519_uint128)(arg1[1]) * (arg1[1]));
x19 = ((fiat_25519_uint128)(arg1[0]) * x3);
x20 = ((fiat_25519_uint128)(arg1[0]) * x6);
x21 = ((fiat_25519_uint128)(arg1[0]) * x7);
x22 = ((fiat_25519_uint128)(arg1[0]) * x8);
x23 = ((fiat_25519_uint128)(arg1[0]) * (arg1[0]));
x24 = (x23 + (x15 + x13));
x25 = (uint64_t)(x24 >> 51);
x26 = (uint64_t)(x24 & UINT64_C(0x7ffffffffffff));
x27 = (x19 + (x16 + x14));
x28 = (x20 + (x17 + x9));
x29 = (x21 + (x18 + x10));
x30 = (x22 + (x12 + x11));
x31 = (x25 + x30);
x32 = (uint64_t)(x31 >> 51);
x33 = (uint64_t)(x31 & UINT64_C(0x7ffffffffffff));
x34 = (x32 + x29);
x35 = (uint64_t)(x34 >> 51);
x36 = (uint64_t)(x34 & UINT64_C(0x7ffffffffffff));
x37 = (x35 + x28);
x38 = (uint64_t)(x37 >> 51);
x39 = (uint64_t)(x37 & UINT64_C(0x7ffffffffffff));
x40 = (x38 + x27);
x41 = (uint64_t)(x40 >> 51);
x42 = (uint64_t)(x40 & UINT64_C(0x7ffffffffffff));
x43 = (x41 * UINT8_C(0x13));
x44 = (x26 + x43);
x45 = (x44 >> 51);
x46 = (x44 & UINT64_C(0x7ffffffffffff));
x47 = (x45 + x33);
x48 = (fiat_25519_uint1)(x47 >> 51);
x49 = (x47 & UINT64_C(0x7ffffffffffff));
x50 = (x48 + x36);
out1[0] = x46;
out1[1] = x49;
out1[2] = x50;
out1[3] = x39;
out1[4] = x42;
}
/*
* The function fiat_25519_carry reduces a field element.
*
* Postconditions:
* eval out1 mod m = eval arg1 mod m
*
*/
static void fiat_25519_carry(fiat_25519_tight_field_element out1, const fiat_25519_loose_field_element arg1) {
uint64_t x1;
uint64_t x2;
uint64_t x3;
uint64_t x4;
uint64_t x5;
uint64_t x6;
uint64_t x7;
uint64_t x8;
uint64_t x9;
uint64_t x10;
uint64_t x11;
uint64_t x12;
x1 = (arg1[0]);
x2 = ((x1 >> 51) + (arg1[1]));
x3 = ((x2 >> 51) + (arg1[2]));
x4 = ((x3 >> 51) + (arg1[3]));
x5 = ((x4 >> 51) + (arg1[4]));
x6 = ((x1 & UINT64_C(0x7ffffffffffff)) + ((x5 >> 51) * UINT8_C(0x13)));
x7 = ((fiat_25519_uint1)(x6 >> 51) + (x2 & UINT64_C(0x7ffffffffffff)));
x8 = (x6 & UINT64_C(0x7ffffffffffff));
x9 = (x7 & UINT64_C(0x7ffffffffffff));
x10 = ((fiat_25519_uint1)(x7 >> 51) + (x3 & UINT64_C(0x7ffffffffffff)));
x11 = (x4 & UINT64_C(0x7ffffffffffff));
x12 = (x5 & UINT64_C(0x7ffffffffffff));
out1[0] = x8;
out1[1] = x9;
out1[2] = x10;
out1[3] = x11;
out1[4] = x12;
}
/*
* The function fiat_25519_add adds two field elements.
*
* Postconditions:
* eval out1 mod m = (eval arg1 + eval arg2) mod m
*
*/
static void fiat_25519_add(fiat_25519_loose_field_element out1, const fiat_25519_tight_field_element arg1, const fiat_25519_tight_field_element arg2) {
uint64_t x1;
uint64_t x2;
uint64_t x3;
uint64_t x4;
uint64_t x5;
x1 = ((arg1[0]) + (arg2[0]));
x2 = ((arg1[1]) + (arg2[1]));
x3 = ((arg1[2]) + (arg2[2]));
x4 = ((arg1[3]) + (arg2[3]));
x5 = ((arg1[4]) + (arg2[4]));
out1[0] = x1;
out1[1] = x2;
out1[2] = x3;
out1[3] = x4;
out1[4] = x5;
}
/*
* The function fiat_25519_sub subtracts two field elements.
*
* Postconditions:
* eval out1 mod m = (eval arg1 - eval arg2) mod m
*
*/
static void fiat_25519_sub(fiat_25519_loose_field_element out1, const fiat_25519_tight_field_element arg1, const fiat_25519_tight_field_element arg2) {
uint64_t x1;
uint64_t x2;
uint64_t x3;
uint64_t x4;
uint64_t x5;
x1 = ((UINT64_C(0xfffffffffffda) + (arg1[0])) - (arg2[0]));
x2 = ((UINT64_C(0xffffffffffffe) + (arg1[1])) - (arg2[1]));
x3 = ((UINT64_C(0xffffffffffffe) + (arg1[2])) - (arg2[2]));
x4 = ((UINT64_C(0xffffffffffffe) + (arg1[3])) - (arg2[3]));
x5 = ((UINT64_C(0xffffffffffffe) + (arg1[4])) - (arg2[4]));
out1[0] = x1;
out1[1] = x2;
out1[2] = x3;
out1[3] = x4;
out1[4] = x5;
}
/*
* The function fiat_25519_opp negates a field element.
*
* Postconditions:
* eval out1 mod m = -eval arg1 mod m
*
*/
static void fiat_25519_opp(fiat_25519_loose_field_element out1, const fiat_25519_tight_field_element arg1) {
uint64_t x1;
uint64_t x2;
uint64_t x3;
uint64_t x4;
uint64_t x5;
x1 = (UINT64_C(0xfffffffffffda) - (arg1[0]));
x2 = (UINT64_C(0xffffffffffffe) - (arg1[1]));
x3 = (UINT64_C(0xffffffffffffe) - (arg1[2]));
x4 = (UINT64_C(0xffffffffffffe) - (arg1[3]));
x5 = (UINT64_C(0xffffffffffffe) - (arg1[4]));
out1[0] = x1;
out1[1] = x2;
out1[2] = x3;
out1[3] = x4;
out1[4] = x5;
}
/*
* The function fiat_25519_selectznz is a multi-limb conditional select.
*
* Postconditions:
* out1 = (if arg1 = 0 then arg2 else arg3)
*
* Input Bounds:
* arg1: [0x0 ~> 0x1]
* arg2: [[0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff]]
* arg3: [[0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff]]
* Output Bounds:
* out1: [[0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff], [0x0 ~> 0xffffffffffffffff]]
*/
static void fiat_25519_selectznz(uint64_t out1[5], fiat_25519_uint1 arg1, const uint64_t arg2[5], const uint64_t arg3[5]) {
uint64_t x1;
uint64_t x2;
uint64_t x3;
uint64_t x4;
uint64_t x5;
fiat_25519_cmovznz_u64(&x1, arg1, (arg2[0]), (arg3[0]));
fiat_25519_cmovznz_u64(&x2, arg1, (arg2[1]), (arg3[1]));
fiat_25519_cmovznz_u64(&x3, arg1, (arg2[2]), (arg3[2]));
fiat_25519_cmovznz_u64(&x4, arg1, (arg2[3]), (arg3[3]));
fiat_25519_cmovznz_u64(&x5, arg1, (arg2[4]), (arg3[4]));
out1[0] = x1;
out1[1] = x2;
out1[2] = x3;
out1[3] = x4;
out1[4] = x5;
}
/*
* The function fiat_25519_to_bytes serializes a field element to bytes in little-endian order.
*
* Postconditions:
* out1 = map (λ x, ⌊((eval arg1 mod m) mod 2^(8 * (x + 1))) / 2^(8 * x)⌋) [0..31]
*
* Output Bounds:
* out1: [[0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0x7f]]
*/
static void fiat_25519_to_bytes(uint8_t out1[32], const fiat_25519_tight_field_element arg1) {
uint64_t x1;
fiat_25519_uint1 x2;
uint64_t x3;
fiat_25519_uint1 x4;
uint64_t x5;
fiat_25519_uint1 x6;
uint64_t x7;
fiat_25519_uint1 x8;
uint64_t x9;
fiat_25519_uint1 x10;
uint64_t x11;
uint64_t x12;
fiat_25519_uint1 x13;
uint64_t x14;
fiat_25519_uint1 x15;
uint64_t x16;
fiat_25519_uint1 x17;
uint64_t x18;
fiat_25519_uint1 x19;
uint64_t x20;
fiat_25519_uint1 x21;
uint64_t x22;
uint64_t x23;
uint64_t x24;
uint64_t x25;
uint8_t x26;
uint64_t x27;
uint8_t x28;
uint64_t x29;
uint8_t x30;
uint64_t x31;
uint8_t x32;
uint64_t x33;
uint8_t x34;
uint64_t x35;
uint8_t x36;
uint8_t x37;
uint64_t x38;
uint8_t x39;
uint64_t x40;
uint8_t x41;
uint64_t x42;
uint8_t x43;
uint64_t x44;
uint8_t x45;
uint64_t x46;
uint8_t x47;
uint64_t x48;
uint8_t x49;
uint8_t x50;
uint64_t x51;
uint8_t x52;
uint64_t x53;
uint8_t x54;
uint64_t x55;
uint8_t x56;
uint64_t x57;
uint8_t x58;
uint64_t x59;
uint8_t x60;
uint64_t x61;
uint8_t x62;
uint64_t x63;
uint8_t x64;
fiat_25519_uint1 x65;
uint64_t x66;
uint8_t x67;
uint64_t x68;
uint8_t x69;
uint64_t x70;
uint8_t x71;
uint64_t x72;
uint8_t x73;
uint64_t x74;
uint8_t x75;
uint64_t x76;
uint8_t x77;
uint8_t x78;
uint64_t x79;
uint8_t x80;
uint64_t x81;
uint8_t x82;
uint64_t x83;
uint8_t x84;
uint64_t x85;
uint8_t x86;
uint64_t x87;
uint8_t x88;
uint64_t x89;
uint8_t x90;
uint8_t x91;
fiat_25519_subborrowx_u51(&x1, &x2, 0x0, (arg1[0]), UINT64_C(0x7ffffffffffed));
fiat_25519_subborrowx_u51(&x3, &x4, x2, (arg1[1]), UINT64_C(0x7ffffffffffff));
fiat_25519_subborrowx_u51(&x5, &x6, x4, (arg1[2]), UINT64_C(0x7ffffffffffff));
fiat_25519_subborrowx_u51(&x7, &x8, x6, (arg1[3]), UINT64_C(0x7ffffffffffff));
fiat_25519_subborrowx_u51(&x9, &x10, x8, (arg1[4]), UINT64_C(0x7ffffffffffff));
fiat_25519_cmovznz_u64(&x11, x10, 0x0, UINT64_C(0xffffffffffffffff));
fiat_25519_addcarryx_u51(&x12, &x13, 0x0, x1, (x11 & UINT64_C(0x7ffffffffffed)));
fiat_25519_addcarryx_u51(&x14, &x15, x13, x3, (x11 & UINT64_C(0x7ffffffffffff)));
fiat_25519_addcarryx_u51(&x16, &x17, x15, x5, (x11 & UINT64_C(0x7ffffffffffff)));
fiat_25519_addcarryx_u51(&x18, &x19, x17, x7, (x11 & UINT64_C(0x7ffffffffffff)));
fiat_25519_addcarryx_u51(&x20, &x21, x19, x9, (x11 & UINT64_C(0x7ffffffffffff)));
x22 = (x20 << 4);
x23 = (x18 * (uint64_t)0x2);
x24 = (x16 << 6);
x25 = (x14 << 3);
x26 = (uint8_t)(x12 & UINT8_C(0xff));
x27 = (x12 >> 8);
x28 = (uint8_t)(x27 & UINT8_C(0xff));
x29 = (x27 >> 8);
x30 = (uint8_t)(x29 & UINT8_C(0xff));
x31 = (x29 >> 8);
x32 = (uint8_t)(x31 & UINT8_C(0xff));
x33 = (x31 >> 8);
x34 = (uint8_t)(x33 & UINT8_C(0xff));
x35 = (x33 >> 8);
x36 = (uint8_t)(x35 & UINT8_C(0xff));
x37 = (uint8_t)(x35 >> 8);
x38 = (x25 + (uint64_t)x37);
x39 = (uint8_t)(x38 & UINT8_C(0xff));
x40 = (x38 >> 8);
x41 = (uint8_t)(x40 & UINT8_C(0xff));
x42 = (x40 >> 8);
x43 = (uint8_t)(x42 & UINT8_C(0xff));
x44 = (x42 >> 8);
x45 = (uint8_t)(x44 & UINT8_C(0xff));
x46 = (x44 >> 8);
x47 = (uint8_t)(x46 & UINT8_C(0xff));
x48 = (x46 >> 8);
x49 = (uint8_t)(x48 & UINT8_C(0xff));
x50 = (uint8_t)(x48 >> 8);
x51 = (x24 + (uint64_t)x50);
x52 = (uint8_t)(x51 & UINT8_C(0xff));
x53 = (x51 >> 8);
x54 = (uint8_t)(x53 & UINT8_C(0xff));
x55 = (x53 >> 8);
x56 = (uint8_t)(x55 & UINT8_C(0xff));
x57 = (x55 >> 8);
x58 = (uint8_t)(x57 & UINT8_C(0xff));
x59 = (x57 >> 8);
x60 = (uint8_t)(x59 & UINT8_C(0xff));
x61 = (x59 >> 8);
x62 = (uint8_t)(x61 & UINT8_C(0xff));
x63 = (x61 >> 8);
x64 = (uint8_t)(x63 & UINT8_C(0xff));
x65 = (fiat_25519_uint1)(x63 >> 8);
x66 = (x23 + (uint64_t)x65);
x67 = (uint8_t)(x66 & UINT8_C(0xff));
x68 = (x66 >> 8);
x69 = (uint8_t)(x68 & UINT8_C(0xff));
x70 = (x68 >> 8);
x71 = (uint8_t)(x70 & UINT8_C(0xff));
x72 = (x70 >> 8);
x73 = (uint8_t)(x72 & UINT8_C(0xff));
x74 = (x72 >> 8);
x75 = (uint8_t)(x74 & UINT8_C(0xff));
x76 = (x74 >> 8);
x77 = (uint8_t)(x76 & UINT8_C(0xff));
x78 = (uint8_t)(x76 >> 8);
x79 = (x22 + (uint64_t)x78);
x80 = (uint8_t)(x79 & UINT8_C(0xff));
x81 = (x79 >> 8);
x82 = (uint8_t)(x81 & UINT8_C(0xff));
x83 = (x81 >> 8);
x84 = (uint8_t)(x83 & UINT8_C(0xff));
x85 = (x83 >> 8);
x86 = (uint8_t)(x85 & UINT8_C(0xff));
x87 = (x85 >> 8);
x88 = (uint8_t)(x87 & UINT8_C(0xff));
x89 = (x87 >> 8);
x90 = (uint8_t)(x89 & UINT8_C(0xff));
x91 = (uint8_t)(x89 >> 8);
out1[0] = x26;
out1[1] = x28;
out1[2] = x30;
out1[3] = x32;
out1[4] = x34;
out1[5] = x36;
out1[6] = x39;
out1[7] = x41;
out1[8] = x43;
out1[9] = x45;
out1[10] = x47;
out1[11] = x49;
out1[12] = x52;
out1[13] = x54;
out1[14] = x56;
out1[15] = x58;
out1[16] = x60;
out1[17] = x62;
out1[18] = x64;
out1[19] = x67;
out1[20] = x69;
out1[21] = x71;
out1[22] = x73;
out1[23] = x75;
out1[24] = x77;
out1[25] = x80;
out1[26] = x82;
out1[27] = x84;
out1[28] = x86;
out1[29] = x88;
out1[30] = x90;
out1[31] = x91;
}
/*
* The function fiat_25519_from_bytes deserializes a field element from bytes in little-endian order.
*
* Postconditions:
* eval out1 mod m = bytes_eval arg1 mod m
*
* Input Bounds:
* arg1: [[0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0xff], [0x0 ~> 0x7f]]
*/
static void fiat_25519_from_bytes(fiat_25519_tight_field_element out1, const uint8_t arg1[32]) {
uint64_t x1;
uint64_t x2;
uint64_t x3;
uint64_t x4;
uint64_t x5;
uint64_t x6;
uint64_t x7;
uint64_t x8;
uint64_t x9;
uint64_t x10;
uint64_t x11;
uint64_t x12;
uint64_t x13;
uint64_t x14;
uint64_t x15;
uint64_t x16;
uint64_t x17;
uint64_t x18;
uint64_t x19;
uint64_t x20;
uint64_t x21;
uint64_t x22;
uint64_t x23;
uint64_t x24;
uint64_t x25;
uint64_t x26;
uint64_t x27;
uint64_t x28;
uint64_t x29;
uint64_t x30;
uint64_t x31;
uint8_t x32;
uint64_t x33;
uint64_t x34;
uint64_t x35;
uint64_t x36;
uint64_t x37;
uint64_t x38;
uint64_t x39;
uint8_t x40;
uint64_t x41;
uint64_t x42;
uint64_t x43;
uint64_t x44;
uint64_t x45;
uint64_t x46;
uint64_t x47;
uint8_t x48;
uint64_t x49;
uint64_t x50;
uint64_t x51;
uint64_t x52;
uint64_t x53;
uint64_t x54;
uint64_t x55;
uint64_t x56;
uint8_t x57;
uint64_t x58;
uint64_t x59;
uint64_t x60;
uint64_t x61;
uint64_t x62;
uint64_t x63;
uint64_t x64;
uint8_t x65;
uint64_t x66;
uint64_t x67;
uint64_t x68;
uint64_t x69;
uint64_t x70;
uint64_t x71;
x1 = ((uint64_t)(arg1[31]) << 44);
x2 = ((uint64_t)(arg1[30]) << 36);
x3 = ((uint64_t)(arg1[29]) << 28);
x4 = ((uint64_t)(arg1[28]) << 20);
x5 = ((uint64_t)(arg1[27]) << 12);
x6 = ((uint64_t)(arg1[26]) << 4);
x7 = ((uint64_t)(arg1[25]) << 47);
x8 = ((uint64_t)(arg1[24]) << 39);
x9 = ((uint64_t)(arg1[23]) << 31);
x10 = ((uint64_t)(arg1[22]) << 23);
x11 = ((uint64_t)(arg1[21]) << 15);
x12 = ((uint64_t)(arg1[20]) << 7);
x13 = ((uint64_t)(arg1[19]) << 50);
x14 = ((uint64_t)(arg1[18]) << 42);
x15 = ((uint64_t)(arg1[17]) << 34);
x16 = ((uint64_t)(arg1[16]) << 26);
x17 = ((uint64_t)(arg1[15]) << 18);
x18 = ((uint64_t)(arg1[14]) << 10);
x19 = ((uint64_t)(arg1[13]) << 2);
x20 = ((uint64_t)(arg1[12]) << 45);
x21 = ((uint64_t)(arg1[11]) << 37);
x22 = ((uint64_t)(arg1[10]) << 29);
x23 = ((uint64_t)(arg1[9]) << 21);
x24 = ((uint64_t)(arg1[8]) << 13);
x25 = ((uint64_t)(arg1[7]) << 5);
x26 = ((uint64_t)(arg1[6]) << 48);
x27 = ((uint64_t)(arg1[5]) << 40);
x28 = ((uint64_t)(arg1[4]) << 32);
x29 = ((uint64_t)(arg1[3]) << 24);
x30 = ((uint64_t)(arg1[2]) << 16);
x31 = ((uint64_t)(arg1[1]) << 8);
x32 = (arg1[0]);
x33 = (x31 + (uint64_t)x32);
x34 = (x30 + x33);
x35 = (x29 + x34);
x36 = (x28 + x35);
x37 = (x27 + x36);
x38 = (x26 + x37);
x39 = (x38 & UINT64_C(0x7ffffffffffff));
x40 = (uint8_t)(x38 >> 51);
x41 = (x25 + (uint64_t)x40);
x42 = (x24 + x41);
x43 = (x23 + x42);
x44 = (x22 + x43);
x45 = (x21 + x44);
x46 = (x20 + x45);
x47 = (x46 & UINT64_C(0x7ffffffffffff));
x48 = (uint8_t)(x46 >> 51);
x49 = (x19 + (uint64_t)x48);
x50 = (x18 + x49);
x51 = (x17 + x50);
x52 = (x16 + x51);
x53 = (x15 + x52);
x54 = (x14 + x53);
x55 = (x13 + x54);
x56 = (x55 & UINT64_C(0x7ffffffffffff));
x57 = (uint8_t)(x55 >> 51);
x58 = (x12 + (uint64_t)x57);
x59 = (x11 + x58);
x60 = (x10 + x59);
x61 = (x9 + x60);
x62 = (x8 + x61);
x63 = (x7 + x62);
x64 = (x63 & UINT64_C(0x7ffffffffffff));
x65 = (uint8_t)(x63 >> 51);
x66 = (x6 + (uint64_t)x65);
x67 = (x5 + x66);
x68 = (x4 + x67);
x69 = (x3 + x68);
x70 = (x2 + x69);
x71 = (x1 + x70);
out1[0] = x39;
out1[1] = x47;
out1[2] = x56;
out1[3] = x64;
out1[4] = x71;
}
/*
* The function fiat_25519_carry_scmul_121666 multiplies a field element by 121666 and reduces the result.
*
* Postconditions:
* eval out1 mod m = (121666 * eval arg1) mod m
*
*/
static void fiat_25519_carry_scmul_121666(fiat_25519_tight_field_element out1, const fiat_25519_loose_field_element arg1) {
fiat_25519_uint128 x1;
fiat_25519_uint128 x2;
fiat_25519_uint128 x3;
fiat_25519_uint128 x4;
fiat_25519_uint128 x5;
uint64_t x6;
uint64_t x7;
fiat_25519_uint128 x8;
uint64_t x9;
uint64_t x10;
fiat_25519_uint128 x11;
uint64_t x12;
uint64_t x13;
fiat_25519_uint128 x14;
uint64_t x15;
uint64_t x16;
fiat_25519_uint128 x17;
uint64_t x18;
uint64_t x19;
uint64_t x20;
uint64_t x21;
fiat_25519_uint1 x22;
uint64_t x23;
uint64_t x24;
fiat_25519_uint1 x25;
uint64_t x26;
uint64_t x27;
x1 = ((fiat_25519_uint128)UINT32_C(0x1db42) * (arg1[4]));
x2 = ((fiat_25519_uint128)UINT32_C(0x1db42) * (arg1[3]));
x3 = ((fiat_25519_uint128)UINT32_C(0x1db42) * (arg1[2]));
x4 = ((fiat_25519_uint128)UINT32_C(0x1db42) * (arg1[1]));
x5 = ((fiat_25519_uint128)UINT32_C(0x1db42) * (arg1[0]));
x6 = (uint64_t)(x5 >> 51);
x7 = (uint64_t)(x5 & UINT64_C(0x7ffffffffffff));
x8 = (x6 + x4);
x9 = (uint64_t)(x8 >> 51);
x10 = (uint64_t)(x8 & UINT64_C(0x7ffffffffffff));
x11 = (x9 + x3);
x12 = (uint64_t)(x11 >> 51);
x13 = (uint64_t)(x11 & UINT64_C(0x7ffffffffffff));
x14 = (x12 + x2);
x15 = (uint64_t)(x14 >> 51);
x16 = (uint64_t)(x14 & UINT64_C(0x7ffffffffffff));
x17 = (x15 + x1);
x18 = (uint64_t)(x17 >> 51);
x19 = (uint64_t)(x17 & UINT64_C(0x7ffffffffffff));
x20 = (x18 * UINT8_C(0x13));
x21 = (x7 + x20);
x22 = (fiat_25519_uint1)(x21 >> 51);
x23 = (x21 & UINT64_C(0x7ffffffffffff));
x24 = (x22 + x10);
x25 = (fiat_25519_uint1)(x24 >> 51);
x26 = (x24 & UINT64_C(0x7ffffffffffff));
x27 = (x25 + x13);
out1[0] = x23;
out1[1] = x26;
out1[2] = x27;
out1[3] = x16;
out1[4] = x19;
}

1859
unikernel/duniverse/mirage-crypto/ec/native/curve25519_stubs.c Normal file
View file

File diff suppressed because it is too large Load diff

375
unikernel/duniverse/mirage-crypto/ec/native/curve25519_tables.h Normal file
View file

@ -0,0 +1,375 @@
/* following code is from c47bfce06 of boringssl: crypto/curve25519 */
/* Copyright (c) 2020, Google Inc.
*
* Permission to use, copy, modify, and/or distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
* SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
* OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
* CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */
// This file is generated from
// ./make_curve25519_tables.py > curve25519_tables.h
static const fe d = {{
#if defined(ARCH_64BIT)
929955233495203, 466365720129213, 1662059464998953, 2033849074728123,
1442794654840575
#else
56195235, 13857412, 51736253, 6949390, 114729, 24766616, 60832955, 30306712,
48412415, 21499315
#endif
}};
static const fe sqrtm1 = {{
#if defined(ARCH_64BIT)
1718705420411056, 234908883556509, 2233514472574048, 2117202627021982,
765476049583133
#else
34513072, 25610706, 9377949, 3500415, 12389472, 33281959, 41962654,
31548777, 326685, 11406482
#endif
}};
static const fe d2 = {{
#if defined(ARCH_64BIT)
1859910466990425, 932731440258426, 1072319116312658, 1815898335770999,
633789495995903
#else
45281625, 27714825, 36363642, 13898781, 229458, 15978800, 54557047,
27058993, 29715967, 9444199
#endif
}};
// This block of code replaces the standard base-point table with a much smaller
// one. The standard table is 30,720 bytes while this one is just 960.
//
// This table contains 15 pairs of group elements, (x, y), where each field
// element is serialised with |fe_tobytes|. If |i| is the index of the group
// element then consider i+1 as a four-bit number: (i₀, i₁, i₂, i₃) (where i₀
// is the most significant bit). The value of the group element is then:
// (i₀×2^192 + i₁×2^128 + i₂×2^64 + i₃)G, where G is the generator.
static const uint8_t k25519SmallPrecomp[15 * 2 * 32] = {
0x1a, 0xd5, 0x25, 0x8f, 0x60, 0x2d, 0x56, 0xc9, 0xb2, 0xa7, 0x25, 0x95,
0x60, 0xc7, 0x2c, 0x69, 0x5c, 0xdc, 0xd6, 0xfd, 0x31, 0xe2, 0xa4, 0xc0,
0xfe, 0x53, 0x6e, 0xcd, 0xd3, 0x36, 0x69, 0x21, 0x58, 0x66, 0x66, 0x66,
0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66,
0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66,
0x66, 0x66, 0x66, 0x66, 0x02, 0xa2, 0xed, 0xf4, 0x8f, 0x6b, 0x0b, 0x3e,
0xeb, 0x35, 0x1a, 0xd5, 0x7e, 0xdb, 0x78, 0x00, 0x96, 0x8a, 0xa0, 0xb4,
0xcf, 0x60, 0x4b, 0xd4, 0xd5, 0xf9, 0x2d, 0xbf, 0x88, 0xbd, 0x22, 0x62,
0x13, 0x53, 0xe4, 0x82, 0x57, 0xfa, 0x1e, 0x8f, 0x06, 0x2b, 0x90, 0xba,
0x08, 0xb6, 0x10, 0x54, 0x4f, 0x7c, 0x1b, 0x26, 0xed, 0xda, 0x6b, 0xdd,
0x25, 0xd0, 0x4e, 0xea, 0x42, 0xbb, 0x25, 0x03, 0xa2, 0xfb, 0xcc, 0x61,
0x67, 0x06, 0x70, 0x1a, 0xc4, 0x78, 0x3a, 0xff, 0x32, 0x62, 0xdd, 0x2c,
0xab, 0x50, 0x19, 0x3b, 0xf2, 0x9b, 0x7d, 0xb8, 0xfd, 0x4f, 0x29, 0x9c,
0xa7, 0x91, 0xba, 0x0e, 0x46, 0x5e, 0x51, 0xfe, 0x1d, 0xbf, 0xe5, 0xe5,
0x9b, 0x95, 0x0d, 0x67, 0xf8, 0xd1, 0xb5, 0x5a, 0xa1, 0x93, 0x2c, 0xc3,
0xde, 0x0e, 0x97, 0x85, 0x2d, 0x7f, 0xea, 0xab, 0x3e, 0x47, 0x30, 0x18,
0x24, 0xe8, 0xb7, 0x60, 0xae, 0x47, 0x80, 0xfc, 0xe5, 0x23, 0xe7, 0xc2,
0xc9, 0x85, 0xe6, 0x98, 0xa0, 0x29, 0x4e, 0xe1, 0x84, 0x39, 0x2d, 0x95,
0x2c, 0xf3, 0x45, 0x3c, 0xff, 0xaf, 0x27, 0x4c, 0x6b, 0xa6, 0xf5, 0x4b,
0x11, 0xbd, 0xba, 0x5b, 0x9e, 0xc4, 0xa4, 0x51, 0x1e, 0xbe, 0xd0, 0x90,
0x3a, 0x9c, 0xc2, 0x26, 0xb6, 0x1e, 0xf1, 0x95, 0x7d, 0xc8, 0x6d, 0x52,
0xe6, 0x99, 0x2c, 0x5f, 0x9a, 0x96, 0x0c, 0x68, 0x29, 0xfd, 0xe2, 0xfb,
0xe6, 0xbc, 0xec, 0x31, 0x08, 0xec, 0xe6, 0xb0, 0x53, 0x60, 0xc3, 0x8c,
0xbe, 0xc1, 0xb3, 0x8a, 0x8f, 0xe4, 0x88, 0x2b, 0x55, 0xe5, 0x64, 0x6e,
0x9b, 0xd0, 0xaf, 0x7b, 0x64, 0x2a, 0x35, 0x25, 0x10, 0x52, 0xc5, 0x9e,
0x58, 0x11, 0x39, 0x36, 0x45, 0x51, 0xb8, 0x39, 0x93, 0xfc, 0x9d, 0x6a,
0xbe, 0x58, 0xcb, 0xa4, 0x0f, 0x51, 0x3c, 0x38, 0x05, 0xca, 0xab, 0x43,
0x63, 0x0e, 0xf3, 0x8b, 0x41, 0xa6, 0xf8, 0x9b, 0x53, 0x70, 0x80, 0x53,
0x86, 0x5e, 0x8f, 0xe3, 0xc3, 0x0d, 0x18, 0xc8, 0x4b, 0x34, 0x1f, 0xd8,
0x1d, 0xbc, 0xf2, 0x6d, 0x34, 0x3a, 0xbe, 0xdf, 0xd9, 0xf6, 0xf3, 0x89,
0xa1, 0xe1, 0x94, 0x9f, 0x5d, 0x4c, 0x5d, 0xe9, 0xa1, 0x49, 0x92, 0xef,
0x0e, 0x53, 0x81, 0x89, 0x58, 0x87, 0xa6, 0x37, 0xf1, 0xdd, 0x62, 0x60,
0x63, 0x5a, 0x9d, 0x1b, 0x8c, 0xc6, 0x7d, 0x52, 0xea, 0x70, 0x09, 0x6a,
0xe1, 0x32, 0xf3, 0x73, 0x21, 0x1f, 0x07, 0x7b, 0x7c, 0x9b, 0x49, 0xd8,
0xc0, 0xf3, 0x25, 0x72, 0x6f, 0x9d, 0xed, 0x31, 0x67, 0x36, 0x36, 0x54,
0x40, 0x92, 0x71, 0xe6, 0x11, 0x28, 0x11, 0xad, 0x93, 0x32, 0x85, 0x7b,
0x3e, 0xb7, 0x3b, 0x49, 0x13, 0x1c, 0x07, 0xb0, 0x2e, 0x93, 0xaa, 0xfd,
0xfd, 0x28, 0x47, 0x3d, 0x8d, 0xd2, 0xda, 0xc7, 0x44, 0xd6, 0x7a, 0xdb,
0x26, 0x7d, 0x1d, 0xb8, 0xe1, 0xde, 0x9d, 0x7a, 0x7d, 0x17, 0x7e, 0x1c,
0x37, 0x04, 0x8d, 0x2d, 0x7c, 0x5e, 0x18, 0x38, 0x1e, 0xaf, 0xc7, 0x1b,
0x33, 0x48, 0x31, 0x00, 0x59, 0xf6, 0xf2, 0xca, 0x0f, 0x27, 0x1b, 0x63,
0x12, 0x7e, 0x02, 0x1d, 0x49, 0xc0, 0x5d, 0x79, 0x87, 0xef, 0x5e, 0x7a,
0x2f, 0x1f, 0x66, 0x55, 0xd8, 0x09, 0xd9, 0x61, 0x38, 0x68, 0xb0, 0x07,
0xa3, 0xfc, 0xcc, 0x85, 0x10, 0x7f, 0x4c, 0x65, 0x65, 0xb3, 0xfa, 0xfa,
0xa5, 0x53, 0x6f, 0xdb, 0x74, 0x4c, 0x56, 0x46, 0x03, 0xe2, 0xd5, 0x7a,
0x29, 0x1c, 0xc6, 0x02, 0xbc, 0x59, 0xf2, 0x04, 0x75, 0x63, 0xc0, 0x84,
0x2f, 0x60, 0x1c, 0x67, 0x76, 0xfd, 0x63, 0x86, 0xf3, 0xfa, 0xbf, 0xdc,
0xd2, 0x2d, 0x90, 0x91, 0xbd, 0x33, 0xa9, 0xe5, 0x66, 0x0c, 0xda, 0x42,
0x27, 0xca, 0xf4, 0x66, 0xc2, 0xec, 0x92, 0x14, 0x57, 0x06, 0x63, 0xd0,
0x4d, 0x15, 0x06, 0xeb, 0x69, 0x58, 0x4f, 0x77, 0xc5, 0x8b, 0xc7, 0xf0,
0x8e, 0xed, 0x64, 0xa0, 0xb3, 0x3c, 0x66, 0x71, 0xc6, 0x2d, 0xda, 0x0a,
0x0d, 0xfe, 0x70, 0x27, 0x64, 0xf8, 0x27, 0xfa, 0xf6, 0x5f, 0x30, 0xa5,
0x0d, 0x6c, 0xda, 0xf2, 0x62, 0x5e, 0x78, 0x47, 0xd3, 0x66, 0x00, 0x1c,
0xfd, 0x56, 0x1f, 0x5d, 0x3f, 0x6f, 0xf4, 0x4c, 0xd8, 0xfd, 0x0e, 0x27,
0xc9, 0x5c, 0x2b, 0xbc, 0xc0, 0xa4, 0xe7, 0x23, 0x29, 0x02, 0x9f, 0x31,
0xd6, 0xe9, 0xd7, 0x96, 0xf4, 0xe0, 0x5e, 0x0b, 0x0e, 0x13, 0xee, 0x3c,
0x09, 0xed, 0xf2, 0x3d, 0x76, 0x91, 0xc3, 0xa4, 0x97, 0xae, 0xd4, 0x87,
0xd0, 0x5d, 0xf6, 0x18, 0x47, 0x1f, 0x1d, 0x67, 0xf2, 0xcf, 0x63, 0xa0,
0x91, 0x27, 0xf8, 0x93, 0x45, 0x75, 0x23, 0x3f, 0xd1, 0xf1, 0xad, 0x23,
0xdd, 0x64, 0x93, 0x96, 0x41, 0x70, 0x7f, 0xf7, 0xf5, 0xa9, 0x89, 0xa2,
0x34, 0xb0, 0x8d, 0x1b, 0xae, 0x19, 0x15, 0x49, 0x58, 0x23, 0x6d, 0x87,
0x15, 0x4f, 0x81, 0x76, 0xfb, 0x23, 0xb5, 0xea, 0xcf, 0xac, 0x54, 0x8d,
0x4e, 0x42, 0x2f, 0xeb, 0x0f, 0x63, 0xdb, 0x68, 0x37, 0xa8, 0xcf, 0x8b,
0xab, 0xf5, 0xa4, 0x6e, 0x96, 0x2a, 0xb2, 0xd6, 0xbe, 0x9e, 0xbd, 0x0d,
0xb4, 0x42, 0xa9, 0xcf, 0x01, 0x83, 0x8a, 0x17, 0x47, 0x76, 0xc4, 0xc6,
0x83, 0x04, 0x95, 0x0b, 0xfc, 0x11, 0xc9, 0x62, 0xb8, 0x0c, 0x76, 0x84,
0xd9, 0xb9, 0x37, 0xfa, 0xfc, 0x7c, 0xc2, 0x6d, 0x58, 0x3e, 0xb3, 0x04,
0xbb, 0x8c, 0x8f, 0x48, 0xbc, 0x91, 0x27, 0xcc, 0xf9, 0xb7, 0x22, 0x19,
0x83, 0x2e, 0x09, 0xb5, 0x72, 0xd9, 0x54, 0x1c, 0x4d, 0xa1, 0xea, 0x0b,
0xf1, 0xc6, 0x08, 0x72, 0x46, 0x87, 0x7a, 0x6e, 0x80, 0x56, 0x0a, 0x8a,
0xc0, 0xdd, 0x11, 0x6b, 0xd6, 0xdd, 0x47, 0xdf, 0x10, 0xd9, 0xd8, 0xea,
0x7c, 0xb0, 0x8f, 0x03, 0x00, 0x2e, 0xc1, 0x8f, 0x44, 0xa8, 0xd3, 0x30,
0x06, 0x89, 0xa2, 0xf9, 0x34, 0xad, 0xdc, 0x03, 0x85, 0xed, 0x51, 0xa7,
0x82, 0x9c, 0xe7, 0x5d, 0x52, 0x93, 0x0c, 0x32, 0x9a, 0x5b, 0xe1, 0xaa,
0xca, 0xb8, 0x02, 0x6d, 0x3a, 0xd4, 0xb1, 0x3a, 0xf0, 0x5f, 0xbe, 0xb5,
0x0d, 0x10, 0x6b, 0x38, 0x32, 0xac, 0x76, 0x80, 0xbd, 0xca, 0x94, 0x71,
0x7a, 0xf2, 0xc9, 0x35, 0x2a, 0xde, 0x9f, 0x42, 0x49, 0x18, 0x01, 0xab,
0xbc, 0xef, 0x7c, 0x64, 0x3f, 0x58, 0x3d, 0x92, 0x59, 0xdb, 0x13, 0xdb,
0x58, 0x6e, 0x0a, 0xe0, 0xb7, 0x91, 0x4a, 0x08, 0x20, 0xd6, 0x2e, 0x3c,
0x45, 0xc9, 0x8b, 0x17, 0x79, 0xe7, 0xc7, 0x90, 0x99, 0x3a, 0x18, 0x25,
};
// Bi[i] = (2*i+1)*B
static const ge_precomp Bi[8] = {
{
{{
#if defined(ARCH_64BIT)
1288382639258501, 245678601348599, 269427782077623,
1462984067271730, 137412439391563
#else
25967493, 19198397, 29566455, 3660896, 54414519, 4014786, 27544626,
21800161, 61029707, 2047604
#endif
}},
{{
#if defined(ARCH_64BIT)
62697248952638, 204681361388450, 631292143396476, 338455783676468,
1213667448819585
#else
54563134, 934261, 64385954, 3049989, 66381436, 9406985, 12720692,
5043384, 19500929, 18085054
#endif
}},
{{
#if defined(ARCH_64BIT)
301289933810280, 1259582250014073, 1422107436869536,
796239922652654, 1953934009299142
#else
58370664, 4489569, 9688441, 18769238, 10184608, 21191052, 29287918,
11864899, 42594502, 29115885
#endif
}},
},
{
{{
#if defined(ARCH_64BIT)
1601611775252272, 1720807796594148, 1132070835939856,
1260455018889551, 2147779492816911
#else
15636272, 23865875, 24204772, 25642034, 616976, 16869170, 27787599,
18782243, 28944399, 32004408
#endif
}},
{{
#if defined(ARCH_64BIT)
316559037616741, 2177824224946892, 1459442586438991,
1461528397712656, 751590696113597
#else
16568933, 4717097, 55552716, 32452109, 15682895, 21747389, 16354576,
21778470, 7689661, 11199574
#endif
}},
{{
#if defined(ARCH_64BIT)
1850748884277385, 1200145853858453, 1068094770532492,
672251375690438, 1586055907191707
#else
30464137, 27578307, 55329429, 17883566, 23220364, 15915852, 7512774,
10017326, 49359771, 23634074
#endif
}},
},
{
{{
#if defined(ARCH_64BIT)
769950342298419, 132954430919746, 844085933195555, 974092374476333,
726076285546016
#else
10861363, 11473154, 27284546, 1981175, 37044515, 12577860, 32867885,
14515107, 51670560, 10819379
#endif
}},
{{
#if defined(ARCH_64BIT)
425251763115706, 608463272472562, 442562545713235, 837766094556764,
374555092627893
#else
4708026, 6336745, 20377586, 9066809, 55836755, 6594695, 41455196,
12483687, 54440373, 5581305
#endif
}},
{{
#if defined(ARCH_64BIT)
1086255230780037, 274979815921559, 1960002765731872,
929474102396301, 1190409889297339
#else
19563141, 16186464, 37722007, 4097518, 10237984, 29206317, 28542349,
13850243, 43430843, 17738489
#endif
}},
},
{
{{
#if defined(ARCH_64BIT)
665000864555967, 2065379846933859, 370231110385876, 350988370788628,
1233371373142985
#else
5153727, 9909285, 1723747, 30776558, 30523604, 5516873, 19480852,
5230134, 43156425, 18378665
#endif
}},
{{
#if defined(ARCH_64BIT)
2019367628972465, 676711900706637, 110710997811333,
1108646842542025, 517791959672113
#else
36839857, 30090922, 7665485, 10083793, 28475525, 1649722, 20654025,
16520125, 30598449, 7715701
#endif
}},
{{
#if defined(ARCH_64BIT)
965130719900578, 247011430587952, 526356006571389, 91986625355052,
2157223321444601
#else
28881826, 14381568, 9657904, 3680757, 46927229, 7843315, 35708204,
1370707, 29794553, 32145132
#endif
}},
},
{
{{
#if defined(ARCH_64BIT)
1802695059465007, 1664899123557221, 593559490740857,
2160434469266659, 927570450755031
#else
44589871, 26862249, 14201701, 24808930, 43598457, 8844725, 18474211,
32192982, 54046167, 13821876
#endif
}},
{{
#if defined(ARCH_64BIT)
1725674970513508, 1933645953859181, 1542344539275782,
1767788773573747, 1297447965928905
#else
60653668, 25714560, 3374701, 28813570, 40010246, 22982724, 31655027,
26342105, 18853321, 19333481
#endif
}},
{{
#if defined(ARCH_64BIT)
1381809363726107, 1430341051343062, 2061843536018959,
1551778050872521, 2036394857967624
#else
4566811, 20590564, 38133974, 21313742, 59506191, 30723862, 58594505,
23123294, 2207752, 30344648
#endif
}},
},
{
{{
#if defined(ARCH_64BIT)
1970894096313054, 528066325833207, 1619374932191227,
2207306624415883, 1169170329061080
#else
41954014, 29368610, 29681143, 7868801, 60254203, 24130566, 54671499,
32891431, 35997400, 17421995
#endif
}},
{{
#if defined(ARCH_64BIT)
2070390218572616, 1458919061857835, 624171843017421,
1055332792707765, 433987520732508
#else
25576264, 30851218, 7349803, 21739588, 16472781, 9300885, 3844789,
15725684, 171356, 6466918
#endif
}},
{{
#if defined(ARCH_64BIT)
893653801273833, 1168026499324677, 1242553501121234,
1306366254304474, 1086752658510815
#else
23103977, 13316479, 9739013, 17404951, 817874, 18515490, 8965338,
19466374, 36393951, 16193876
#endif
}},
},
{
{{
#if defined(ARCH_64BIT)
213454002618221, 939771523987438, 1159882208056014, 317388369627517,
621213314200687
#else
33587053, 3180712, 64714734, 14003686, 50205390, 17283591, 17238397,
4729455, 49034351, 9256799
#endif
}},
{{
#if defined(ARCH_64BIT)
1971678598905747, 338026507889165, 762398079972271, 655096486107477,
42299032696322
#else
41926547, 29380300, 32336397, 5036987, 45872047, 11360616, 22616405,
9761698, 47281666, 630304
#endif
}},
{{
#if defined(ARCH_64BIT)
177130678690680, 1754759263300204, 1864311296286618,
1180675631479880, 1292726903152791
#else
53388152, 2639452, 42871404, 26147950, 9494426, 27780403, 60554312,
17593437, 64659607, 19263131
#endif
}},
},
{
{{
#if defined(ARCH_64BIT)
1913163449625248, 460779200291993, 2193883288642314,
1008900146920800, 1721983679009502
#else
63957664, 28508356, 9282713, 6866145, 35201802, 32691408, 48168288,
15033783, 25105118, 25659556
#endif
}},
{{
#if defined(ARCH_64BIT)
1070401523076875, 1272492007800961, 1910153608563310,
2075579521696771, 1191169788841221
#else
42782475, 15950225, 35307649, 18961608, 55446126, 28463506, 1573891,
30928545, 2198789, 17749813
#endif
}},
{{
#if defined(ARCH_64BIT)
692896803108118, 500174642072499, 2068223309439677,
1162190621851337, 1426986007309901
#else
64009494, 10324966, 64867251, 7453182, 61661885, 30818928, 53296841,
17317989, 34647629, 21263748
#endif
}},
},
};

61
unikernel/duniverse/mirage-crypto/ec/native/inversion_template.h Normal file
View file

@ -0,0 +1,61 @@
#define MAKE_FN_NAME1(x,y) x ## y
#define MAKE_FN_NAME(x,y) MAKE_FN_NAME1(x,y)
#define PRECOMP MAKE_FN_NAME(CURVE_DESCRIPTION,_divstep_precomp)
#define MSAT MAKE_FN_NAME(CURVE_DESCRIPTION,_msat)
#define MONE MAKE_FN_NAME(CURVE_DESCRIPTION,_set_one)
#define DIVSTEP MAKE_FN_NAME(CURVE_DESCRIPTION,_divstep)
#define OPP MAKE_FN_NAME(CURVE_DESCRIPTION,_opp)
#define MUL MAKE_FN_NAME(CURVE_DESCRIPTION,_mul)
#define SZNZ MAKE_FN_NAME(CURVE_DESCRIPTION,_selectznz)
#if LEN_PRIME < 46
#define ITERATIONS (((49 * LEN_PRIME) + 80) / 17)
#else
#define ITERATIONS (((49 * LEN_PRIME) + 57) / 17)
#endif
#define SAT_LIMBS LIMBS + 1 /* we might need 2 more bits to represent m in twos complement */
#define BYTES 8 * (((LEN_PRIME - 1) / 64) + 1)
static void inverse(WORD out[LIMBS], WORD g[SAT_LIMBS]) {
WORD precomp[LIMBS];
PRECOMP(precomp);
WORD d = 1;
WORD f[SAT_LIMBS];
WORD v[LIMBS];
WORD r[LIMBS];
WORD out1;
WORD out2[SAT_LIMBS], out3[SAT_LIMBS], out4[LIMBS], out5[LIMBS];
MSAT(f);
MONE(r);
for (int j = 0; j < LIMBS; j++) v[j] = 0;
for (int i = 0; i < ITERATIONS - (ITERATIONS % 2); i+=2) {
DIVSTEP(&out1,out2,out3,out4,out5,d,f,g,v,r);
DIVSTEP(&d,f,g,v,r,out1,out2,out3,out4,out5);
}
if (ITERATIONS % 2) {
DIVSTEP(&out1,out2,out3,out4,out5,d,f,g,v,r);
for (int k = 0; k < LIMBS; k++) v[k] = out4[k];
for (int k = 0; k < SAT_LIMBS; k++) f[k] = out2[k];
}
WORD h[LIMBS];
OPP(h, v);
SZNZ(v, f[SAT_LIMBS -1 ] >> (WORDSIZE - 1), v, h);
MUL(out, v, precomp);
return;
}
static void inversion (WORD out[LIMBS], const WORD in[LIMBS]) {
WORD in_[SAT_LIMBS];
for (int i = 0; i < LIMBS; i++) in_[i] = in[i];
in_[LIMBS] = 0;
inverse(out, in_);
return;
}

4264
unikernel/duniverse/mirage-crypto/ec/native/np256_32.h Normal file
View file

File diff suppressed because it is too large Load diff

1797
unikernel/duniverse/mirage-crypto/ec/native/np256_64.h Normal file
View file

File diff suppressed because it is too large Load diff

79
unikernel/duniverse/mirage-crypto/ec/native/np256_stubs.c Normal file
View file

@ -0,0 +1,79 @@
#include "mirage_crypto.h"
/* Microsoft compiler does not support 128-bit integers. Drop down to
* 32-bit for MSVC.
*/
#if defined(ARCH_64BIT) && !defined(_MSC_VER)
#include "np256_64.h"
#define LIMBS 4
#define WORD uint64_t
#define WORDSIZE 64
#else
#include "np256_32.h"
#define LIMBS 8
#define WORD uint32_t
#define WORDSIZE 32
#endif
#define LEN_PRIME 256
#define CURVE_DESCRIPTION fiat_np256
#include "inversion_template.h"
#include <caml/memory.h>
CAMLprim value mc_np256_inv(value out, value in)
{
CAMLparam2(out, in);
inversion((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np256_mul(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_np256_mul((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np256_add(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_np256_add((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np256_one(value out)
{
CAMLparam1(out);
fiat_np256_set_one((WORD*)Bytes_val(out));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np256_from_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_np256_from_bytes((WORD*)Bytes_val(out), _st_uint8(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np256_to_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_np256_to_bytes(Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np256_from_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_np256_from_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np256_to_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_np256_to_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}

8835
unikernel/duniverse/mirage-crypto/ec/native/np384_32.h Normal file
View file

File diff suppressed because it is too large Load diff

3104
unikernel/duniverse/mirage-crypto/ec/native/np384_64.h Normal file
View file

File diff suppressed because it is too large Load diff

79
unikernel/duniverse/mirage-crypto/ec/native/np384_stubs.c Normal file
View file

@ -0,0 +1,79 @@
#include "mirage_crypto.h"
/* Microsoft compiler does not support 128-bit integers. Drop down to
* 32-bit for MSVC.
*/
#if defined(ARCH_64BIT) && !defined(_MSC_VER)
#include "np384_64.h"
#define LIMBS 6
#define WORD uint64_t
#define WORDSIZE 64
#else
#include "np384_32.h"
#define LIMBS 12
#define WORD uint32_t
#define WORDSIZE 32
#endif
#define LEN_PRIME 384
#define CURVE_DESCRIPTION fiat_np384
#include "inversion_template.h"
#include <caml/memory.h>
CAMLprim value mc_np384_inv(value out, value in)
{
CAMLparam2(out, in);
inversion((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np384_mul(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_np384_mul((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np384_add(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_np384_add((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np384_one(value out)
{
CAMLparam1(out);
fiat_np384_set_one((WORD*)Bytes_val(out));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np384_from_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_np384_from_bytes((WORD*)Bytes_val(out), _st_uint8(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np384_to_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_np384_to_bytes(Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np384_from_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_np384_from_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np384_to_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_np384_to_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}

16271
unikernel/duniverse/mirage-crypto/ec/native/np521_32.h Normal file
View file

File diff suppressed because it is too large Load diff

5628
unikernel/duniverse/mirage-crypto/ec/native/np521_64.h Normal file
View file

File diff suppressed because it is too large Load diff

80
unikernel/duniverse/mirage-crypto/ec/native/np521_stubs.c Normal file
View file

@ -0,0 +1,80 @@
#include "mirage_crypto.h"
/* Microsoft compiler does not support 128-bit integers. Drop down to
* 32-bit for MSVC.
*/
#if defined(ARCH_64BIT) && !defined(_MSC_VER)
#include "np521_64.h"
#define LIMBS 9
#define WORD uint64_t
#define WORDSIZE 64
#else
#include "np521_32.h"
#define LIMBS 17
#define WORD uint32_t
#define WORDSIZE 32
#endif
#define LEN_PRIME 521
#define CURVE_DESCRIPTION fiat_np521
#include "inversion_template.h"
#include <caml/memory.h>
CAMLprim value mc_np521_inv(value out, value in)
{
CAMLparam2(out, in);
inversion((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np521_mul(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_np521_mul((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np521_add(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_np521_add((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np521_one(value out)
{
CAMLparam1(out);
fiat_np521_set_one((WORD*)Bytes_val(out));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np521_from_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_np521_from_bytes((WORD*)Bytes_val(out), _st_uint8(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np521_to_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_np521_to_bytes(Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np521_from_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_np521_from_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_np521_to_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_np521_to_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}

4760
unikernel/duniverse/mirage-crypto/ec/native/p256_32.h Normal file
View file

File diff suppressed because it is too large Load diff

2011
unikernel/duniverse/mirage-crypto/ec/native/p256_64.h Normal file
View file

File diff suppressed because it is too large Load diff

160
unikernel/duniverse/mirage-crypto/ec/native/p256_stubs.c Normal file
View file

@ -0,0 +1,160 @@
#include "mirage_crypto.h"
/* Microsoft compiler does not support 128-bit integers. Drop down to
* 32-bit for MSVC.
*/
#if defined(ARCH_64BIT) && !defined(_MSC_VER)
#include "p256_64.h"
#define LIMBS 4
#define WORD uint64_t
#define WORDSIZE 64
#include "p256_tables_64.h"
#else
#include "p256_32.h"
#define LIMBS 8
#define WORD uint32_t
#define WORDSIZE 32
#include "p256_tables_32.h"
#endif
#define LEN_PRIME 256
#define CURVE_DESCRIPTION fiat_p256
#include "inversion_template.h"
#include "point_operations.h"
#include <caml/memory.h>
CAMLprim value mc_p256_sub(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_p256_sub((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_add(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_p256_add((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_mul(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_p256_mul((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_from_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_p256_from_bytes((WORD*)Bytes_val(out), _st_uint8(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_to_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_p256_to_bytes(Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_sqr(value out, value in)
{
CAMLparam2(out, in);
fiat_p256_square((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_from_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_p256_from_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_to_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_p256_to_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_nz(value x)
{
CAMLparam1(x);
CAMLreturn(Val_bool(fe_nz((const WORD*)String_val(x))));
}
CAMLprim value mc_p256_set_one(value x)
{
CAMLparam1(x);
fiat_p256_set_one((WORD*)Bytes_val(x));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_inv(value out, value in)
{
CAMLparam2(out, in);
inversion((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_point_double(value out, value in)
{
CAMLparam2(out, in);
point_double(
(WORD*)Bytes_val(Field(out, 0)),
(WORD*)Bytes_val(Field(out, 1)),
(WORD*)Bytes_val(Field(out, 2)),
(const WORD*)String_val(Field(in, 0)),
(const WORD*)String_val(Field(in, 1)),
(const WORD*)String_val(Field(in, 2))
);
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_point_add(value out, value p, value q)
{
CAMLparam3(out, p, q);
point_add(
(WORD*)Bytes_val(Field(out, 0)),
(WORD*)Bytes_val(Field(out, 1)),
(WORD*)Bytes_val(Field(out, 2)),
(const WORD*)String_val(Field(p, 0)),
(const WORD*)String_val(Field(p, 1)),
(const WORD*)String_val(Field(p, 2)),
0,
(const WORD*)String_val(Field(q, 0)),
(const WORD*)String_val(Field(q, 1)),
(const WORD*)String_val(Field(q, 2))
);
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_select(value out, value bit, value t, value f)
{
CAMLparam4(out, bit, t, f);
fe_cmovznz(
(WORD*)Bytes_val(out),
Bool_val(bit),
(const WORD*)String_val(f),
(const WORD*)String_val(t)
);
CAMLreturn(Val_unit);
}
CAMLprim value mc_p256_scalar_mult_base(value out, value s)
{
CAMLparam2(out, s);
scalar_mult_base(
(WORD *) Bytes_val(Field(out, 0)),
(WORD *) Bytes_val(Field(out, 1)),
(WORD *) Bytes_val(Field(out, 2)),
_st_uint8(s),
caml_string_length(s)
);
CAMLreturn(Val_unit);
}

13581
unikernel/duniverse/mirage-crypto/ec/native/p256_tables_32.h Normal file
View file

File diff suppressed because it is too large Load diff

13581
unikernel/duniverse/mirage-crypto/ec/native/p256_tables_64.h Normal file
View file

File diff suppressed because it is too large Load diff

10141
unikernel/duniverse/mirage-crypto/ec/native/p384_32.h Normal file
View file

File diff suppressed because it is too large Load diff

3870
unikernel/duniverse/mirage-crypto/ec/native/p384_64.h Normal file
View file

File diff suppressed because it is too large Load diff

159
unikernel/duniverse/mirage-crypto/ec/native/p384_stubs.c Normal file
View file

@ -0,0 +1,159 @@
#include "mirage_crypto.h"
/* Microsoft compiler does not support 128-bit integers. Drop down to
* 32-bit for MSVC.
*/
#if defined(ARCH_64BIT) && !defined(_MSC_VER)
#include "p384_64.h"
#define LIMBS 6
#define WORD uint64_t
#define WORDSIZE 64
#include "p384_tables_64.h"
#else
#include "p384_32.h"
#define LIMBS 12
#define WORD uint32_t
#define WORDSIZE 32
#include "p384_tables_32.h"
#endif
#define LEN_PRIME 384
#define CURVE_DESCRIPTION fiat_p384
#include "inversion_template.h"
#include "point_operations.h"
#include <caml/memory.h>
CAMLprim value mc_p384_sub(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_p384_sub((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_add(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_p384_add((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_mul(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_p384_mul((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_from_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_p384_from_bytes((WORD*)Bytes_val(out), _st_uint8(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_to_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_p384_to_bytes(Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_sqr(value out, value in)
{
CAMLparam2(out, in);
fiat_p384_square((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_from_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_p384_from_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_to_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_p384_to_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_nz(value x)
{
CAMLparam1(x);
CAMLreturn(Val_bool(fe_nz((const WORD*)String_val(x))));
}
CAMLprim value mc_p384_set_one(value x)
{
CAMLparam1(x);
fiat_p384_set_one((WORD*)Bytes_val(x));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_inv(value out, value in)
{
CAMLparam2(out, in);
inversion((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_point_double(value out, value in)
{
CAMLparam2(out, in);
point_double(
(WORD*)Bytes_val(Field(out, 0)),
(WORD*)Bytes_val(Field(out, 1)),
(WORD*)Bytes_val(Field(out, 2)),
(const WORD*)String_val(Field(in, 0)),
(const WORD*)String_val(Field(in, 1)),
(const WORD*)String_val(Field(in, 2))
);
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_point_add(value out, value p, value q)
{
CAMLparam3(out, p, q);
point_add(
(WORD*)Bytes_val(Field(out, 0)),
(WORD*)Bytes_val(Field(out, 1)),
(WORD*)Bytes_val(Field(out, 2)),
(const WORD*)String_val(Field(p, 0)),
(const WORD*)String_val(Field(p, 1)),
(const WORD*)String_val(Field(p, 2)),
0,
(const WORD*)String_val(Field(q, 0)),
(const WORD*)String_val(Field(q, 1)),
(const WORD*)String_val(Field(q, 2))
);
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_select(value out, value bit, value t, value f)
{
CAMLparam4(out, bit, t, f);
fe_cmovznz(
(WORD*)Bytes_val(out),
Bool_val(bit),
(const WORD*)String_val(f),
(const WORD*)String_val(t)
);
CAMLreturn(Val_unit);
}
CAMLprim value mc_p384_scalar_mult_base(value out, value s)
{
CAMLparam2(out, s);
scalar_mult_base(
(WORD *) Bytes_val(Field(out, 0)),
(WORD *) Bytes_val(Field(out, 1)),
(WORD *) Bytes_val(Field(out, 2)),
_st_uint8(s),
caml_string_length(s)
);
CAMLreturn(Val_unit);
}

24684
unikernel/duniverse/mirage-crypto/ec/native/p384_tables_32.h Normal file
View file

File diff suppressed because it is too large Load diff

20365
unikernel/duniverse/mirage-crypto/ec/native/p384_tables_64.h Normal file
View file

File diff suppressed because it is too large Load diff

19718
unikernel/duniverse/mirage-crypto/ec/native/p521_32.h Normal file
View file

File diff suppressed because it is too large Load diff

6619
unikernel/duniverse/mirage-crypto/ec/native/p521_64.h Normal file
View file

File diff suppressed because it is too large Load diff

159
unikernel/duniverse/mirage-crypto/ec/native/p521_stubs.c Normal file
View file

@ -0,0 +1,159 @@
#include "mirage_crypto.h"
/* Microsoft compiler does not support 128-bit integers. Drop down to
* 32-bit for MSVC.
*/
#if defined(ARCH_64BIT) && !defined(_MSC_VER)
#include "p521_64.h"
#define LIMBS 9
#define WORD uint64_t
#define WORDSIZE 64
#include "p521_tables_64.h"
#else
#include "p521_32.h"
#define LIMBS 17
#define WORD uint32_t
#define WORDSIZE 32
#include "p521_tables_32.h"
#endif
#define LEN_PRIME 521
#define CURVE_DESCRIPTION fiat_p521
#include "inversion_template.h"
#include "point_operations.h"
#include <caml/memory.h>
CAMLprim value mc_p521_sub(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_p521_sub((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_add(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_p521_add((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_mul(value out, value a, value b)
{
CAMLparam3(out, a, b);
fiat_p521_mul((WORD*)Bytes_val(out), (const WORD*)String_val(a), (const WORD*)String_val(b));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_from_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_p521_from_bytes((WORD*)Bytes_val(out), _st_uint8(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_to_bytes(value out, value in)
{
CAMLparam2(out, in);
fiat_p521_to_bytes(Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_sqr(value out, value in)
{
CAMLparam2(out, in);
fiat_p521_square((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_from_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_p521_from_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_to_montgomery(value out, value in)
{
CAMLparam2(out, in);
fiat_p521_to_montgomery((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_nz(value x)
{
CAMLparam1(x);
CAMLreturn(Val_bool(fe_nz((const WORD*)String_val(x))));
}
CAMLprim value mc_p521_set_one(value x)
{
CAMLparam1(x);
fiat_p521_set_one((WORD*)Bytes_val(x));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_inv(value out, value in)
{
CAMLparam2(out, in);
inversion((WORD*)Bytes_val(out), (const WORD*)String_val(in));
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_point_double(value out, value in)
{
CAMLparam2(out, in);
point_double(
(WORD*)Bytes_val(Field(out, 0)),
(WORD*)Bytes_val(Field(out, 1)),
(WORD*)Bytes_val(Field(out, 2)),
(const WORD*)String_val(Field(in, 0)),
(const WORD*)String_val(Field(in, 1)),
(const WORD*)String_val(Field(in, 2))
);
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_point_add(value out, value p, value q)
{
CAMLparam3(out, p, q);
point_add(
(WORD*)Bytes_val(Field(out, 0)),
(WORD*)Bytes_val(Field(out, 1)),
(WORD*)Bytes_val(Field(out, 2)),
(const WORD*)String_val(Field(p, 0)),
(const WORD*)String_val(Field(p, 1)),
(const WORD*)String_val(Field(p, 2)),
0,
(const WORD*)String_val(Field(q, 0)),
(const WORD*)String_val(Field(q, 1)),
(const WORD*)String_val(Field(q, 2))
);
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_select(value out, value bit, value t, value f)
{
CAMLparam4(out, bit, t, f);
fe_cmovznz(
(WORD*)Bytes_val(out),
Bool_val(bit),
(const WORD*)String_val(f),
(const WORD*)String_val(t)
);
CAMLreturn(Val_unit);
}
CAMLprim value mc_p521_scalar_mult_base(value out, value s)
{
CAMLparam2(out, s);
scalar_mult_base(
(WORD *) Bytes_val(Field(out, 0)),
(WORD *) Bytes_val(Field(out, 1)),
(WORD *) Bytes_val(Field(out, 2)),
_st_uint8(s),
caml_string_length(s)
);
CAMLreturn(Val_unit);
}

263
unikernel/duniverse/mirage-crypto/ec/native/point_operations.h Normal file
View file

@ -0,0 +1,263 @@
#define MAKE_FN_NAME1(x,y) x ## y
#define MAKE_FN_NAME(x,y) MAKE_FN_NAME1(x,y)
#define fe_one MAKE_FN_NAME(CURVE_DESCRIPTION,_set_one)
#define fe_add MAKE_FN_NAME(CURVE_DESCRIPTION,_add)
#define fe_sub MAKE_FN_NAME(CURVE_DESCRIPTION,_sub)
#define fe_mul MAKE_FN_NAME(CURVE_DESCRIPTION,_mul)
#define fe_sqr MAKE_FN_NAME(CURVE_DESCRIPTION,_square)
#define fe_nonzero MAKE_FN_NAME(CURVE_DESCRIPTION,_nonzero)
#define fe_selectznz MAKE_FN_NAME(CURVE_DESCRIPTION,_selectznz)
#define fe_from_bytes MAKE_FN_NAME(CURVE_DESCRIPTION,_from_bytes)
#define fe_to_mont MAKE_FN_NAME(CURVE_DESCRIPTION,_to_montgomery)
typedef WORD fe[LIMBS];
static WORD fe_nz(const WORD in1[LIMBS]) {
WORD ret;
fe_nonzero(&ret, in1);
return ret;
}
static void fe_copy(WORD out[LIMBS], const WORD in1[LIMBS]) {
for (int i = 0; i < LIMBS; i++) {
out[i] = in1[i];
}
}
static void fe_cmovznz(WORD out[LIMBS], WORD t, const WORD z[LIMBS],
const WORD nz[LIMBS]) {
fe_selectznz(out, !!t, z, nz);
}
// Group operations
// ----------------
//
// Building on top of the field operations we have the operations on the
// elliptic curve group itself. Points on the curve are represented in Jacobian
// coordinates.
//
// Both operations were transcribed to Coq and proven to correspond to naive
// implementations using Affine coordinates, for all suitable fields. In the
// Coq proofs, issues of constant-time execution and memory layout (aliasing)
// conventions were not considered. Specification of affine coordinates:
// <https://github.com/mit-plv/fiat-crypto/blob/79f8b5f39ed609339f0233098dee1a3c4e6b3080/src/Spec/WeierstrassCurve.v#L28>
// As a sanity check, a proof that these points form a commutative group:
// <https://github.com/mit-plv/fiat-crypto/blob/79f8b5f39ed609339f0233098dee1a3c4e6b3080/src/Curves/Weierstrass/AffineProofs.v#L33>
// point_double calculates 2*(x_in, y_in, z_in)
//
// The method is taken from:
// http://hyperelliptic.org/EFD/g1p/auto-shortw-jacobian-3.html#doubling-dbl-2001-b
//
// Coq transcription and correctness proof:
// <https://github.com/mit-plv/fiat-crypto/blob/79f8b5f39ed609339f0233098dee1a3c4e6b3080/src/Curves/Weierstrass/Jacobian.v#L93>
// <https://github.com/mit-plv/fiat-crypto/blob/79f8b5f39ed609339f0233098dee1a3c4e6b3080/src/Curves/Weierstrass/Jacobian.v#L201>
//
// Outputs can equal corresponding inputs, i.e., x_out == x_in is allowed.
// while x_out == y_in is not (maybe this works, but it's not tested).
static void point_double(fe x_out, fe y_out, fe z_out,
const fe x_in, const fe y_in, const fe z_in) {
fe delta, gamma, beta, ftmp, ftmp2, tmptmp, alpha, fourbeta;
// delta = z^2
fe_sqr(delta, z_in);
// gamma = y^2
fe_sqr(gamma, y_in);
// beta = x*gamma
fe_mul(beta, x_in, gamma);
// alpha = 3*(x-delta)*(x+delta)
fe_sub(ftmp, x_in, delta);
fe_add(ftmp2, x_in, delta);
fe_add(tmptmp, ftmp2, ftmp2);
fe_add(ftmp2, ftmp2, tmptmp);
fe_mul(alpha, ftmp, ftmp2);
// x' = alpha^2 - 8*beta
fe_sqr(x_out, alpha);
fe_add(fourbeta, beta, beta);
fe_add(fourbeta, fourbeta, fourbeta);
fe_add(tmptmp, fourbeta, fourbeta);
fe_sub(x_out, x_out, tmptmp);
// z' = (y + z)^2 - gamma - delta
fe_add(delta, gamma, delta);
fe_add(ftmp, y_in, z_in);
fe_sqr(z_out, ftmp);
fe_sub(z_out, z_out, delta);
// y' = alpha*(4*beta - x') - 8*gamma^2
fe_sub(y_out, fourbeta, x_out);
fe_add(gamma, gamma, gamma);
fe_sqr(gamma, gamma);
fe_mul(y_out, alpha, y_out);
fe_add(gamma, gamma, gamma);
fe_sub(y_out, y_out, gamma);
}
// point_add calculates (x1, y1, z1) + (x2, y2, z2)
//
// The method is taken from:
// http://hyperelliptic.org/EFD/g1p/auto-shortw-jacobian-3.html#addition-add-2007-bl,
// adapted for mixed addition (z2 = 1, or z2 = 0 for the point at infinity).
//
// Coq transcription and correctness proof:
// <https://github.com/mit-plv/fiat-crypto/blob/79f8b5f39ed609339f0233098dee1a3c4e6b3080/src/Curves/Weierstrass/Jacobian.v#L135>
// <https://github.com/mit-plv/fiat-crypto/blob/79f8b5f39ed609339f0233098dee1a3c4e6b3080/src/Curves/Weierstrass/Jacobian.v#L205>
//
// This function includes a branch for checking whether the two input points
// are equal, (while not equal to the point at infinity). This case never
// happens during single point multiplication, so there is no timing leak for
// ECDH or ECDSA signing.
static void point_add(fe x3, fe y3, fe z3, const fe x1,
const fe y1, const fe z1, const int mixed,
const fe x2, const fe y2, const fe z2) {
fe x_out, y_out, z_out;
WORD z1nz = fe_nz(z1);
WORD z2nz = fe_nz(z2);
// z1z1 = z1z1 = z1**2
fe z1z1; fe_sqr(z1z1, z1);
fe u1, s1, two_z1z2;
if (!mixed) {
// z2z2 = z2**2
fe z2z2; fe_sqr(z2z2, z2);
// u1 = x1*z2z2
fe_mul(u1, x1, z2z2);
// two_z1z2 = (z1 + z2)**2 - (z1z1 + z2z2) = 2z1z2
fe_add(two_z1z2, z1, z2);
fe_sqr(two_z1z2, two_z1z2);
fe_sub(two_z1z2, two_z1z2, z1z1);
fe_sub(two_z1z2, two_z1z2, z2z2);
// s1 = y1 * z2**3
fe_mul(s1, z2, z2z2);
fe_mul(s1, s1, y1);
} else {
// We'll assume z2 = 1 (special case z2 = 0 is handled later).
// u1 = x1*z2z2
fe_copy(u1, x1);
// two_z1z2 = 2z1z2
fe_add(two_z1z2, z1, z1);
// s1 = y1 * z2**3
fe_copy(s1, y1);
}
// u2 = x2*z1z1
fe u2; fe_mul(u2, x2, z1z1);
// h = u2 - u1
fe h; fe_sub(h, u2, u1);
WORD xneq = fe_nz(h);
// z_out = two_z1z2 * h
fe_mul(z_out, h, two_z1z2);
// z1z1z1 = z1 * z1z1
fe z1z1z1; fe_mul(z1z1z1, z1, z1z1);
// s2 = y2 * z1**3
fe s2; fe_mul(s2, y2, z1z1z1);
// r = (s2 - s1)*2
fe r;
fe_sub(r, s2, s1);
fe_add(r, r, r);
WORD yneq = fe_nz(r);
if (!xneq && !yneq && z1nz && z2nz) {
point_double(x3, y3, z3, x1, y1, z1);
return;
}
// I = (2h)**2
fe i;
fe_add(i, h, h);
fe_sqr(i, i);
// J = h * I
fe j; fe_mul(j, h, i);
// V = U1 * I
fe v; fe_mul(v, u1, i);
// x_out = r**2 - J - 2V
fe_sqr(x_out, r);
fe_sub(x_out, x_out, j);
fe_sub(x_out, x_out, v);
fe_sub(x_out, x_out, v);
// y_out = r(V-x_out) - 2 * s1 * J
fe_sub(y_out, v, x_out);
fe_mul(y_out, y_out, r);
fe s1j;
fe_mul(s1j, s1, j);
fe_sub(y_out, y_out, s1j);
fe_sub(y_out, y_out, s1j);
fe_cmovznz(x_out, z1nz, x2, x_out);
fe_cmovznz(x3, z2nz, x1, x_out);
fe_cmovznz(y_out, z1nz, y2, y_out);
fe_cmovznz(y3, z2nz, y1, y_out);
fe_cmovznz(z_out, z1nz, z2, z_out);
fe_cmovznz(z3, z2nz, z1, z_out);
}
/* Use a sliding window optimization method for scalar multiplication
Hard-coded window size = 4
Implementation inspired from Go's crypto library
https://github.com/golang/go/blob/a5cd894318677359f6d07ee74f9004d28b4d164c/src/crypto/internal/nistec/p256.go#L317
*/
/* Select the n-th element of the table
without leaking information about [n] */
static void table_select(fe out_x, fe out_y, fe out_z, size_t index, uint8_t n) {
fe x, y, z = {0};
fe_one(x); fe_one(y);
for(uint8_t i = 1 ; i < 16 ; ++i) {
WORD cond = i ^ n;
fe_cmovznz(x, cond, generator_table[index][n - 1][0], x);
fe_cmovznz(y, cond, generator_table[index][n - 1][1], y);
fe_cmovznz(z, cond, generator_table[index][n - 1][2], z);
}
fe_copy(out_x, x);
fe_copy(out_y, y);
fe_copy(out_z, z);
}
/* Returns [kG] by decomposing [k] in binary form, and adding
[2^0G * k_0 + 2^1G * k_1 + ...] in constant time using
pre-computed values of 2^iG */
static void scalar_mult_base(fe x2, fe y2, fe z2,
const uint8_t* scalar, size_t len) {
// P = 0
fe p_x, p_y, p_z = {0};
fe_one(p_x);
fe_one(p_y);
size_t index = 0;
for(size_t i = 0 ; i < len ; ++i) {
fe s_x, s_y, s_z;
uint8_t window = scalar[i] & 0xf;
table_select(s_x, s_y, s_z, index, window);
point_add(p_x, p_y, p_z, p_x, p_y, p_z, 0, s_x, s_y, s_z);
index++;
window = scalar[i] >> 4;
table_select(s_x, s_y, s_z, index, window);
point_add(p_x, p_y, p_z, p_x, p_y, p_z, 0, s_x, s_y, s_z);
index++;
}
fe_copy(x2, p_x);
fe_copy(y2, p_y);
fe_copy(z2, p_z);
}

54
unikernel/duniverse/mirage-crypto/mirage-crypto-ec.opam Normal file
View file

@ -0,0 +1,54 @@
version: "2.0.2"
opam-version: "2.0"
synopsis: "Elliptic Curve Cryptography with primitives taken from Fiat"
description: """
An implementation of key exchange (ECDH) and digital signature (ECDSA/EdDSA)
algorithms using code from Fiat (<https://github.com/mit-plv/fiat-crypto>).
The curves P256 (SECP256R1), P384 (SECP384R1),
P521 (SECP521R1), and 25519 (X25519, Ed25519) are implemented by this package.
"""
maintainer: "Hannes Mehnert <hannes@mehnert.org>"
authors: [
"Hannes Mehnert <hannes@mehnert.org>"
"Nathan Rebours <nathan.p.rebours@gmail.com>"
"Clément Pascutto <clement@tarides.com>"
"Etienne Millon <me@emillon.org>"
"Virgile Robles <virgile.robles@protonmail.ch>"
# and from the fiat-crypto AUTHORS file
"Andres Erbsen <andreser@mit.edu>"
"Google Inc."
"Jade Philipoom <jadep@mit.edu> <jade.philipoom@gmail.com>"
"Massachusetts Institute of Technology"
"Zoe Paraskevopoulou <zoe.paraskevopoulou@gmail.com>"
]
license: "MIT"
homepage: "https://github.com/mirage/mirage-crypto"
doc: "https://mirage.github.io/mirage-crypto/doc"
bug-reports: "https://github.com/mirage/mirage-crypto/issues"
depends: [
"dune" {>= "2.7"}
"ocaml" {>= "4.13.0"}
"dune-configurator"
"eqaf" {>= "0.7"}
"mirage-crypto-rng" {=version}
"digestif" {>= "1.2.0"}
"alcotest" {with-test & >= "0.8.1"}
"ppx_deriving_yojson" {with-test}
"ppx_deriving" {with-test}
"yojson" {with-test & >= "1.6.0"}
"asn1-combinators" {with-test & >= "0.3.1"}
"ohex" {with-test & >= "0.2.0"}
"ounit2" {with-test}
]
conflicts: [
"ocaml-freestanding"
]
build: [
["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
dev-repo: "git+https://github.com/mirage/mirage-crypto.git"
tags: ["org:mirage"]
x-maintenance-intent: [ "(latest)" ]

35
unikernel/duniverse/mirage-crypto/mirage-crypto-pk.opam Normal file
View file

@ -0,0 +1,35 @@
version: "2.0.2"
opam-version: "2.0"
homepage: "https://github.com/mirage/mirage-crypto"
dev-repo: "git+https://github.com/mirage/mirage-crypto.git"
bug-reports: "https://github.com/mirage/mirage-crypto/issues"
doc: "https://mirage.github.io/mirage-crypto/doc"
authors: ["David Kaloper <dk505@cam.ac.uk>" "Hannes Mehnert <hannes@mehnert.org>" ]
maintainer: "Hannes Mehnert <hannes@mehnert.org>"
license: "ISC"
synopsis: "Simple public-key cryptography for the modern age"
build: [ ["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs ]
["dune" "runtest" "-p" name "-j" jobs] {with-test} ]
depends: [
"conf-gmp-powm-sec" {build}
"ocaml" {>= "4.13.0"}
"dune" {>= "2.7"}
"ounit2" {with-test}
"randomconv" {with-test & >= "0.2.0"}
"ohex" {with-test & >= "0.2.0"}
"mirage-crypto" {=version}
"mirage-crypto-rng" {=version}
"digestif" {>= "1.2.0"}
"zarith" {>= "1.13"}
"eqaf" {>= "0.8"}
]
conflicts: [
"ocaml-freestanding"
]
description: """
Mirage-crypto-pk provides public-key cryptography (RSA, DSA, DH).
"""
x-maintenance-intent: [ "(latest)" ]

31
unikernel/duniverse/mirage-crypto/mirage-crypto-rng-miou-unix.opam Normal file
View file

@ -0,0 +1,31 @@
version: "2.0.2"
opam-version: "2.0"
homepage: "https://github.com/mirage/mirage-crypto"
dev-repo: "git+https://github.com/mirage/mirage-crypto.git"
bug-reports: "https://github.com/mirage/mirage-crypto/issues"
doc: "https://mirage.github.io/mirage-crypto/doc"
authors: ["Romain Calascibetta <romain.calascibetta@gmail.com>" ]
maintainer: "Romain Calascibetta <romain.calascibetta@gmail.com>"
license: "ISC"
synopsis: "Feed the entropy source in an miou.unix-friendly way"
build: [ ["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs ]
["dune" "runtest" "-p" name "-j" jobs] {with-test} ]
depends: [
"ocaml" {>= "5.0.0"}
"dune" {>= "2.7"}
"miou" {>= "0.2.0"}
"logs"
"mirage-crypto-rng" {=version}
"duration"
"mtime" {>= "1.0.0"}
"digestif" {>= "1.2.0"}
"ohex" {with-test & >= "0.2.0"}
]
description: """
Mirage-crypto-rng-miou-unix feeds the entropy source for Mirage_crypto_rng-based
random number generator implementations, in an miou.unix-friendly way.
"""
x-maintenance-intent: [ "(latest)" ]

32
unikernel/duniverse/mirage-crypto/mirage-crypto-rng-mirage.opam Normal file
View file

@ -0,0 +1,32 @@
version: "2.0.2"
opam-version: "2.0"
homepage: "https://github.com/mirage/mirage-crypto"
dev-repo: "git+https://github.com/mirage/mirage-crypto.git"
bug-reports: "https://github.com/mirage/mirage-crypto/issues"
doc: "https://mirage.github.io/mirage-crypto/doc"
authors: ["David Kaloper <dk505@cam.ac.uk>" "Hannes Mehnert <hannes@mehnert.org>" ]
maintainer: "Hannes Mehnert <hannes@mehnert.org>"
license: "BSD-2-Clause"
synopsis: "Entropy collection for a cryptographically secure PRNG"
build: [ ["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs ]
["dune" "runtest" "-p" name "-j" jobs] {with-test} ]
depends: [
"ocaml" {>= "4.13.0"}
"dune" {>= "2.7"}
"mirage-crypto-rng" {=version}
"duration"
"logs"
"lwt" {>= "4.0.0"}
"mirage-runtime" {>= "3.8.0"}
"mirage-sleep" {>= "4.0.0"}
"mirage-mtime" {>= "4.0.0"}
"mirage-unix" {with-test & >= "5.0.0"}
"ohex" {with-test & >= "0.2.0"}
]
description: """
Mirage-crypto-rng-mirage provides entropy collection code for the RNG.
"""
x-maintenance-intent: [ "(latest)" ]

34
unikernel/duniverse/mirage-crypto/mirage-crypto-rng.opam Normal file
View file

@ -0,0 +1,34 @@
version: "2.0.2"
opam-version: "2.0"
homepage: "https://github.com/mirage/mirage-crypto"
dev-repo: "git+https://github.com/mirage/mirage-crypto.git"
bug-reports: "https://github.com/mirage/mirage-crypto/issues"
doc: "https://mirage.github.io/mirage-crypto/doc"
authors: ["David Kaloper <dk505@cam.ac.uk>" "Hannes Mehnert <hannes@mehnert.org>" ]
maintainer: "Hannes Mehnert <hannes@mehnert.org>"
license: "ISC"
synopsis: "A cryptographically secure PRNG"
build: [ ["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs ]
["dune" "runtest" "-p" name "-j" jobs] {with-test} ]
depends: [
"ocaml" {>= "4.14.0"}
"dune" {>= "2.7"}
"dune-configurator" {>= "2.0.0"}
"duration"
"logs"
"mirage-crypto" {=version}
"digestif" {>= "1.1.4"}
"ounit2" {with-test}
"randomconv" {with-test & >= "0.2.0"}
"ohex" {with-test & >= "0.2.0"}
]
conflicts: [ "mirage-runtime" {< "3.8.0"} ]
description: """
Mirage-crypto-rng provides a random number generator interface, and
implementations: Fortuna, HMAC-DRBG, getrandom/getentropy based (in the unix
sublibrary)
"""
x-maintenance-intent: [ "(latest)" ]

31
unikernel/duniverse/mirage-crypto/mirage-crypto.opam Normal file
View file

@ -0,0 +1,31 @@
version: "2.0.2"
opam-version: "2.0"
homepage: "https://github.com/mirage/mirage-crypto"
dev-repo: "git+https://github.com/mirage/mirage-crypto.git"
bug-reports: "https://github.com/mirage/mirage-crypto/issues"
doc: "https://mirage.github.io/mirage-crypto/doc"
authors: ["David Kaloper <dk505@cam.ac.uk>" "Hannes Mehnert <hannes@mehnert.org>" ]
maintainer: "Hannes Mehnert <hannes@mehnert.org>"
license: "ISC"
synopsis: "Simple symmetric cryptography for the modern age"
build: [ ["dune" "subst"] {dev}
["dune" "build" "-p" name "-j" jobs ]
["dune" "runtest" "-p" name "-j" jobs] {with-test} ]
depends: [
"ocaml" {>= "4.13.0"}
"dune" {>= "2.7"}
"dune-configurator" {>= "2.0.0"}
"ounit2" {with-test}
"ohex" {with-test & >= "0.2.0"}
"eqaf" {>= "0.8"}
]
conflicts: [
"ocaml-freestanding"
"result" {< "1.5"}
]
description: """
Mirage-crypto provides symmetric ciphers (DES, AES, RC4, ChaCha20/Poly1305).
"""
x-maintenance-intent: [ "(latest)" ]

15
unikernel/duniverse/mirage-crypto/mirage/config.ml Normal file
View file

@ -0,0 +1,15 @@
open Mirage
let main =
let packages = [
package "mirage-crypto-rng" ;
package "mirage-crypto-pk" ;
package "mirage-crypto" ;
package ~min:"0.8.7" "fmt" ;
package "ohex" ;
]
in
main ~packages "Unikernel" job
let () =
register "crypto-test" [main]

25
unikernel/duniverse/mirage-crypto/mirage/unikernel.ml Normal file
View file

@ -0,0 +1,25 @@
let start () =
Logs.info (fun m -> m "using Fortuna, entropy sources: %a"
Fmt.(list ~sep:(any ", ") Mirage_crypto_rng.Entropy.pp_source)
(Mirage_crypto_rng.Entropy.sources ())) ;
Logs.info (fun m -> m "64 byte random:@ %a" (Ohex.pp_hexdump ())
(Mirage_crypto_rng.generate 64)) ;
let n = Bytes.(unsafe_to_string (create 32)) in
let key = Mirage_crypto.Chacha20.of_secret n
and nonce = Bytes.(unsafe_to_string (create 12))
in
Logs.info (fun m -> m "Chacha20/Poly1305 of 32*0, key 32*0, nonce 12*0: %a"
(Ohex.pp_hexdump ())
(Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce n));
let key = Mirage_crypto_pk.Rsa.generate ~bits:4096 () in
let signature =
Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:`SHA256 ~key (`Message n)
in
let verified =
let key = Mirage_crypto_pk.Rsa.pub_of_priv key in
let hashp = function `SHA256 -> true | _ -> false in
Mirage_crypto_pk.Rsa.PKCS1.verify ~hashp ~key ~signature (`Message n)
in
Logs.info (fun m -> m "Generated a RSA key of %d bits (sign + verify %B)"
(Mirage_crypto_pk.Rsa.priv_bits key) verified);
Lwt.return_unit

5
unikernel/duniverse/mirage-crypto/pk/common.ml Normal file
View file

@ -0,0 +1,5 @@
let rec until p f = let r = f () in if p r then r else until p f
let guard p err = if p then Ok () else Error err
let ( let* ) = Result.bind

695
unikernel/duniverse/mirage-crypto/pk/dh.ml Normal file
View file

@ -0,0 +1,695 @@
open Mirage_crypto.Uncommon
open Common
exception Invalid_key
type group = {
p : Z.t ; (* The prime modulus *)
gg : Z.t ; (* Group generator *)
q : Z.t option ; (* `gg`'s order, maybe *)
}
let group ~p ~gg ?q () =
let* () =
guard (Z.(p > zero && is_odd p) && Z_extra.pseudoprime p)
(`Msg "invalid prime")
in
let* () =
guard Z.(one < gg && gg < p) (`Msg "invalid generator")
in
Ok { p ; gg ; q }
type secret = { group : group ; x : Z.t }
(*
* Estimates of equivalent-strength exponent sizes for the moduli sizes.
* 2048-8192 are taken from "Negotiated FF DHE Parameters for TLS."
* Sizes above and below are further guesswork.
*)
let exp_equivalent = [
(1024, 180); (2048, 225); (3072, 275); (4096, 325); (6144, 375); (8192, 400)
]
and exp_equivalent_max = 512
let exp_size bits =
try snd @@ List.find (fun (g, _) -> g >= bits) exp_equivalent
with Not_found -> exp_equivalent_max
let modulus_size { p; _ } = Z.numbits p
(*
* Current thinking:
* g^y < 0 || g^y >= p : obviously not computed mod p
* g^y = 0 || g^y = 1 : shared secret is 0, resp. 1
* g^y = p - 1 : order of g^y is 2
* g^y = g : y mod (p-1) is 1
*)
let bad_public_key { p; gg; _ } ggx =
ggx <= Z.one || ggx >= Z.(pred p) || ggx = gg
let valid_secret { p ; _ } s =
Z.(one < s && s < p)
let key_of_secret_z ({ p; gg; _ } as group) x =
if valid_secret group x then
match Z.(powm_sec gg x p) with
| ggx when bad_public_key group ggx -> raise_notrace Invalid_key
| ggx -> ({ group ; x }, Z_extra.to_octets_be ggx)
else
raise_notrace Invalid_key
let key_of_secret group ~s =
(* catches Invalid_private_key and re-raises with exception trace: *)
try key_of_secret_z group (Z_extra.of_octets_be s)
with Invalid_key -> raise Invalid_key
(* XXX
* - slightly weird distribution when bits > |q|
* - exponentiation time
*)
let rec gen_key ?g ?bits ({ p; q; _ } as group) =
let pb = Z.numbits p in
let s =
imin (Option.value bits ~default:pb |> exp_size)
(Option.fold ~none:pb ~some:Z.numbits q)
|> Z_extra.gen_bits ?g ~msb:1
in
try key_of_secret_z group s with Invalid_key -> gen_key ?g ?bits group
let shared { group ; x } cs =
match Z_extra.of_octets_be cs with
| ggy when bad_public_key group ggy -> None
| ggy -> Some (Z_extra.to_octets_be (Z.powm_sec ggy x group.p))
(* Finds a safe prime with [p = 2q + 1] and [2^q = 1 mod p]. *)
let rec gen_group ?g ~bits () =
let gg = Z.(~$2)
and (q, p) = Z_extra.safe_prime ?g (imax bits 1) in
if Z.(powm gg q p = one) then { p; gg; q = Some q } else gen_group ?g ~bits ()
module Group = struct
(* Safe-prime-style group: p = 2q + 1 && gg = 2 && gg^q = 1 mod p *)
let s_group ~p =
let p = Z_extra.of_octets_be p in
{ p ; gg = Z.(~$2) ; q = Some Z.(pred p / ~$2) }
(* Any old group. *)
let group ~p ~gg ~q =
let f = Z_extra.of_octets_be in
{ p = f p ; gg = f gg ; q = Some (f q) }
(* RFC2409 *)
let oakley_1 =
(* 2^768 - 2 ^704 - 1 + 2^64 * { [2^638 pi] + 149686 } *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xC9\x0F\xDA\xA2\x21\x68\xC2\x34\
\xC4\xC6\x62\x8B\x80\xDC\x1C\xD1\x29\x02\x4E\x08\x8A\x67\xCC\x74\
\x02\x0B\xBE\xA6\x3B\x13\x9B\x22\x51\x4A\x08\x79\x8E\x34\x04\xDD\
\xEF\x95\x19\xB3\xCD\x3A\x43\x1B\x30\x2B\x0A\x6D\xF2\x5F\x14\x37\
\x4F\xE1\x35\x6D\x6D\x51\xC2\x45\xE4\x85\xB5\x76\x62\x5E\x7E\xC6\
\xF4\x4C\x42\xE9\xA6\x3A\x36\x20\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
let oakley_2 =
(* 2^1024 - 2^960 - 1 + 2^64 * { [2^894 pi] + 129093 }. *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xC9\x0F\xDA\xA2\x21\x68\xC2\x34\
\xC4\xC6\x62\x8B\x80\xDC\x1C\xD1\x29\x02\x4E\x08\x8A\x67\xCC\x74\
\x02\x0B\xBE\xA6\x3B\x13\x9B\x22\x51\x4A\x08\x79\x8E\x34\x04\xDD\
\xEF\x95\x19\xB3\xCD\x3A\x43\x1B\x30\x2B\x0A\x6D\xF2\x5F\x14\x37\
\x4F\xE1\x35\x6D\x6D\x51\xC2\x45\xE4\x85\xB5\x76\x62\x5E\x7E\xC6\
\xF4\x4C\x42\xE9\xA6\x37\xED\x6B\x0B\xFF\x5C\xB6\xF4\x06\xB7\xED\
\xEE\x38\x6B\xFB\x5A\x89\x9F\xA5\xAE\x9F\x24\x11\x7C\x4B\x1F\xE6\
x49\x28\x66\x51\xEC\xE6\x53\x81\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
(* RFC3526 *)
let oakley_5 =
(* 2^1536 - 2^1472 - 1 + 2^64 * { [2^1406 pi] + 741804 } *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xC9\x0F\xDA\xA2\x21\x68\xC2\x34\
\xC4\xC6\x62\x8B\x80\xDC\x1C\xD1\x29\x02\x4E\x08\x8A\x67\xCC\x74\
\x02\x0B\xBE\xA6\x3B\x13\x9B\x22\x51\x4A\x08\x79\x8E\x34\x04\xDD\
\xEF\x95\x19\xB3\xCD\x3A\x43\x1B\x30\x2B\x0A\x6D\xF2\x5F\x14\x37\
\x4F\xE1\x35\x6D\x6D\x51\xC2\x45\xE4\x85\xB5\x76\x62\x5E\x7E\xC6\
\xF4\x4C\x42\xE9\xA6\x37\xED\x6B\x0B\xFF\x5C\xB6\xF4\x06\xB7\xED\
\xEE\x38\x6B\xFB\x5A\x89\x9F\xA5\xAE\x9F\x24\x11\x7C\x4B\x1F\xE6\
\x49\x28\x66\x51\xEC\xE4\x5B\x3D\xC2\x00\x7C\xB8\xA1\x63\xBF\x05\
\x98\xDA\x48\x36\x1C\x55\xD3\x9A\x69\x16\x3F\xA8\xFD\x24\xCF\x5F\
\x83\x65\x5D\x23\xDC\xA3\xAD\x96\x1C\x62\xF3\x56\x20\x85\x52\xBB\
\x9E\xD5\x29\x07\x70\x96\x96\x6D\x67\x0C\x35\x4E\x4A\xBC\x98\x04\
\xF1\x74\x6C\x08\xCA\x23\x73\x27\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
let oakley_14 =
(* 2^2048 - 2^1984 - 1 + 2^64 * { [2^1918 pi] + 124476 } *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xC9\x0F\xDA\xA2\x21\x68\xC2\x34\
\xC4\xC6\x62\x8B\x80\xDC\x1C\xD1\x29\x02\x4E\x08\x8A\x67\xCC\x74\
\x02\x0B\xBE\xA6\x3B\x13\x9B\x22\x51\x4A\x08\x79\x8E\x34\x04\xDD\
\xEF\x95\x19\xB3\xCD\x3A\x43\x1B\x30\x2B\x0A\x6D\xF2\x5F\x14\x37\
\x4F\xE1\x35\x6D\x6D\x51\xC2\x45\xE4\x85\xB5\x76\x62\x5E\x7E\xC6\
\xF4\x4C\x42\xE9\xA6\x37\xED\x6B\x0B\xFF\x5C\xB6\xF4\x06\xB7\xED\
\xEE\x38\x6B\xFB\x5A\x89\x9F\xA5\xAE\x9F\x24\x11\x7C\x4B\x1F\xE6\
\x49\x28\x66\x51\xEC\xE4\x5B\x3D\xC2\x00\x7C\xB8\xA1\x63\xBF\x05\
\x98\xDA\x48\x36\x1C\x55\xD3\x9A\x69\x16\x3F\xA8\xFD\x24\xCF\x5F\
\x83\x65\x5D\x23\xDC\xA3\xAD\x96\x1C\x62\xF3\x56\x20\x85\x52\xBB\
\x9E\xD5\x29\x07\x70\x96\x96\x6D\x67\x0C\x35\x4E\x4A\xBC\x98\x04\
\xF1\x74\x6C\x08\xCA\x18\x21\x7C\x32\x90\x5E\x46\x2E\x36\xCE\x3B\
\xE3\x9E\x77\x2C\x18\x0E\x86\x03\x9B\x27\x83\xA2\xEC\x07\xA2\x8F\
\xB5\xC5\x5D\xF0\x6F\x4C\x52\xC9\xDE\x2B\xCB\xF6\x95\x58\x17\x18\
\x39\x95\x49\x7C\xEA\x95\x6A\xE5\x15\xD2\x26\x18\x98\xFA\x05\x10\
\x15\x72\x8E\x5A\x8A\xAC\xAA\x68\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
let oakley_15 =
(* 2^3072 - 2^3008 - 1 + 2^64 * { [2^2942 pi] + 1690314 } *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xC9\x0F\xDA\xA2\x21\x68\xC2\x34\
\xC4\xC6\x62\x8B\x80\xDC\x1C\xD1\x29\x02\x4E\x08\x8A\x67\xCC\x74\
\x02\x0B\xBE\xA6\x3B\x13\x9B\x22\x51\x4A\x08\x79\x8E\x34\x04\xDD\
\xEF\x95\x19\xB3\xCD\x3A\x43\x1B\x30\x2B\x0A\x6D\xF2\x5F\x14\x37\
\x4F\xE1\x35\x6D\x6D\x51\xC2\x45\xE4\x85\xB5\x76\x62\x5E\x7E\xC6\
\xF4\x4C\x42\xE9\xA6\x37\xED\x6B\x0B\xFF\x5C\xB6\xF4\x06\xB7\xED\
\xEE\x38\x6B\xFB\x5A\x89\x9F\xA5\xAE\x9F\x24\x11\x7C\x4B\x1F\xE6\
\x49\x28\x66\x51\xEC\xE4\x5B\x3D\xC2\x00\x7C\xB8\xA1\x63\xBF\x05\
\x98\xDA\x48\x36\x1C\x55\xD3\x9A\x69\x16\x3F\xA8\xFD\x24\xCF\x5F\
\x83\x65\x5D\x23\xDC\xA3\xAD\x96\x1C\x62\xF3\x56\x20\x85\x52\xBB\
\x9E\xD5\x29\x07\x70\x96\x96\x6D\x67\x0C\x35\x4E\x4A\xBC\x98\x04\
\xF1\x74\x6C\x08\xCA\x18\x21\x7C\x32\x90\x5E\x46\x2E\x36\xCE\x3B\
\xE3\x9E\x77\x2C\x18\x0E\x86\x03\x9B\x27\x83\xA2\xEC\x07\xA2\x8F\
\xB5\xC5\x5D\xF0\x6F\x4C\x52\xC9\xDE\x2B\xCB\xF6\x95\x58\x17\x18\
\x39\x95\x49\x7C\xEA\x95\x6A\xE5\x15\xD2\x26\x18\x98\xFA\x05\x10\
\x15\x72\x8E\x5A\x8A\xAA\xC4\x2D\xAD\x33\x17\x0D\x04\x50\x7A\x33\
\xA8\x55\x21\xAB\xDF\x1C\xBA\x64\xEC\xFB\x85\x04\x58\xDB\xEF\x0A\
\x8A\xEA\x71\x57\x5D\x06\x0C\x7D\xB3\x97\x0F\x85\xA6\xE1\xE4\xC7\
\xAB\xF5\xAE\x8C\xDB\x09\x33\xD7\x1E\x8C\x94\xE0\x4A\x25\x61\x9D\
\xCE\xE3\xD2\x26\x1A\xD2\xEE\x6B\xF1\x2F\xFA\x06\xD9\x8A\x08\x64\
\xD8\x76\x02\x73\x3E\xC8\x6A\x64\x52\x1F\x2B\x18\x17\x7B\x20\x0C\
\xBB\xE1\x17\x57\x7A\x61\x5D\x6C\x77\x09\x88\xC0\xBA\xD9\x46\xE2\
\x08\xE2\x4F\xA0\x74\xE5\xAB\x31\x43\xDB\x5B\xFC\xE0\xFD\x10\x8E\
\x4B\x82\xD1\x20\xA9\x3A\xD2\xCA\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
let oakley_16 =
(* 2^4096 - 2^4032 - 1 + 2^64 * { [2^3966 pi] + 240904 } *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xC9\x0F\xDA\xA2\x21\x68\xC2\x34\
\xC4\xC6\x62\x8B\x80\xDC\x1C\xD1\x29\x02\x4E\x08\x8A\x67\xCC\x74\
\x02\x0B\xBE\xA6\x3B\x13\x9B\x22\x51\x4A\x08\x79\x8E\x34\x04\xDD\
\xEF\x95\x19\xB3\xCD\x3A\x43\x1B\x30\x2B\x0A\x6D\xF2\x5F\x14\x37\
\x4F\xE1\x35\x6D\x6D\x51\xC2\x45\xE4\x85\xB5\x76\x62\x5E\x7E\xC6\
\xF4\x4C\x42\xE9\xA6\x37\xED\x6B\x0B\xFF\x5C\xB6\xF4\x06\xB7\xED\
\xEE\x38\x6B\xFB\x5A\x89\x9F\xA5\xAE\x9F\x24\x11\x7C\x4B\x1F\xE6\
\x49\x28\x66\x51\xEC\xE4\x5B\x3D\xC2\x00\x7C\xB8\xA1\x63\xBF\x05\
\x98\xDA\x48\x36\x1C\x55\xD3\x9A\x69\x16\x3F\xA8\xFD\x24\xCF\x5F\
\x83\x65\x5D\x23\xDC\xA3\xAD\x96\x1C\x62\xF3\x56\x20\x85\x52\xBB\
\x9E\xD5\x29\x07\x70\x96\x96\x6D\x67\x0C\x35\x4E\x4A\xBC\x98\x04\
\xF1\x74\x6C\x08\xCA\x18\x21\x7C\x32\x90\x5E\x46\x2E\x36\xCE\x3B\
\xE3\x9E\x77\x2C\x18\x0E\x86\x03\x9B\x27\x83\xA2\xEC\x07\xA2\x8F\
\xB5\xC5\x5D\xF0\x6F\x4C\x52\xC9\xDE\x2B\xCB\xF6\x95\x58\x17\x18\
\x39\x95\x49\x7C\xEA\x95\x6A\xE5\x15\xD2\x26\x18\x98\xFA\x05\x10\
\x15\x72\x8E\x5A\x8A\xAA\xC4\x2D\xAD\x33\x17\x0D\x04\x50\x7A\x33\
\xA8\x55\x21\xAB\xDF\x1C\xBA\x64\xEC\xFB\x85\x04\x58\xDB\xEF\x0A\
\x8A\xEA\x71\x57\x5D\x06\x0C\x7D\xB3\x97\x0F\x85\xA6\xE1\xE4\xC7\
\xAB\xF5\xAE\x8C\xDB\x09\x33\xD7\x1E\x8C\x94\xE0\x4A\x25\x61\x9D\
\xCE\xE3\xD2\x26\x1A\xD2\xEE\x6B\xF1\x2F\xFA\x06\xD9\x8A\x08\x64\
\xD8\x76\x02\x73\x3E\xC8\x6A\x64\x52\x1F\x2B\x18\x17\x7B\x20\x0C\
\xBB\xE1\x17\x57\x7A\x61\x5D\x6C\x77\x09\x88\xC0\xBA\xD9\x46\xE2\
\x08\xE2\x4F\xA0\x74\xE5\xAB\x31\x43\xDB\x5B\xFC\xE0\xFD\x10\x8E\
\x4B\x82\xD1\x20\xA9\x21\x08\x01\x1A\x72\x3C\x12\xA7\x87\xE6\xD7\
\x88\x71\x9A\x10\xBD\xBA\x5B\x26\x99\xC3\x27\x18\x6A\xF4\xE2\x3C\
\x1A\x94\x68\x34\xB6\x15\x0B\xDA\x25\x83\xE9\xCA\x2A\xD4\x4C\xE8\
\xDB\xBB\xC2\xDB\x04\xDE\x8E\xF9\x2E\x8E\xFC\x14\x1F\xBE\xCA\xA6\
\x28\x7C\x59\x47\x4E\x6B\xC0\x5D\x99\xB2\x96\x4F\xA0\x90\xC3\xA2\
\x23\x3B\xA1\x86\x51\x5B\xE7\xED\x1F\x61\x29\x70\xCE\xE2\xD7\xAF\
\xB8\x1B\xDD\x76\x21\x70\x48\x1C\xD0\x06\x91\x27\xD5\xB0\x5A\xA9\
\x93\xB4\xEA\x98\x8D\x8F\xDD\xC1\x86\xFF\xB7\xDC\x90\xA6\xC0\x8F\
\x4D\xF4\x35\xC9\x34\x06\x31\x99\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
let oakley_17 =
(* 2^6144 - 2^6080 - 1 + 2^64 * { [2^6014 pi] + 929484 } *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xC9\x0F\xDA\xA2\x21\x68\xC2\x34\
\xC4\xC6\x62\x8B\x80\xDC\x1C\xD1\x29\x02\x4E\x08\x8A\x67\xCC\x74\
\x02\x0B\xBE\xA6\x3B\x13\x9B\x22\x51\x4A\x08\x79\x8E\x34\x04\xDD\
\xEF\x95\x19\xB3\xCD\x3A\x43\x1B\x30\x2B\x0A\x6D\xF2\x5F\x14\x37\
\x4F\xE1\x35\x6D\x6D\x51\xC2\x45\xE4\x85\xB5\x76\x62\x5E\x7E\xC6\
\xF4\x4C\x42\xE9\xA6\x37\xED\x6B\x0B\xFF\x5C\xB6\xF4\x06\xB7\xED\
\xEE\x38\x6B\xFB\x5A\x89\x9F\xA5\xAE\x9F\x24\x11\x7C\x4B\x1F\xE6\
\x49\x28\x66\x51\xEC\xE4\x5B\x3D\xC2\x00\x7C\xB8\xA1\x63\xBF\x05\
\x98\xDA\x48\x36\x1C\x55\xD3\x9A\x69\x16\x3F\xA8\xFD\x24\xCF\x5F\
\x83\x65\x5D\x23\xDC\xA3\xAD\x96\x1C\x62\xF3\x56\x20\x85\x52\xBB\
\x9E\xD5\x29\x07\x70\x96\x96\x6D\x67\x0C\x35\x4E\x4A\xBC\x98\x04\
\xF1\x74\x6C\x08\xCA\x18\x21\x7C\x32\x90\x5E\x46\x2E\x36\xCE\x3B\
\xE3\x9E\x77\x2C\x18\x0E\x86\x03\x9B\x27\x83\xA2\xEC\x07\xA2\x8F\
\xB5\xC5\x5D\xF0\x6F\x4C\x52\xC9\xDE\x2B\xCB\xF6\x95\x58\x17\x18\
\x39\x95\x49\x7C\xEA\x95\x6A\xE5\x15\xD2\x26\x18\x98\xFA\x05\x10\
\x15\x72\x8E\x5A\x8A\xAA\xC4\x2D\xAD\x33\x17\x0D\x04\x50\x7A\x33\
\xA8\x55\x21\xAB\xDF\x1C\xBA\x64\xEC\xFB\x85\x04\x58\xDB\xEF\x0A\
\x8A\xEA\x71\x57\x5D\x06\x0C\x7D\xB3\x97\x0F\x85\xA6\xE1\xE4\xC7\
\xAB\xF5\xAE\x8C\xDB\x09\x33\xD7\x1E\x8C\x94\xE0\x4A\x25\x61\x9D\
\xCE\xE3\xD2\x26\x1A\xD2\xEE\x6B\xF1\x2F\xFA\x06\xD9\x8A\x08\x64\
\xD8\x76\x02\x73\x3E\xC8\x6A\x64\x52\x1F\x2B\x18\x17\x7B\x20\x0C\
\xBB\xE1\x17\x57\x7A\x61\x5D\x6C\x77\x09\x88\xC0\xBA\xD9\x46\xE2\
\x08\xE2\x4F\xA0\x74\xE5\xAB\x31\x43\xDB\x5B\xFC\xE0\xFD\x10\x8E\
\x4B\x82\xD1\x20\xA9\x21\x08\x01\x1A\x72\x3C\x12\xA7\x87\xE6\xD7\
\x88\x71\x9A\x10\xBD\xBA\x5B\x26\x99\xC3\x27\x18\x6A\xF4\xE2\x3C\
\x1A\x94\x68\x34\xB6\x15\x0B\xDA\x25\x83\xE9\xCA\x2A\xD4\x4C\xE8\
\xDB\xBB\xC2\xDB\x04\xDE\x8E\xF9\x2E\x8E\xFC\x14\x1F\xBE\xCA\xA6\
\x28\x7C\x59\x47\x4E\x6B\xC0\x5D\x99\xB2\x96\x4F\xA0\x90\xC3\xA2\
\x23\x3B\xA1\x86\x51\x5B\xE7\xED\x1F\x61\x29\x70\xCE\xE2\xD7\xAF\
\xB8\x1B\xDD\x76\x21\x70\x48\x1C\xD0\x06\x91\x27\xD5\xB0\x5A\xA9\
\x93\xB4\xEA\x98\x8D\x8F\xDD\xC1\x86\xFF\xB7\xDC\x90\xA6\xC0\x8F\
\x4D\xF4\x35\xC9\x34\x02\x84\x92\x36\xC3\xFA\xB4\xD2\x7C\x70\x26\
\xC1\xD4\xDC\xB2\x60\x26\x46\xDE\xC9\x75\x1E\x76\x3D\xBA\x37\xBD\
\xF8\xFF\x94\x06\xAD\x9E\x53\x0E\xE5\xDB\x38\x2F\x41\x30\x01\xAE\
\xB0\x6A\x53\xED\x90\x27\xD8\x31\x17\x97\x27\xB0\x86\x5A\x89\x18\
\xDA\x3E\xDB\xEB\xCF\x9B\x14\xED\x44\xCE\x6C\xBA\xCE\xD4\xBB\x1B\
\xDB\x7F\x14\x47\xE6\xCC\x25\x4B\x33\x20\x51\x51\x2B\xD7\xAF\x42\
\x6F\xB8\xF4\x01\x37\x8C\xD2\xBF\x59\x83\xCA\x01\xC6\x4B\x92\xEC\
\xF0\x32\xEA\x15\xD1\x72\x1D\x03\xF4\x82\xD7\xCE\x6E\x74\xFE\xF6\
\xD5\x5E\x70\x2F\x46\x98\x0C\x82\xB5\xA8\x40\x31\x90\x0B\x1C\x9E\
\x59\xE7\xC9\x7F\xBE\xC7\xE8\xF3\x23\xA9\x7A\x7E\x36\xCC\x88\xBE\
\x0F\x1D\x45\xB7\xFF\x58\x5A\xC5\x4B\xD4\x07\xB2\x2B\x41\x54\xAA\
\xCC\x8F\x6D\x7E\xBF\x48\xE1\xD8\x14\xCC\x5E\xD2\x0F\x80\x37\xE0\
\xA7\x97\x15\xEE\xF2\x9B\xE3\x28\x06\xA1\xD5\x8B\xB7\xC5\xDA\x76\
\xF5\x50\xAA\x3D\x8A\x1F\xBF\xF0\xEB\x19\xCC\xB1\xA3\x13\xD5\x5C\
\xDA\x56\xC9\xEC\x2E\xF2\x96\x32\x38\x7F\xE8\xD7\x6E\x3C\x04\x68\
\x04\x3E\x8F\x66\x3F\x48\x60\xEE\x12\xBF\x2D\x5B\x0B\x74\x74\xD6\
\xE6\x94\xF9\x1E\x6D\xCC\x40\x24\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
let oakley_18 =
(* 2^8192 - 2^8128 - 1 + 2^64 * { [2^8062 pi] + 4743158 } *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xC9\x0F\xDA\xA2\x21\x68\xC2\x34\
\xC4\xC6\x62\x8B\x80\xDC\x1C\xD1\x29\x02\x4E\x08\x8A\x67\xCC\x74\
\x02\x0B\xBE\xA6\x3B\x13\x9B\x22\x51\x4A\x08\x79\x8E\x34\x04\xDD\
\xEF\x95\x19\xB3\xCD\x3A\x43\x1B\x30\x2B\x0A\x6D\xF2\x5F\x14\x37\
\x4F\xE1\x35\x6D\x6D\x51\xC2\x45\xE4\x85\xB5\x76\x62\x5E\x7E\xC6\
\xF4\x4C\x42\xE9\xA6\x37\xED\x6B\x0B\xFF\x5C\xB6\xF4\x06\xB7\xED\
\xEE\x38\x6B\xFB\x5A\x89\x9F\xA5\xAE\x9F\x24\x11\x7C\x4B\x1F\xE6\
\x49\x28\x66\x51\xEC\xE4\x5B\x3D\xC2\x00\x7C\xB8\xA1\x63\xBF\x05\
\x98\xDA\x48\x36\x1C\x55\xD3\x9A\x69\x16\x3F\xA8\xFD\x24\xCF\x5F\
\x83\x65\x5D\x23\xDC\xA3\xAD\x96\x1C\x62\xF3\x56\x20\x85\x52\xBB\
\x9E\xD5\x29\x07\x70\x96\x96\x6D\x67\x0C\x35\x4E\x4A\xBC\x98\x04\
\xF1\x74\x6C\x08\xCA\x18\x21\x7C\x32\x90\x5E\x46\x2E\x36\xCE\x3B\
\xE3\x9E\x77\x2C\x18\x0E\x86\x03\x9B\x27\x83\xA2\xEC\x07\xA2\x8F\
\xB5\xC5\x5D\xF0\x6F\x4C\x52\xC9\xDE\x2B\xCB\xF6\x95\x58\x17\x18\
\x39\x95\x49\x7C\xEA\x95\x6A\xE5\x15\xD2\x26\x18\x98\xFA\x05\x10\
\x15\x72\x8E\x5A\x8A\xAA\xC4\x2D\xAD\x33\x17\x0D\x04\x50\x7A\x33\
\xA8\x55\x21\xAB\xDF\x1C\xBA\x64\xEC\xFB\x85\x04\x58\xDB\xEF\x0A\
\x8A\xEA\x71\x57\x5D\x06\x0C\x7D\xB3\x97\x0F\x85\xA6\xE1\xE4\xC7\
\xAB\xF5\xAE\x8C\xDB\x09\x33\xD7\x1E\x8C\x94\xE0\x4A\x25\x61\x9D\
\xCE\xE3\xD2\x26\x1A\xD2\xEE\x6B\xF1\x2F\xFA\x06\xD9\x8A\x08\x64\
\xD8\x76\x02\x73\x3E\xC8\x6A\x64\x52\x1F\x2B\x18\x17\x7B\x20\x0C\
\xBB\xE1\x17\x57\x7A\x61\x5D\x6C\x77\x09\x88\xC0\xBA\xD9\x46\xE2\
\x08\xE2\x4F\xA0\x74\xE5\xAB\x31\x43\xDB\x5B\xFC\xE0\xFD\x10\x8E\
\x4B\x82\xD1\x20\xA9\x21\x08\x01\x1A\x72\x3C\x12\xA7\x87\xE6\xD7\
\x88\x71\x9A\x10\xBD\xBA\x5B\x26\x99\xC3\x27\x18\x6A\xF4\xE2\x3C\
\x1A\x94\x68\x34\xB6\x15\x0B\xDA\x25\x83\xE9\xCA\x2A\xD4\x4C\xE8\
\xDB\xBB\xC2\xDB\x04\xDE\x8E\xF9\x2E\x8E\xFC\x14\x1F\xBE\xCA\xA6\
\x28\x7C\x59\x47\x4E\x6B\xC0\x5D\x99\xB2\x96\x4F\xA0\x90\xC3\xA2\
\x23\x3B\xA1\x86\x51\x5B\xE7\xED\x1F\x61\x29\x70\xCE\xE2\xD7\xAF\
\xB8\x1B\xDD\x76\x21\x70\x48\x1C\xD0\x06\x91\x27\xD5\xB0\x5A\xA9\
\x93\xB4\xEA\x98\x8D\x8F\xDD\xC1\x86\xFF\xB7\xDC\x90\xA6\xC0\x8F\
\x4D\xF4\x35\xC9\x34\x02\x84\x92\x36\xC3\xFA\xB4\xD2\x7C\x70\x26\
\xC1\xD4\xDC\xB2\x60\x26\x46\xDE\xC9\x75\x1E\x76\x3D\xBA\x37\xBD\
\xF8\xFF\x94\x06\xAD\x9E\x53\x0E\xE5\xDB\x38\x2F\x41\x30\x01\xAE\
\xB0\x6A\x53\xED\x90\x27\xD8\x31\x17\x97\x27\xB0\x86\x5A\x89\x18\
\xDA\x3E\xDB\xEB\xCF\x9B\x14\xED\x44\xCE\x6C\xBA\xCE\xD4\xBB\x1B\
\xDB\x7F\x14\x47\xE6\xCC\x25\x4B\x33\x20\x51\x51\x2B\xD7\xAF\x42\
\x6F\xB8\xF4\x01\x37\x8C\xD2\xBF\x59\x83\xCA\x01\xC6\x4B\x92\xEC\
\xF0\x32\xEA\x15\xD1\x72\x1D\x03\xF4\x82\xD7\xCE\x6E\x74\xFE\xF6\
\xD5\x5E\x70\x2F\x46\x98\x0C\x82\xB5\xA8\x40\x31\x90\x0B\x1C\x9E\
\x59\xE7\xC9\x7F\xBE\xC7\xE8\xF3\x23\xA9\x7A\x7E\x36\xCC\x88\xBE\
\x0F\x1D\x45\xB7\xFF\x58\x5A\xC5\x4B\xD4\x07\xB2\x2B\x41\x54\xAA\
\xCC\x8F\x6D\x7E\xBF\x48\xE1\xD8\x14\xCC\x5E\xD2\x0F\x80\x37\xE0\
\xA7\x97\x15\xEE\xF2\x9B\xE3\x28\x06\xA1\xD5\x8B\xB7\xC5\xDA\x76\
\xF5\x50\xAA\x3D\x8A\x1F\xBF\xF0\xEB\x19\xCC\xB1\xA3\x13\xD5\x5C\
\xDA\x56\xC9\xEC\x2E\xF2\x96\x32\x38\x7F\xE8\xD7\x6E\x3C\x04\x68\
\x04\x3E\x8F\x66\x3F\x48\x60\xEE\x12\xBF\x2D\x5B\x0B\x74\x74\xD6\
\xE6\x94\xF9\x1E\x6D\xBE\x11\x59\x74\xA3\x92\x6F\x12\xFE\xE5\xE4\
\x38\x77\x7C\xB6\xA9\x32\xDF\x8C\xD8\xBE\xC4\xD0\x73\xB9\x31\xBA\
\x3B\xC8\x32\xB6\x8D\x9D\xD3\x00\x74\x1F\xA7\xBF\x8A\xFC\x47\xED\
\x25\x76\xF6\x93\x6B\xA4\x24\x66\x3A\xAB\x63\x9C\x5A\xE4\xF5\x68\
\x34\x23\xB4\x74\x2B\xF1\xC9\x78\x23\x8F\x16\xCB\xE3\x9D\x65\x2D\
\xE3\xFD\xB8\xBE\xFC\x84\x8A\xD9\x22\x22\x2E\x04\xA4\x03\x7C\x07\
\x13\xEB\x57\xA8\x1A\x23\xF0\xC7\x34\x73\xFC\x64\x6C\xEA\x30\x6B\
\x4B\xCB\xC8\x86\x2F\x83\x85\xDD\xFA\x9D\x4B\x7F\xA2\xC0\x87\xE8\
\x79\x68\x33\x03\xED\x5B\xDD\x3A\x06\x2B\x3C\xF5\xB3\xA2\x78\xA6\
\x6D\x2A\x13\xF8\x3F\x44\xF8\x2D\xDF\x31\x0E\xE0\x74\xAB\x6A\x36\
\x45\x97\xE8\x99\xA0\x25\x5D\xC1\x64\xF3\x1C\xC5\x08\x46\x85\x1D\
\xF9\xAB\x48\x19\x5D\xED\x7E\xA1\xB1\xD5\x10\xBD\x7E\xE7\x4D\x73\
\xFA\xF3\x6B\xC3\x1E\xCF\xA2\x68\x35\x90\x46\xF4\xEB\x87\x9F\x92\
\x40\x09\x43\x8B\x48\x1C\x6C\xD7\x88\x9A\x00\x2E\xD5\xEE\x38\x2B\
\xC9\x19\x0D\xA6\xFC\x02\x6E\x47\x95\x58\xE4\x47\x56\x77\xE9\xAA\
\x9E\x30\x50\xE2\x76\x56\x94\xDF\xC8\x1F\x56\xE8\x80\xB9\x6E\x71\
\x60\xC9\x80\xDD\x98\xED\xD3\xDF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
(* RFC5114 *)
(* 1024-bit, 160-bit subgroup *)
let rfc_5114_1 =
let p =
"\xB1\x0B\x8F\x96\xA0\x80\xE0\x1D\xDE\x92\xDE\x5E\xAE\x5D\x54\xEC\
\x52\xC9\x9F\xBC\xFB\x06\xA3\xC6\x9A\x6A\x9D\xCA\x52\xD2\x3B\x61\
\x60\x73\xE2\x86\x75\xA2\x3D\x18\x98\x38\xEF\x1E\x2E\xE6\x52\xC0\
\x13\xEC\xB4\xAE\xA9\x06\x11\x23\x24\x97\x5C\x3C\xD4\x9B\x83\xBF\
\xAC\xCB\xDD\x7D\x90\xC4\xBD\x70\x98\x48\x8E\x9C\x21\x9A\x73\x72\
\x4E\xFF\xD6\xFA\xE5\x64\x47\x38\xFA\xA3\x1A\x4F\xF5\x5B\xCC\xC0\
\xA1\x51\xAF\x5F\x0D\xC8\xB4\xBD\x45\xBF\x37\xDF\x36\x5C\x1A\x65\
\xE6\x8C\xFD\xA7\x6D\x4D\xA7\x08\xDF\x1F\xB2\xBC\x2E\x4A\x43\x71"
and gg =
"\xA4\xD1\xCB\xD5\xC3\xFD\x34\x12\x67\x65\xA4\x42\xEF\xB9\x99\x05\
\xF8\x10\x4D\xD2\x58\xAC\x50\x7F\xD6\x40\x6C\xFF\x14\x26\x6D\x31\
\x26\x6F\xEA\x1E\x5C\x41\x56\x4B\x77\x7E\x69\x0F\x55\x04\xF2\x13\
\x16\x02\x17\xB4\xB0\x1B\x88\x6A\x5E\x91\x54\x7F\x9E\x27\x49\xF4\
\xD7\xFB\xD7\xD3\xB9\xA9\x2E\xE1\x90\x9D\x0D\x22\x63\xF8\x0A\x76\
\xA6\xA2\x4C\x08\x7A\x09\x1F\x53\x1D\xBF\x0A\x01\x69\xB6\xA2\x8A\
\xD6\x62\xA4\xD1\x8E\x73\xAF\xA3\x2D\x77\x9D\x59\x18\xD0\x8B\xC8\
\x85\x8F\x4D\xCE\xF9\x7C\x2A\x24\\x85\x5E\x6E\xEB\x22\xB3\xB2\xE5"
and q =
"\xF5\x18\xAA\x87\x81\xA8\xDF\x27\x8A\xBA\x4E\x7D\x64\xB7\xCB\x9D\
\x49\x46\x23\x53"
in
group ~p ~gg ~q
(* 2048-bit, 224-bit subgroup *)
let rfc_5114_2 =
let p =
"\xAD\x10\x7E\x1E\x91\x23\xA9\xD0\xD6\x60\xFA\xA7\x95\x59\xC5\x1F\
\xA2\x0D\x64\xE5\x68\x3B\x9F\xD1\xB5\x4B\x15\x97\xB6\x1D\x0A\x75\
\xE6\xFA\x14\x1D\xF9\x5A\x56\xDB\xAF\x9A\x3C\x40\x7B\xA1\xDF\x15\
\xEB\x3D\x68\x8A\x30\x9C\x18\x0E\x1D\xE6\xB8\x5A\x12\x74\xA0\xA6\
\x6D\x3F\x81\x52\xAD\x6A\xC2\x12\x90\x37\xC9\xED\xEF\xDA\x4D\xF8\
\xD9\x1E\x8F\xEF\x55\xB7\x39\x4B\x7A\xD5\xB7\xD0\xB6\xC1\x22\x07\
\xC9\xF9\x8D\x11\xED\x34\xDB\xF6\xC6\xBA\x0B\x2C\x8B\xBC\x27\xBE\
\x6A\x00\xE0\xA0\xB9\xC4\x97\x08\xB3\xBF\x8A\x31\x70\x91\x88\x36\
\x81\x28\x61\x30\xBC\x89\x85\xDB\x16\x02\xE7\x14\x41\x5D\x93\x30\
\x27\x82\x73\xC7\xDE\x31\xEF\xDC\x73\x10\xF7\x12\x1F\xD5\xA0\x74\
\x15\x98\x7D\x9A\xDC\x0A\x48\x6D\xCD\xF9\x3A\xCC\x44\x32\x83\x87\
\x31\x5D\x75\xE1\x98\xC6\x41\xA4\x80\xCD\x86\xA1\xB9\xE5\x87\xE8\
\xBE\x60\xE6\x9C\xC9\x28\xB2\xB9\xC5\x21\x72\xE4\x13\x04\x2E\x9B\
\x23\xF1\x0B\x0E\x16\xE7\x97\x63\xC9\xB5\x3D\xCF\x4B\xA8\x0A\x29\
\xE3\xFB\x73\xC1\x6B\x8E\x75\xB9\x7E\xF3\x63\xE2\xFF\xA3\x1F\x71\
\xCF\x9D\xE5\x38\x4E\x71\xB8\x1C\x0A\xC4\xDF\xFE\x0C\x10\xE6\x4F"
and gg =
"\xAC\x40\x32\xEF\x4F\x2D\x9A\xE3\x9D\xF3\x0B\x5C\x8F\xFD\xAC\x50\
\x6C\xDE\xBE\x7B\x89\x99\x8C\xAF\x74\x86\x6A\x08\xCF\xE4\xFF\xE3\
\xA6\x82\x4A\x4E\x10\xB9\xA6\xF0\xDD\x92\x1F\x01\xA7\x0C\x4A\xFA\
\xAB\x73\x9D\x77\x00\xC2\x9F\x52\xC5\x7D\xB1\x7C\x62\x0A\x86\x52\
\xBE\x5E\x90\x01\xA8\xD6\x6A\xD7\xC1\x76\x69\x10\x19\x99\x02\x4A\
\xF4\xD0\x27\x27\x5A\xC1\x34\x8B\xB8\xA7\x62\xD0\x52\x1B\xC9\x8A\
\xE2\x47\x15\x04\x22\xEA\x1E\xD4\x09\x93\x9D\x54\xDA\x74\x60\xCD\
\xB5\xF6\xC6\xB2\x50\x71\x7C\xBE\xF1\x80\xEB\x34\x11\x8E\x98\xD1\
\x19\x52\x9A\x45\xD6\xF8\x34\x56\x6E\x30\x25\xE3\x16\xA3\x30\xEF\
\xBB\x77\xA8\x6F\x0C\x1A\xB1\x5B\x05\x1A\xE3\xD4\x28\xC8\xF8\xAC\
\xB7\x0A\x81\x37\x15\x0B\x8E\xEB\x10\xE1\x83\xED\xD1\x99\x63\xDD\
\xD9\xE2\x63\xE4\x77\x05\x89\xEF\x6A\xA2\x1E\x7F\x5F\x2F\xF3\x81\
\xB5\x39\xCC\xE3\x40\x9D\x13\xCD\x56\x6A\xFB\xB4\x8D\x6C\x01\x91\
\x81\xE1\xBC\xFE\x94\xB3\x02\x69\xED\xFE\x72\xFE\x9B\x6A\xA4\xBD\
\x7B\x5A\x0F\x1C\x71\xCF\xFF\x4C\x19\xC4\x18\xE1\xF6\xEC\x01\x79\
\x81\xBC\x08\x7F\x2A\x70\x65\xB3\x84\xB8\x90\xD3\x19\x1F\x2B\xFA"
and q =
"\x80\x1C\x0D\x34\xC5\x8D\x93\xFE\x99\x71\x77\x10\x1F\x80\x53\x5A\
\x47\x38\xCE\xBC\xBF\x38\x9A\x99\xB3\x63\x71\xEB"
in
group ~p ~gg ~q
(* 2048-bit, 256-bit subgroup *)
let rfc_5114_3 =
let p =
"\x87\xA8\xE6\x1D\xB4\xB6\x66\x3C\xFF\xBB\xD1\x9C\x65\x19\x59\x99\
\x8C\xEE\xF6\x08\x66\x0D\xD0\xF2\x5D\x2C\xEE\xD4\x43\x5E\x3B\x00\
\xE0\x0D\xF8\xF1\xD6\x19\x57\xD4\xFA\xF7\xDF\x45\x61\xB2\xAA\x30\
\x16\xC3\xD9\x11\x34\x09\x6F\xAA\x3B\xF4\x29\x6D\x83\x0E\x9A\x7C\
\x20\x9E\x0C\x64\x97\x51\x7A\xBD\x5A\x8A\x9D\x30\x6B\xCF\x67\xED\
\x91\xF9\xE6\x72\x5B\x47\x58\xC0\x22\xE0\xB1\xEF\x42\x75\xBF\x7B\
\x6C\x5B\xFC\x11\xD4\x5F\x90\x88\xB9\x41\xF5\x4E\xB1\xE5\x9B\xB8\
\xBC\x39\xA0\xBF\x12\x30\x7F\x5C\x4F\xDB\x70\xC5\x81\xB2\x3F\x76\
\xB6\x3A\xCA\xE1\xCA\xA6\xB7\x90\x2D\x52\x52\x67\x35\x48\x8A\x0E\
\xF1\x3C\x6D\x9A\x51\xBF\xA4\xAB\x3A\xD8\x34\x77\x96\x52\x4D\x8E\
\xF6\xA1\x67\xB5\xA4\x18\x25\xD9\x67\xE1\x44\xE5\x14\x05\x64\x25\
\x1C\xCA\xCB\x83\xE6\xB4\x86\xF6\xB3\xCA\x3F\x79\x71\x50\x60\x26\
\xC0\xB8\x57\xF6\x89\x96\x28\x56\xDE\xD4\x01\x0A\xBD\x0B\xE6\x21\
\xC3\xA3\x96\x0A\x54\xE7\x10\xC3\x75\xF2\x63\x75\xD7\x01\x41\x03\
\xA4\xB5\x43\x30\xC1\x98\xAF\x12\x61\x16\xD2\x27\x6E\x11\x71\x5F\
\x69\x38\x77\xFA\xD7\xEF\x09\xCA\xDB\x09\x4A\xE9\x1E\x1A\x15\x97"
and gg =
"\x3F\xB3\x2C\x9B\x73\x13\x4D\x0B\x2E\x77\x50\x66\x60\xED\xBD\x48\
\x4C\xA7\xB1\x8F\x21\xEF\x20\x54\x07\xF4\x79\x3A\x1A\x0B\xA1\x25\
\x10\xDB\xC1\x50\x77\xBE\x46\x3F\xFF\x4F\xED\x4A\xAC\x0B\xB5\x55\
\xBE\x3A\x6C\x1B\x0C\x6B\x47\xB1\xBC\x37\x73\xBF\x7E\x8C\x6F\x62\
\x90\x12\x28\xF8\xC2\x8C\xBB\x18\xA5\x5A\xE3\x13\x41\x00\x0A\x65\
\x01\x96\xF9\x31\xC7\x7A\x57\xF2\xDD\xF4\x63\xE5\xE9\xEC\x14\x4B\
\x77\x7D\xE6\x2A\xAA\xB8\xA8\x62\x8A\xC3\x76\xD2\x82\xD6\xED\x38\
\x64\xE6\x79\x82\x42\x8E\xBC\x83\x1D\x14\x34\x8F\x6F\x2F\x91\x93\
\xB5\x04\x5A\xF2\x76\x71\x64\xE1\xDF\xC9\x67\xC1\xFB\x3F\x2E\x55\
\xA4\xBD\x1B\xFF\xE8\x3B\x9C\x80\xD0\x52\xB9\x85\xD1\x82\xEA\x0A\
\xDB\x2A\x3B\x73\x13\xD3\xFE\x14\xC8\x48\x4B\x1E\x05\x25\x88\xB9\
\xB7\xD2\xBB\xD2\xDF\x01\x61\x99\xEC\xD0\x6E\x15\x57\xCD\x09\x15\
\xB3\x35\x3B\xBB\x64\xE0\xEC\x37\x7F\xD0\x28\x37\x0D\xF9\x2B\x52\
\xC7\x89\x14\x28\xCD\xC6\x7E\xB6\x18\x4B\x52\x3D\x1D\xB2\x46\xC3\
\x2F\x63\x07\x84\x90\xF0\x0E\xF8\xD6\x47\xD1\x48\xD4\x79\x54\x51\
\x5E\x23\x27\xCF\xEF\x98\xC5\x82\x66\x4B\x4C\x0F\x6C\xC4\x16\x59"
and q =
"\x8C\xF8\x36\x42\xA7\x09\xA0\x97\xB4\x47\x99\x76\x40\x12\x9D\xA2\
\x99\xB1\xA4\x7D\x1E\xB3\x75\x0B\xA3\x08\xB0\xFE\x64\xF5\xFB\xD3"
in
group ~p ~gg ~q
(* draft-ietf-tls-negotiated-ff-dhe-08 *)
let ffdhe2048 =
(* p = 2^2048 - 2^1984 + {[2^1918 * e] + 560316 } * 2^64 - 1 *)
(* The estimated symmetric-equivalent strength of this group is 103 bits.
Peers using ffdhe2048 that want to optimize their key exchange with a
short exponent (Section 5.2) should choose a secret key of at least
225 bits. *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xAD\xF8\x54\x58\xA2\xBB\x4A\x9A\
\xAF\xDC\x56\x20\x27\x3D\x3C\xF1\xD8\xB9\xC5\x83\xCE\x2D\x36\x95\
\xA9\xE1\x36\x41\x14\x64\x33\xFB\xCC\x93\x9D\xCE\x24\x9B\x3E\xF9\
\x7D\x2F\xE3\x63\x63\x0C\x75\xD8\xF6\x81\xB2\x02\xAE\xC4\x61\x7A\
\xD3\xDF\x1E\xD5\xD5\xFD\x65\x61\x24\x33\xF5\x1F\x5F\x06\x6E\xD0\
\x85\x63\x65\x55\x3D\xED\x1A\xF3\xB5\x57\x13\x5E\x7F\x57\xC9\x35\
\x98\x4F\x0C\x70\xE0\xE6\x8B\x77\xE2\xA6\x89\xDA\xF3\xEF\xE8\x72\
\x1D\xF1\x58\xA1\x36\xAD\xE7\x35\x30\xAC\xCA\x4F\x48\x3A\x79\x7A\
\xBC\x0A\xB1\x82\xB3\x24\xFB\x61\xD1\x08\xA9\x4B\xB2\xC8\xE3\xFB\
\xB9\x6A\xDA\xB7\x60\xD7\xF4\x68\x1D\x4F\x42\xA3\xDE\x39\x4D\xF4\
\xAE\x56\xED\xE7\x63\x72\xBB\x19\x0B\x07\xA7\xC8\xEE\x0A\x6D\x70\
\x9E\x02\xFC\xE1\xCD\xF7\xE2\xEC\xC0\x34\x04\xCD\x28\x34\x2F\x61\
\x91\x72\xFE\x9C\xE9\x85\x83\xFF\x8E\x4F\x12\x32\xEE\xF2\x81\x83\
\xC3\xFE\x3B\x1B\x4C\x6F\xAD\x73\x3B\xB5\xFC\xBC\x2E\xC2\x20\x05\
\xC5\x8E\xF1\x83\x7D\x16\x83\xB2\xC6\xF3\x4A\x26\xC1\xB2\xEF\xFA\
\x88\x6B\x42\x38\x61\x28\x5C\x97\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
let ffdhe3072 =
(* p = 2^3072 - 2^3008 + {[2^2942 * e] + 2625351} * 2^64 -1 *)
(* The estimated symmetric-equivalent strength of this group is 125 bits.
Peers using ffdhe3072 that want to optimize their key exchange with a
short exponent (Section 5.2) should choose a secret key of at least
275 bits. *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xAD\xF8\x54\x58\xA2\xBB\x4A\x9A\
\xAF\xDC\x56\x20\x27\x3D\x3C\xF1\xD8\xB9\xC5\x83\xCE\x2D\x36\x95\
\xA9\xE1\x36\x41\x14\x64\x33\xFB\xCC\x93\x9D\xCE\x24\x9B\x3E\xF9\
\x7D\x2F\xE3\x63\x63\x0C\x75\xD8\xF6\x81\xB2\x02\xAE\xC4\x61\x7A\
\xD3\xDF\x1E\xD5\xD5\xFD\x65\x61\x24\x33\xF5\x1F\x5F\x06\x6E\xD0\
\x85\x63\x65\x55\x3D\xED\x1A\xF3\xB5\x57\x13\x5E\x7F\x57\xC9\x35\
\x98\x4F\x0C\x70\xE0\xE6\x8B\x77\xE2\xA6\x89\xDA\xF3\xEF\xE8\x72\
\x1D\xF1\x58\xA1\x36\xAD\xE7\x35\x30\xAC\xCA\x4F\x48\x3A\x79\x7A\
\xBC\x0A\xB1\x82\xB3\x24\xFB\x61\xD1\x08\xA9\x4B\xB2\xC8\xE3\xFB\
\xB9\x6A\xDA\xB7\x60\xD7\xF4\x68\x1D\x4F\x42\xA3\xDE\x39\x4D\xF4\
\xAE\x56\xED\xE7\x63\x72\xBB\x19\x0B\x07\xA7\xC8\xEE\x0A\x6D\x70\
\x9E\x02\xFC\xE1\xCD\xF7\xE2\xEC\xC0\x34\x04\xCD\x28\x34\x2F\x61\
\x91\x72\xFE\x9C\xE9\x85\x83\xFF\x8E\x4F\x12\x32\xEE\xF2\x81\x83\
\xC3\xFE\x3B\x1B\x4C\x6F\xAD\x73\x3B\xB5\xFC\xBC\x2E\xC2\x20\x05\
\xC5\x8E\xF1\x83\x7D\x16\x83\xB2\xC6\xF3\x4A\x26\xC1\xB2\xEF\xFA\
\x88\x6B\x42\x38\x61\x1F\xCF\xDC\xDE\x35\x5B\x3B\x65\x19\x03\x5B\
\xBC\x34\xF4\xDE\xF9\x9C\x02\x38\x61\xB4\x6F\xC9\xD6\xE6\xC9\x07\
\x7A\xD9\x1D\x26\x91\xF7\xF7\xEE\x59\x8C\xB0\xFA\xC1\x86\xD9\x1C\
\xAE\xFE\x13\x09\x85\x13\x92\x70\xB4\x13\x0C\x93\xBC\x43\x79\x44\
\xF4\xFD\x44\x52\xE2\xD7\x4D\xD3\x64\xF2\xE2\x1E\x71\xF5\x4B\xFF\
\x5C\xAE\x82\xAB\x9C\x9D\xF6\x9E\xE8\x6D\x2B\xC5\x22\x36\x3A\x0D\
\xAB\xC5\x21\x97\x9B\x0D\xEA\xDA\x1D\xBF\x9A\x42\xD5\xC4\x48\x4E\
\x0A\xBC\xD0\x6B\xFA\x53\xDD\xEF\x3C\x1B\x20\xEE\x3F\xD5\x9D\x7C\
\x25\xE4\x1D\x2B\x66\xC6\x2E\x37\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
let ffdhe4096 =
(* p = 2^4096 - 2^4032 + {[2^3966 * e] + 5736041} * 2^64 - 1 *)
(* The estimated symmetric-equivalent strength of this group is 150 bits.
Peers using ffdhe4096 that want to optimize their key exchange with a
short exponent (Section 5.2) should choose a secret key of at least
325 bits. *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xAD\xF8\x54\x58\xA2\xBB\x4A\x9A\
\xAF\xDC\x56\x20\x27\x3D\x3C\xF1\xD8\xB9\xC5\x83\xCE\x2D\x36\x95\
\xA9\xE1\x36\x41\x14\x64\x33\xFB\xCC\x93\x9D\xCE\x24\x9B\x3E\xF9\
\x7D\x2F\xE3\x63\x63\x0C\x75\xD8\xF6\x81\xB2\x02\xAE\xC4\x61\x7A\
\xD3\xDF\x1E\xD5\xD5\xFD\x65\x61\x24\x33\xF5\x1F\x5F\x06\x6E\xD0\
\x85\x63\x65\x55\x3D\xED\x1A\xF3\xB5\x57\x13\x5E\x7F\x57\xC9\x35\
\x98\x4F\x0C\x70\xE0\xE6\x8B\x77\xE2\xA6\x89\xDA\xF3\xEF\xE8\x72\
\x1D\xF1\x58\xA1\x36\xAD\xE7\x35\x30\xAC\xCA\x4F\x48\x3A\x79\x7A\
\xBC\x0A\xB1\x82\xB3\x24\xFB\x61\xD1\x08\xA9\x4B\xB2\xC8\xE3\xFB\
\xB9\x6A\xDA\xB7\x60\xD7\xF4\x68\x1D\x4F\x42\xA3\xDE\x39\x4D\xF4\
\xAE\x56\xED\xE7\x63\x72\xBB\x19\x0B\x07\xA7\xC8\xEE\x0A\x6D\x70\
\x9E\x02\xFC\xE1\xCD\xF7\xE2\xEC\xC0\x34\x04\xCD\x28\x34\x2F\x61\
\x91\x72\xFE\x9C\xE9\x85\x83\xFF\x8E\x4F\x12\x32\xEE\xF2\x81\x83\
\xC3\xFE\x3B\x1B\x4C\x6F\xAD\x73\x3B\xB5\xFC\xBC\x2E\xC2\x20\x05\
\xC5\x8E\xF1\x83\x7D\x16\x83\xB2\xC6\xF3\x4A\x26\xC1\xB2\xEF\xFA\
\x88\x6B\x42\x38\x61\x1F\xCF\xDC\xDE\x35\x5B\x3B\x65\x19\x03\x5B\
\xBC\x34\xF4\xDE\xF9\x9C\x02\x38\x61\xB4\x6F\xC9\xD6\xE6\xC9\x07\
\x7A\xD9\x1D\x26\x91\xF7\xF7\xEE\x59\x8C\xB0\xFA\xC1\x86\xD9\x1C\
\xAE\xFE\x13\x09\x85\x13\x92\x70\xB4\x13\x0C\x93\xBC\x43\x79\x44\
\xF4\xFD\x44\x52\xE2\xD7\x4D\xD3\x64\xF2\xE2\x1E\x71\xF5\x4B\xFF\
\x5C\xAE\x82\xAB\x9C\x9D\xF6\x9E\xE8\x6D\x2B\xC5\x22\x36\x3A\x0D\
\xAB\xC5\x21\x97\x9B\x0D\xEA\xDA\x1D\xBF\x9A\x42\xD5\xC4\x48\x4E\
\x0A\xBC\xD0\x6B\xFA\x53\xDD\xEF\x3C\x1B\x20\xEE\x3F\xD5\x9D\x7C\
\x25\xE4\x1D\x2B\x66\x9E\x1E\xF1\x6E\x6F\x52\xC3\x16\x4D\xF4\xFB\
\x79\x30\xE9\xE4\xE5\x88\x57\xB6\xAC\x7D\x5F\x42\xD6\x9F\x6D\x18\
\x77\x63\xCF\x1D\x55\x03\x40\x04\x87\xF5\x5B\xA5\x7E\x31\xCC\x7A\
\x71\x35\xC8\x86\xEF\xB4\x31\x8A\xED\x6A\x1E\x01\x2D\x9E\x68\x32\
\xA9\x07\x60\x0A\x91\x81\x30\xC4\x6D\xC7\x78\xF9\x71\xAD\x00\x38\
\x09\x29\x99\xA3\x33\xCB\x8B\x7A\x1A\x1D\xB9\x3D\x71\x40\x00\x3C\
\x2A\x4E\xCE\xA9\xF9\x8D\x0A\xCC\x0A\x82\x91\xCD\xCE\xC9\x7D\xCF\
\x8E\xC9\xB5\x5A\x7F\x88\xA4\x6B\x4D\xB5\xA8\x51\xF4\x41\x82\xE1\
\xC6\x8A\x00\x7E\x5E\x65\x5F\x6A\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
let ffdhe6144 =
(* p = 2^6144 - 2^6080 + {[2^6014 * e] + 15705020} * 2^64 - 1 *)
(* The estimated symmetric-equivalent strength of this group is 175 bits.
Peers using ffdhe6144 that want to optimize their key exchange with a
short exponent (Section 5.2) should choose a secret key of at least
375 bits. *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xAD\xF8\x54\x58\xA2\xBB\x4A\x9A\
\xAF\xDC\x56\x20\x27\x3D\x3C\xF1\xD8\xB9\xC5\x83\xCE\x2D\x36\x95\
\xA9\xE1\x36\x41\x14\x64\x33\xFB\xCC\x93\x9D\xCE\x24\x9B\x3E\xF9\
\x7D\x2F\xE3\x63\x63\x0C\x75\xD8\xF6\x81\xB2\x02\xAE\xC4\x61\x7A\
\xD3\xDF\x1E\xD5\xD5\xFD\x65\x61\x24\x33\xF5\x1F\x5F\x06\x6E\xD0\
\x85\x63\x65\x55\x3D\xED\x1A\xF3\xB5\x57\x13\x5E\x7F\x57\xC9\x35\
\x98\x4F\x0C\x70\xE0\xE6\x8B\x77\xE2\xA6\x89\xDA\xF3\xEF\xE8\x72\
\x1D\xF1\x58\xA1\x36\xAD\xE7\x35\x30\xAC\xCA\x4F\x48\x3A\x79\x7A\
\xBC\x0A\xB1\x82\xB3\x24\xFB\x61\xD1\x08\xA9\x4B\xB2\xC8\xE3\xFB\
\xB9\x6A\xDA\xB7\x60\xD7\xF4\x68\x1D\x4F\x42\xA3\xDE\x39\x4D\xF4\
\xAE\x56\xED\xE7\x63\x72\xBB\x19\x0B\x07\xA7\xC8\xEE\x0A\x6D\x70\
\x9E\x02\xFC\xE1\xCD\xF7\xE2\xEC\xC0\x34\x04\xCD\x28\x34\x2F\x61\
\x91\x72\xFE\x9C\xE9\x85\x83\xFF\x8E\x4F\x12\x32\xEE\xF2\x81\x83\
\xC3\xFE\x3B\x1B\x4C\x6F\xAD\x73\x3B\xB5\xFC\xBC\x2E\xC2\x20\x05\
\xC5\x8E\xF1\x83\x7D\x16\x83\xB2\xC6\xF3\x4A\x26\xC1\xB2\xEF\xFA\
\x88\x6B\x42\x38\x61\x1F\xCF\xDC\xDE\x35\x5B\x3B\x65\x19\x03\x5B\
\xBC\x34\xF4\xDE\xF9\x9C\x02\x38\x61\xB4\x6F\xC9\xD6\xE6\xC9\x07\
\x7A\xD9\x1D\x26\x91\xF7\xF7\xEE\x59\x8C\xB0\xFA\xC1\x86\xD9\x1C\
\xAE\xFE\x13\x09\x85\x13\x92\x70\xB4\x13\x0C\x93\xBC\x43\x79\x44\
\xF4\xFD\x44\x52\xE2\xD7\x4D\xD3\x64\xF2\xE2\x1E\x71\xF5\x4B\xFF\
\x5C\xAE\x82\xAB\x9C\x9D\xF6\x9E\xE8\x6D\x2B\xC5\x22\x36\x3A\x0D\
\xAB\xC5\x21\x97\x9B\x0D\xEA\xDA\x1D\xBF\x9A\x42\xD5\xC4\x48\x4E\
\x0A\xBC\xD0\x6B\xFA\x53\xDD\xEF\x3C\x1B\x20\xEE\x3F\xD5\x9D\x7C\
\x25\xE4\x1D\x2B\x66\x9E\x1E\xF1\x6E\x6F\x52\xC3\x16\x4D\xF4\xFB\
\x79\x30\xE9\xE4\xE5\x88\x57\xB6\xAC\x7D\x5F\x42\xD6\x9F\x6D\x18\
\x77\x63\xCF\x1D\x55\x03\x40\x04\x87\xF5\x5B\xA5\x7E\x31\xCC\x7A\
\x71\x35\xC8\x86\xEF\xB4\x31\x8A\xED\x6A\x1E\x01\x2D\x9E\x68\x32\
\xA9\x07\x60\x0A\x91\x81\x30\xC4\x6D\xC7\x78\xF9\x71\xAD\x00\x38\
\x09\x29\x99\xA3\x33\xCB\x8B\x7A\x1A\x1D\xB9\x3D\x71\x40\x00\x3C\
\x2A\x4E\xCE\xA9\xF9\x8D\x0A\xCC\x0A\x82\x91\xCD\xCE\xC9\x7D\xCF\
\x8E\xC9\xB5\x5A\x7F\x88\xA4\x6B\x4D\xB5\xA8\x51\xF4\x41\x82\xE1\
\xC6\x8A\x00\x7E\x5E\x0D\xD9\x02\x0B\xFD\x64\xB6\x45\x03\x6C\x7A\
\x4E\x67\x7D\x2C\x38\x53\x2A\x3A\x23\xBA\x44\x42\xCA\xF5\x3E\xA6\
\x3B\xB4\x54\x32\x9B\x76\x24\xC8\x91\x7B\xDD\x64\xB1\xC0\xFD\x4C\
\xB3\x8E\x8C\x33\x4C\x70\x1C\x3A\xCD\xAD\x06\x57\xFC\xCF\xEC\x71\
\x9B\x1F\x5C\x3E\x4E\x46\x04\x1F\x38\x81\x47\xFB\x4C\xFD\xB4\x77\
\xA5\x24\x71\xF7\xA9\xA9\x69\x10\xB8\x55\x32\x2E\xDB\x63\x40\xD8\
\xA0\x0E\xF0\x92\x35\x05\x11\xE3\x0A\xBE\xC1\xFF\xF9\xE3\xA2\x6E\
\x7F\xB2\x9F\x8C\x18\x30\x23\xC3\x58\x7E\x38\xDA\x00\x77\xD9\xB4\
\x76\x3E\x4E\x4B\x94\xB2\xBB\xC1\x94\xC6\x65\x1E\x77\xCA\xF9\x92\
\xEE\xAA\xC0\x23\x2A\x28\x1B\xF6\xB3\xA7\x39\xC1\x22\x61\x16\x82\
\x0A\xE8\xDB\x58\x47\xA6\x7C\xBE\xF9\xC9\x09\x1B\x46\x2D\x53\x8C\
\xD7\x2B\x03\x74\x6A\xE7\x7F\x5E\x62\x29\x2C\x31\x15\x62\xA8\x46\
\x50\x5D\xC8\x2D\xB8\x54\x33\x8A\xE4\x9F\x52\x35\xC9\x5B\x91\x17\
\x8C\xCF\x2D\xD5\xCA\xCE\xF4\x03\xEC\x9D\x18\x10\xC6\x27\x2B\x04\
\x5B\x3B\x71\xF9\xDC\x6B\x80\xD6\x3F\xDD\x4A\x8E\x9A\xDB\x1E\x69\
\x62\xA6\x95\x26\xD4\x31\x61\xC1\xA4\x1D\x57\x0D\x79\x38\xDA\xD4\
\xA4\x0E\x32\x9C\xD0\xE4\x0E\x65\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
let ffdhe8192 =
(* p = 2^8192 - 2^8128 + {[2^8062 * e] + 10965728} * 2^64 - 1 *)
(* The estimated symmetric-equivalent strength of this group is 192 bits.
Peers using ffdhe8192 that want to optimize their key exchange with a
short exponent (Section 5.2) should choose a secret key of at least
400 bits. *)
s_group ~p:
"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xAD\xF8\x54\x58\xA2\xBB\x4A\x9A\
\xAF\xDC\x56\x20\x27\x3D\x3C\xF1\xD8\xB9\xC5\x83\xCE\x2D\x36\x95\
\xA9\xE1\x36\x41\x14\x64\x33\xFB\xCC\x93\x9D\xCE\x24\x9B\x3E\xF9\
\x7D\x2F\xE3\x63\x63\x0C\x75\xD8\xF6\x81\xB2\x02\xAE\xC4\x61\x7A\
\xD3\xDF\x1E\xD5\xD5\xFD\x65\x61\x24\x33\xF5\x1F\x5F\x06\x6E\xD0\
\x85\x63\x65\x55\x3D\xED\x1A\xF3\xB5\x57\x13\x5E\x7F\x57\xC9\x35\
\x98\x4F\x0C\x70\xE0\xE6\x8B\x77\xE2\xA6\x89\xDA\xF3\xEF\xE8\x72\
\x1D\xF1\x58\xA1\x36\xAD\xE7\x35\x30\xAC\xCA\x4F\x48\x3A\x79\x7A\
\xBC\x0A\xB1\x82\xB3\x24\xFB\x61\xD1\x08\xA9\x4B\xB2\xC8\xE3\xFB\
\xB9\x6A\xDA\xB7\x60\xD7\xF4\x68\x1D\x4F\x42\xA3\xDE\x39\x4D\xF4\
\xAE\x56\xED\xE7\x63\x72\xBB\x19\x0B\x07\xA7\xC8\xEE\x0A\x6D\x70\
\x9E\x02\xFC\xE1\xCD\xF7\xE2\xEC\xC0\x34\x04\xCD\x28\x34\x2F\x61\
\x91\x72\xFE\x9C\xE9\x85\x83\xFF\x8E\x4F\x12\x32\xEE\xF2\x81\x83\
\xC3\xFE\x3B\x1B\x4C\x6F\xAD\x73\x3B\xB5\xFC\xBC\x2E\xC2\x20\x05\
\xC5\x8E\xF1\x83\x7D\x16\x83\xB2\xC6\xF3\x4A\x26\xC1\xB2\xEF\xFA\
\x88\x6B\x42\x38\x61\x1F\xCF\xDC\xDE\x35\x5B\x3B\x65\x19\x03\x5B\
\xBC\x34\xF4\xDE\xF9\x9C\x02\x38\x61\xB4\x6F\xC9\xD6\xE6\xC9\x07\
\x7A\xD9\x1D\x26\x91\xF7\xF7\xEE\x59\x8C\xB0\xFA\xC1\x86\xD9\x1C\
\xAE\xFE\x13\x09\x85\x13\x92\x70\xB4\x13\x0C\x93\xBC\x43\x79\x44\
\xF4\xFD\x44\x52\xE2\xD7\x4D\xD3\x64\xF2\xE2\x1E\x71\xF5\x4B\xFF\
\x5C\xAE\x82\xAB\x9C\x9D\xF6\x9E\xE8\x6D\x2B\xC5\x22\x36\x3A\x0D\
\xAB\xC5\x21\x97\x9B\x0D\xEA\xDA\x1D\xBF\x9A\x42\xD5\xC4\x48\x4E\
\x0A\xBC\xD0\x6B\xFA\x53\xDD\xEF\x3C\x1B\x20\xEE\x3F\xD5\x9D\x7C\
\x25\xE4\x1D\x2B\x66\x9E\x1E\xF1\x6E\x6F\x52\xC3\x16\x4D\xF4\xFB\
\x79\x30\xE9\xE4\xE5\x88\x57\xB6\xAC\x7D\x5F\x42\xD6\x9F\x6D\x18\
\x77\x63\xCF\x1D\x55\x03\x40\x04\x87\xF5\x5B\xA5\x7E\x31\xCC\x7A\
\x71\x35\xC8\x86\xEF\xB4\x31\x8A\xED\x6A\x1E\x01\x2D\x9E\x68\x32\
\xA9\x07\x60\x0A\x91\x81\x30\xC4\x6D\xC7\x78\xF9\x71\xAD\x00\x38\
\x09\x29\x99\xA3\x33\xCB\x8B\x7A\x1A\x1D\xB9\x3D\x71\x40\x00\x3C\
\x2A\x4E\xCE\xA9\xF9\x8D\x0A\xCC\x0A\x82\x91\xCD\xCE\xC9\x7D\xCF\
\x8E\xC9\xB5\x5A\x7F\x88\xA4\x6B\x4D\xB5\xA8\x51\xF4\x41\x82\xE1\
\xC6\x8A\x00\x7E\x5E\x0D\xD9\x02\x0B\xFD\x64\xB6\x45\x03\x6C\x7A\
\x4E\x67\x7D\x2C\x38\x53\x2A\x3A\x23\xBA\x44\x42\xCA\xF5\x3E\xA6\
\x3B\xB4\x54\x32\x9B\x76\x24\xC8\x91\x7B\xDD\x64\xB1\xC0\xFD\x4C\
\xB3\x8E\x8C\x33\x4C\x70\x1C\x3A\xCD\xAD\x06\x57\xFC\xCF\xEC\x71\
\x9B\x1F\x5C\x3E\x4E\x46\x04\x1F\x38\x81\x47\xFB\x4C\xFD\xB4\x77\
\xA5\x24\x71\xF7\xA9\xA9\x69\x10\xB8\x55\x32\x2E\xDB\x63\x40\xD8\
\xA0\x0E\xF0\x92\x35\x05\x11\xE3\x0A\xBE\xC1\xFF\xF9\xE3\xA2\x6E\
\x7F\xB2\x9F\x8C\x18\x30\x23\xC3\x58\x7E\x38\xDA\x00\x77\xD9\xB4\
\x76\x3E\x4E\x4B\x94\xB2\xBB\xC1\x94\xC6\x65\x1E\x77\xCA\xF9\x92\
\xEE\xAA\xC0\x23\x2A\x28\x1B\xF6\xB3\xA7\x39\xC1\x22\x61\x16\x82\
\x0A\xE8\xDB\x58\x47\xA6\x7C\xBE\xF9\xC9\x09\x1B\x46\x2D\x53\x8C\
\xD7\x2B\x03\x74\x6A\xE7\x7F\x5E\x62\x29\x2C\x31\x15\x62\xA8\x46\
\x50\x5D\xC8\x2D\xB8\x54\x33\x8A\xE4\x9F\x52\x35\xC9\x5B\x91\x17\
\x8C\xCF\x2D\xD5\xCA\xCE\xF4\x03\xEC\x9D\x18\x10\xC6\x27\x2B\x04\
\x5B\x3B\x71\xF9\xDC\x6B\x80\xD6\x3F\xDD\x4A\x8E\x9A\xDB\x1E\x69\
\x62\xA6\x95\x26\xD4\x31\x61\xC1\xA4\x1D\x57\x0D\x79\x38\xDA\xD4\
\xA4\x0E\x32\x9C\xCF\xF4\x6A\xAA\x36\xAD\x00\x4C\xF6\x00\xC8\x38\
\x1E\x42\x5A\x31\xD9\x51\xAE\x64\xFD\xB2\x3F\xCE\xC9\x50\x9D\x43\
\x68\x7F\xEB\x69\xED\xD1\xCC\x5E\x0B\x8C\xC3\xBD\xF6\x4B\x10\xEF\
\x86\xB6\x31\x42\xA3\xAB\x88\x29\x55\x5B\x2F\x74\x7C\x93\x26\x65\
\xCB\x2C\x0F\x1C\xC0\x1B\xD7\x02\x29\x38\x88\x39\xD2\xAF\x05\xE4\
\x54\x50\x4A\xC7\x8B\x75\x82\x82\x28\x46\xC0\xBA\x35\xC3\x5F\x5C\
\x59\x16\x0C\xC0\x46\xFD\x82\x51\x54\x1F\xC6\x8C\x9C\x86\xB0\x22\
\xBB\x70\x99\x87\x6A\x46\x0E\x74\x51\xA8\xA9\x31\x09\x70\x3F\xEE\
\x1C\x21\x7E\x6C\x38\x26\xE5\x2C\x51\xAA\x69\x1E\x0E\x42\x3C\xFC\
\x99\xE9\xE3\x16\x50\xC1\x21\x7B\x62\x48\x16\xCD\xAD\x9A\x95\xF9\
\xD5\xB8\x01\x94\x88\xD9\xC0\xA0\xA1\xFE\x30\x75\xA5\x77\xE2\x31\
\x83\xF8\x1D\x4A\x3F\x2F\xA4\x57\x1E\xFC\x8C\xE0\xBA\x8A\x4F\xE8\
\xB6\x85\x5D\xFE\x72\xB0\xA6\x6E\xDE\xD2\xFB\xAB\xFB\xE5\x8A\x30\
\xFA\xFA\xBE\x1C\x5D\x71\xA8\x7E\x2F\x74\x1E\xF8\xC1\xFE\x86\xFE\
\xA6\xBB\xFD\xE5\x30\x67\x7F\x0D\x97\xD1\x1D\x49\xF7\xA8\x44\x3D\
\x08\x22\xE5\x06\xA9\xF4\x61\x4E\x01\x1E\x2A\x94\x83\x8F\xF8\x8C\
\xD6\x8C\x8B\xB7\xC5\xC6\x42\x4C\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"
end

178
unikernel/duniverse/mirage-crypto/pk/dsa.ml Normal file
View file

@ -0,0 +1,178 @@
open Mirage_crypto.Uncommon
open Common
type pub = { p : Z.t ; q : Z.t ; gg : Z.t ; y : Z.t }
let pub ?(fips = false) ~p ~q ~gg ~y () =
let* () = guard Z.(one < gg && gg < p) (`Msg "bad generator") in
let* () = guard (Z_extra.pseudoprime q) (`Msg "q is not prime") in
let* () = guard (Z.is_odd p && Z_extra.pseudoprime p) (`Msg "p is not prime") in
let* () = guard Z.(zero < y && y < p) (`Msg "y not in 0..p-1") in
let* () = guard (q < p) (`Msg "q is not smaller than p") in
let* () = guard Z.(zero = (pred p) mod q) (`Msg "p - 1 mod q <> 0") in
let* () =
if fips then
match Z.numbits p, Z.numbits q with
| 1024, 160 | 2048, 224 | 2048, 256 | 3072, 256 -> Ok ()
| _ -> Error (`Msg "bit length of p or q not FIPS specified")
else
Ok ()
in
Ok { p ; q ; gg ; y }
type priv =
{ p : Z.t ; q : Z.t ; gg : Z.t ; x : Z.t ; y : Z.t }
let priv ?fips ~p ~q ~gg ~x ~y () =
let* _ = pub ?fips ~p ~q ~gg ~y () in
let* () = guard Z.(zero < x && x < q) (`Msg "x not in 1..q-1") in
let* () = guard Z.(y = powm gg x p) (`Msg "y <> g ^ x mod p") in
Ok { p ; q ; gg ; x ; y }
let pub_of_priv { p; q; gg; y; _ } = { p; q; gg; y }
type keysize = [ `Fips1024 | `Fips2048 | `Fips3072 | `Exactly of int * int ]
let expand_size = function
| `Fips1024 -> (1024, 160)
| `Fips2048 -> (2048, 256)
| `Fips3072 -> (3072, 256)
| `Exactly (l, n) ->
if 3 <= l && 2 <= n then (l, n) else
invalid_arg "Dsa.generate: bits: `Exactly (%d, %d)" l n
type mask = [ `No | `Yes | `Yes_with of Mirage_crypto_rng.g ]
let expand_mask = function
| `No -> `No
| `Yes -> `Yes None
| `Yes_with g -> `Yes (Some g)
(*
* FIPS.186-4-style derivation:
* - p and q are derived using a method numerically like the one described in
* A.1.1.2, adapted to use the native rng.
* - g is derived as per A.2.1.
*)
let params ?g size =
let two = Z.(~$2) in
let (l, n) = expand_size size in
let q = Z_extra.prime ?g ~msb:1 n in
let p =
let q_q = Z.(q * two) in
until Z_extra.pseudoprime @@ fun () ->
let x = Z_extra.gen_bits ?g ~msb:1 l in
Z.(x - (x mod q_q) + one)
in
let gg =
let e = Z.(pred p / q) in
until ((<>) Z.one) @@ fun () ->
let h = Z_extra.gen_r ?g two Z.(pred p) in
Z.(powm h e p)
in
(* all checks above are already satisfied *)
(p, q, gg)
let generate ?g size =
let (p, q, gg) = params ?g size in
let x = Z_extra.gen_r ?g Z.one q in
let y = Z.(powm gg x p) in
(* checks are satisfied due to construction *)
{ p; q; gg; x; y }
module K_gen (H : Digestif.S) = struct
let drbg : 'a Mirage_crypto_rng.generator =
let module M = Mirage_crypto_rng.Hmac_drbg (H) in (module M)
let z_gen ~key:{ q; x; _ } z =
let repr = Z_extra.to_octets_be ~size:(Z.numbits q // 8) in
let g = Mirage_crypto_rng.create ~strict:true drbg in
Mirage_crypto_rng.reseed ~g (repr x ^ repr Z.(z mod q));
Z_extra.gen_r ~g Z.one q
let generate ~key buf =
z_gen ~key (Z_extra.of_octets_be ~bits:(Z.numbits key.q) buf)
end
module K_gen_sha256 = K_gen (Digestif.SHA256)
let sign_z ?(mask = `Yes) ?k:k0 ~key:({ p; q; gg; x; _ } as key) z =
let k = match k0 with Some k -> k | None -> K_gen_sha256.z_gen ~key z in
let k' = Z.invert k q
and b, b' = match expand_mask mask with
| `No -> Z.one, Z.one
| `Yes g ->
let m = Z_extra.gen_r ?g Z.one q in
m, Z.invert m q
in
let r = Z.(powm_sec gg k p mod q) in
(* normal DSA sign is: s = k^-1 * (z + r * x) mod q *)
(* we apply blinding where possible and compute:
s = k^-1 * b^-1 * (b * z + b * r * x) mod q
see https://github.com/openssl/openssl/pull/6524 for further details *)
let s =
let t1 =
let t11 = Z.(b * x mod q) in
Z.(t11 * r mod q)
in
let t2 = Z.(b * z mod q) in
let t3 = Z.((t1 + t2) mod q) in
let t4 = Z.(k' * t3 mod q) in
Z.(b' * t4 mod q)
in
if r = Z.zero || s = Z.zero then invalid_arg "k unsuitable" else (r, s)
let verify_z ~key:({ p; q; gg; y }: pub ) (r, s) z =
let v () =
let w = Z.invert s q in
let u1 = Z.(z * w mod q)
and u2 = Z.(r * w mod q) in
Z.((powm gg u1 p * powm y u2 p) mod p mod q) in
Z.zero < r && r < q && Z.zero < s && s < q && v () = r
let sign ?mask ?k ~(key : priv) digest =
let bits = Z.numbits key.q in
let size = bits // 8 in
let (r, s) = sign_z ?mask ?k ~key (Z_extra.of_octets_be ~bits digest) in
Z_extra.(to_octets_be ~size r, to_octets_be ~size s)
let verify ~(key : pub) (r, s) digest =
let z = Z_extra.of_octets_be ~bits:(Z.numbits key.q) digest
and (r, s) = Z_extra.(of_octets_be r, of_octets_be s) in
verify_z ~key (r, s) z
let rec shift_left_inplace buf = function
| 0 -> ()
| bits when bits mod 8 = 0 ->
let off = bits / 8 in
let to_blit = Bytes.length buf - off in
Bytes.unsafe_blit buf off buf 0 to_blit ;
Bytes.unsafe_fill buf to_blit (Bytes.length buf - to_blit) '\x00'
| bits when bits < 8 ->
let foo = 8 - bits in
for i = 0 to Bytes.length buf - 2 do
let b1 = Bytes.get_uint8 buf i
and b2 = Bytes.get_uint8 buf (i + 1) in
Bytes.set_uint8 buf i ((b1 lsl bits) lor (b2 lsr foo))
done ;
Bytes.set_uint8 buf (Bytes.length buf - 1)
(Bytes.get_uint8 buf (Bytes.length buf - 1) lsl bits)
| bits ->
shift_left_inplace buf (8 * (bits / 8)) ;
shift_left_inplace buf (bits mod 8)
let (lsl) buf bits =
let buf' = Bytes.of_string buf in
shift_left_inplace buf' bits;
Bytes.unsafe_to_string buf'
let massage ~key:({ q; _ }: pub) digest =
let bits = Z.numbits q in
if bits >= String.length digest * 8 then
digest
else
let buf = Z_extra.(to_octets_be Z.(of_octets_be digest mod q)) in
buf lsl ((8 - bits mod 8) mod 8)

5
unikernel/duniverse/mirage-crypto/pk/dune Normal file
View file

@ -0,0 +1,5 @@
(library
(name mirage_crypto_pk)
(public_name mirage-crypto-pk)
(libraries zarith mirage-crypto mirage-crypto-rng eqaf)
(private_modules common dh dsa rsa z_extra))

4
unikernel/duniverse/mirage-crypto/pk/mirage_crypto_pk.ml Normal file
View file

@ -0,0 +1,4 @@
module Dh = Dh
module Dsa = Dsa
module Rsa = Rsa
module Z_extra = Z_extra

520
unikernel/duniverse/mirage-crypto/pk/mirage_crypto_pk.mli Normal file
View file

@ -0,0 +1,520 @@
(** {1 Public-key cryptography} *)
(** Public and private key types are private, the constructors validate their
well-formedness as much as possible, esp. so that [powm_sec] will not raise
an exception (exponent > 1, or odd modulus). All modular exponentiations
(unless otherwise noted) use the {!Z.powm_sec} function, which uses a static
access pattern and operates in constant time (of the bit size of the input),
independent of which bits are set and not set. The performance is up to 20%
worse than [powm]. Additionally, blinding is applied to RSA and DSA by
default. *)
(** {b RSA} public-key cryptography algorithm. *)
module Rsa : sig
(** {1 Keys}
Messages are checked not to exceed the key size, and this is signalled via
the {!Insufficient_key} exception.
Private-key operations are optionally protected through RSA blinding. *)
exception Insufficient_key
(** Raised if the key is too small to transform the given message, i.e. if the
numerical interpretation of the (potentially padded) message is not
smaller than the modulus. *)
type pub = private {
e : Z.t ; (** Public exponent *)
n : Z.t ; (** Modulus *)
}
(** The public portion of the key. *)
val pub : e:Z.t -> n:Z.t -> (pub, [> `Msg of string ]) result
(** [pub ~e ~n] validates the public key: [1 < e < n], [n > 0],
[is_odd n], and [numbits n >= 89] (a requirement for PKCS1 operations). *)
type priv = private {
e : Z.t ; (** Public exponent *)
d : Z.t ; (** Private exponent *)
n : Z.t ; (** Modulus ([p q])*)
p : Z.t ; (** Prime factor [p] *)
q : Z.t ; (** Prime factor [q] *)
dp : Z.t ; (** [d mod (p-1)] *)
dq : Z.t ; (** [d mod (q-1)] *)
q' : Z.t ; (** [q^(-1) mod p] *)
}
(** Full private key (two-factor version).
{b Note} The key layout assumes that [p > q], which affects the quantity
[q'] (sometimes called [u]), and the computation of the private transform.
Some systems assume otherwise. When using keys produced by a system that
computes [u = p^(-1) mod q], either exchange [p] with [q] and [dp] with
[dq], or re-generate the full private key using
{{!priv_of_primes}[priv_of_primes]}. *)
val priv : e:Z.t -> d:Z.t -> n:Z.t -> p:Z.t -> q:Z.t -> dp:Z.t -> dq:Z.t ->
q':Z.t -> (priv, [> `Msg of string ]) result
(** [priv ~e ~d ~n ~p ~q ~dp ~dq ~q'] validates the private key: [e, n] must
be a valid {!type-pub}, [p] and [q] valid prime numbers [> 0], [odd],
probabilistically prime, [p <> q], [n = p * q], [e] probabilistically
prime and coprime to both [p] and [q], [q' = q ^ -1 mod p], [1 < d < n],
[dp = d mod (p - 1)], [dq = d mod (q - 1)],
and [d = e ^ -1 mod (p - 1) (q - 1)]. *)
val pub_bits : pub -> int
(** Bit-size of a public key. *)
val priv_bits : priv -> int
(** Bit-size of a private key. *)
val priv_of_primes : e:Z.t -> p:Z.t -> q:Z.t ->
(priv, [> `Msg of string ]) result
(** [priv_of_primes ~e ~p ~q] is the {{!type-priv}private key} derived from the
minimal description [(e, p, q)]. *)
val priv_of_exp : ?g:Mirage_crypto_rng.g -> ?attempts:int -> e:Z.t -> d:Z.t ->
n:Z.t -> unit -> (priv, [> `Msg of string ]) result
(** [priv_of_exp ?g ?attempts ~e ~d n] is the unique {{!type-priv}private key}
characterized by the public ([e]) and private ([d]) exponents, and modulus
[n]. This operation uses a probabilistic process that can fail to recover
the key.
[~attempts] is the number of trials. For triplets that form an RSA key,
the probability of failure is at most [2^(-attempts)]. [attempts] defaults
to an unspecified number that yields a very high probability of recovering
valid keys.
Note that no time masking is done for the computations in this function. *)
val pub_of_priv : priv -> pub
(** Extract the public component from a private key. *)
(** {1 The RSA transformation} *)
type 'a or_digest = [ `Message of 'a | `Digest of string ]
(** Either an ['a] or its digest, according to some hash algorithm. *)
type mask = [ `No | `Yes | `Yes_with of Mirage_crypto_rng.g ]
(** Masking (cryptographic blinding) mode for the RSA transform with the
private key. Masking does not change the result, but it does change the
timing profile of the operation.
{ul
{- [`No] disables masking. It is slightly faster but it {b exposes the
private key to timing-based attacks}.}
{- [`Yes] uses random masking with the global RNG instance. This is
the sane option.}
{- [`Yes_with g] uses random masking with the generator [g].}} *)
val encrypt : key:pub -> string -> string
(** [encrypt key message] is the encrypted [message].
@raise Insufficient_key (see {{!Insufficient_key}Insufficient_key})
@raise Invalid_argument if [message] is [0x00] or [0x01]. *)
val decrypt : ?crt_hardening:bool -> ?mask:mask -> key:priv ->
string -> string
(** [decrypt ~crt_hardening ~mask key ciphertext] is the decrypted
[ciphertext], left-padded with [0x00] up to [key] size.
[~crt_hardening] defaults to [false]. If [true] verifies that the
result is correct. This is to counter Chinese remainder theorem attacks to
factorize primes. If the computed signature is incorrect, it is again
computed in the classical way (c ^ d mod n) without the Chinese remainder
theorem optimization. The deterministic {{!PKCS1.sign}PKCS1 signing},
which is at danger, uses [true] as default.
[~mask] defaults to [`Yes].
@raise Insufficient_key (see {{!Insufficient_key}Insufficient_key}) *)
(** {1 Key generation} *)
val generate : ?g:Mirage_crypto_rng.g -> ?e:Z.t -> bits:int -> unit -> priv
(** [generate ~g ~e ~bits ()] is a new {{!type-priv}private key}. The new key is
guaranteed to be well formed, see {!val-priv}.
[e] defaults to [2^16+1].
{b Note} This process might diverge if there are no keys for the given
bit size. This can happen when [bits] is extremely small.
@raise Invalid_argument if [e] is not a prime number (checked
probabilistically) or not in the range [1 < e < 2^bits], or if
[bits < 89] (as above, required for PKCS1 operations). *)
(** {1 PKCS#1 padded modes} *)
(** {b PKCS v1.5} operations, as defined by {b PKCS #1 v1.5}.
For the operations that only add the raw padding, the key size must be at
least 11 bytes larger than the message. For full {{!PKCS1.sign}signing}, the
minimal key size varies according to the hash algorithm. In this case, the
key size is [priv_bits key / 8], rounded up. *)
module PKCS1 : sig
val encrypt : ?g:Mirage_crypto_rng.g -> key:pub -> string -> string
(** [encrypt g key message] is a PKCS1-padded (type 2) and encrypted
[message].
@raise Insufficient_key (see {{!Insufficient_key}Insufficient_key}) *)
val decrypt : ?crt_hardening:bool -> ?mask:mask -> key:priv ->
string -> string option
(** [decrypt ~crt_hardening ~mask ~key ciphertext] is [Some message] if
the [ciphertext] was produced by the corresponding {{!encrypt}encrypt}
operation, or [None] otherwise. [crt_hardening] defaults to
[false]. *)
val sig_encode : ?crt_hardening:bool -> ?mask:mask -> key:priv ->
string -> string
(** [sig_encode ~crt_hardening ~mask ~key message] is the PKCS1-padded
(type 1) [message] signed by the [key]. [crt_hardening] defaults to
[true] and verifies that the computed signature is correct.
{b Note} This operation performs only the padding and RSA transformation
steps of the PKCS 1.5 signature. The full signature is implemented by
{{!sign}[sign]}.
@raise Insufficient_key (see {{!Insufficient_key}Insufficient_key}) *)
val sig_decode : key:pub -> string -> string option
(** [sig_decode key signature] is [Some message] when the [signature]
was produced with the given [key] as per {{!sig_encode}sig_encode}, or
[None] *)
val min_key : [< Digestif.hash' > `MD5 `SHA1 `SHA224 `SHA256 `SHA384 `SHA512 ] -> int
(** [min_key hash] is the minimum key size required by {{!sign}[sign]}. *)
val sign : ?crt_hardening:bool -> ?mask:mask ->
hash:[< Digestif.hash' > `MD5 `SHA1 `SHA224 `SHA256 `SHA384 `SHA512 ] ->
key:priv -> string or_digest -> string
(** [sign ~crt_hardening ~mask ~hash ~key message] is the PKCS 1.5
signature of [message], signed by the [key], using the hash function
[hash]. This is the full signature, with the ASN-encoded message digest
as the payload. [crt_hardening] defaults to [true] and verifies that
the computed signature is correct.
[message] is either the actual message, or its digest.
@raise Insufficient_key (see {{!Insufficient_key}Insufficient_key})
@raise Invalid_argument if message is a [`Digest] of the wrong size. *)
val verify : hashp:([< Digestif.hash' > `MD5 `SHA1 `SHA224 `SHA256 `SHA384 `SHA512 ] -> bool) ->
key:pub -> signature:string -> string or_digest -> bool
(** [verify ~hashp ~key ~signature message] checks that [signature] is the
PKCS 1.5 signature of the [message] under the given [key].
[message] is either the actual message, or its digest.
[hashp] determines the allowed hash algorithms. Whenever [hashp] is
[false], [verify] is also [false].
@raise Invalid_argument if message is a [`Digest] of the wrong size. *)
end
(** {1 OAEP padded modes} *)
(** {b OAEP}-padded encryption, as defined by {b PKCS #1 v2.1}.
The same hash function is used for padding and MGF. MGF is {b MGF1} as
defined in {b PKCS #1 2.1}.
Keys must have a minimum of [2 + 2 * hlen + len(message)] bytes, where
[hlen] is the hash length. *)
module OAEP (H : Digestif.S) : sig
val encrypt : ?g:Mirage_crypto_rng.g -> ?label:string -> key:pub ->
string -> string
(** [encrypt ~g ~label ~key message] is {b OAEP}-padded and encrypted
[message], using the optional [label].
@raise Insufficient_key (see {{!Insufficient_key}Insufficient_key}) *)
val decrypt : ?crt_hardening:bool -> ?mask:mask -> ?label:string ->
key:priv -> string -> string option
(** [decrypt ~crt_hardening ~mask ~label ~key ciphertext] is
[Some message] if the [ciphertext] was produced by the corresponding
{{!encrypt}encrypt} operation, or [None] otherwise. [crt_hardening]
defaults to [false]. *)
end
(** {1 PSS signing} *)
(** {b PSS}-based signing, as defined by {b PKCS #1 v2.1}.
The same hash function is used for padding, MGF and computing message
digest. MGF is {b MGF1} as defined in {b PKCS #1 2.1}.
Keys must have a minimum of [2 + hlen + slen] bytes, where [hlen] is the
hash length and [slen] is the seed length. *)
module PSS (H: Digestif.S) : sig
val sign : ?g:Mirage_crypto_rng.g -> ?crt_hardening:bool ->
?mask:mask -> ?slen:int -> key:priv -> string or_digest -> string
(** [sign ~g ~crt_hardening ~mask ~slen ~key message] the [PSS]-padded
digest of [message], signed with the [key]. [crt_hardening] defaults
to [false].
[slen] is the optional seed length and defaults to the size of the
underlying hash function.
[message] is either the actual message, or its digest.
@raise Insufficient_key (see {{!Insufficient_key}Insufficient_key})
@raise Invalid_argument if message is a [`Digest] of the wrong size. *)
val verify : ?slen:int -> key:pub -> signature:string -> string or_digest -> bool
(** [verify ~slen ~key ~signature message] checks whether [signature] is a
valid {b PSS} signature of the [message] under the given [key].
[message] is either the actual message, or its digest.
@raise Invalid_argument if message is a [`Digest] of the wrong size. *)
end
end
(** {b DSA} digital signature algorithm. *)
module Dsa : sig
(** {1 DSA signature algorithm} *)
type priv = private {
p : Z.t ; (** Modulus *)
q : Z.t ; (** Subgroup order *)
gg : Z.t ; (** Group Generator *)
x : Z.t ; (** Private key proper *)
y : Z.t ; (** Public component *)
}
(** Private key. [p], [q] and [gg] comprise {i domain parameters}. *)
val priv : ?fips:bool -> p:Z.t -> q:Z.t -> gg:Z.t -> x:Z.t -> y:Z.t -> unit ->
(priv, [> `Msg of string ]) result
(** [priv ~fips ~p ~q ~gg ~x ~y ()] constructs a private DSA key from the given
numbers. Will result in an error if parameters are ill-formed: same as
{!val-pub}, and additionally [0 < x < q] and [y = g ^ x mod p]. Note that no
time masking is done on the modular exponentiation. *)
type pub = private {
p : Z.t ;
q : Z.t ;
gg : Z.t ;
y : Z.t ;
}
(** Public key, a subset of {{!type-priv}private key}. *)
val pub : ?fips:bool -> p:Z.t -> q:Z.t -> gg:Z.t -> y:Z.t -> unit ->
(pub, [> `Msg of string ]) result
(** [pub ~fips ~p ~q ~gg ~y ()] constructs a public DSA key from the given
numbers. Will result in an error if the parameters are not well-formed:
[one < gg < p], [q] probabilistically a prime, [p] probabilistically
prime and odd, [0 < y < p], [q < p], and [p - 1 mod q = 0]. If [fips] is
specified and [true] (defaults to [false]), only FIPS-specified bit length
for [p] and [q] are accepted. *)
type keysize = [ `Fips1024 | `Fips2048 | `Fips3072 | `Exactly of int * int ]
(** Key size request. Three {e Fips} variants refer to FIPS-standardized
L-values ([p] size) and imply the corresponding N ([q] size); The last
variants specifies L and N directly. *)
type mask = [ `No | `Yes | `Yes_with of Mirage_crypto_rng.g ]
(** Masking (cryptographic blinding) option. *)
val pub_of_priv : priv -> pub
(** Extract the public component from a private key. *)
val generate : ?g:Mirage_crypto_rng.g -> keysize -> priv
(** [generate g size] is a fresh {{!type-priv}private} key. The domain parameters
are derived using a modified FIPS.186-4 probabilistic process, but the
derivation can not be validated. Note that no time masking is done for the
modular exponentiations.
{b Note} The process might diverge if it is impossible to find parameters
with the given bit sizes. This happens when [n] gets too big for [l], if
the [size] was given as [`Exactly (l, n)].
@raise Invalid_argument if [size] is (`Exactly (l, n)), and either [l] or
[n] is ridiculously small. *)
val sign : ?mask:mask -> ?k:Z.t -> key:priv -> string -> string * string
(** [sign ~mask ~k ~key digest] is the signature, a pair of strings
representing [r] and [s] in big-endian.
[digest] is the full digest of the actual message.
[k], the random component, can either be provided, or is deterministically
derived as per RFC6979, using SHA256.
@raise Invalid_argument if [k] is unsuitable (leading to r or s being 0).
*)
val verify : key:pub -> string * string -> string -> bool
(** [verify ~key (r, s) digest] verifies that the pair [(r, s)] is the signature
of [digest], the message digest, under the private counterpart to [key]. *)
val massage : key:pub -> string -> string
(** [massage key digest] is the numeric value of [digest] taken modulo [q] and
represented in the leftmost [bits(q)] bits of the result.
Both FIPS.186-4 and RFC6979 specify that only the leftmost [bits(q)] bits of
[digest] are to be taken into account, but some implementations consider the
entire [digest]. In cases where {{!sign}sign} and {{!verify}verify} seem
incompatible with a given implementation (esp. if {{!sign}sign} produces
signatures with the [s] component different from the other
implementation's), it might help to pre-process [digest] using this
function (e.g. [sign ~key (massage ~key:(pub_of_priv key) digest)]). *)
(** [K_gen] can be instantiated over a hashing module to obtain an RFC6979
compliant [k]-generator for that hash. *)
module K_gen (H : Digestif.S) : sig
val generate : key:priv -> string -> Z.t
(** [generate key digest] deterministically takes the given private key and
message digest to a [k] suitable for seeding the signing process. *)
end
end
(** Diffie-Hellman, MODP version. *)
module Dh : sig
(** {1 Diffie-Hellman key exchange} *)
exception Invalid_key
(** Raised if the private key material is degenerate.
The following invariants are checked:
Secret key: [1 < secret < p]
Public key: [1 < public < p-1] && [public <> gg]
*)
type group = private {
p : Z.t ; (** modulus *)
gg : Z.t ; (** generator *)
q : Z.t option ; (** subgroup order; potentially unknown *)
}
(** A DH group. *)
val group : p:Z.t -> gg:Z.t -> ?q:Z.t -> unit ->
(group, [> `Msg of string ]) result
(** [group ~p ~gg ~q ()] constructs a group if [p] is odd, a prime number,
and greater than [zero]. [gg] must be in the range [1 < gg < p]. *)
type secret = private { group : group ; x : Z.t }
(** A private key. *)
val modulus_size : group -> int
(** Bit size of the modulus. *)
val key_of_secret : group -> s:string -> secret * string
(** [key_of_secret group s] is the {!secret} and the corresponding public
key which use [s] as the secret exponent.
@raise Invalid_key if [s] is degenerate. *)
val gen_key : ?g:Mirage_crypto_rng.g -> ?bits:int -> group -> secret * string
(** Generate a random {!secret} and the corresponding public key.
[bits] is the exact bit-size of {!secret} and defaults to a value
dependent on the {!type-group}'s [p].
{b Note} The process might diverge when [bits] is extremely small. *)
val shared : secret -> string -> string option
(** [shared secret public] is [Some shared_key] given a
a previously generated {!secret} (which specifies the [group])
and the other party's public key.
[shared_key] is the unpadded big-endian representation of the shared key.
It is [None] if these invariants do not hold for [public]:
[1 < public < p-1] && [public <> gg]. *)
val gen_group : ?g:Mirage_crypto_rng.g -> bits:int -> unit -> group
(** [gen_group ~g ~bits ()] generates a random {!type-group} with modulus size
[bits]. Uses a safe prime [p = 2q + 1] (with [q] prime) for the modulus
and [2] for the generator, such that [2^q = 1 mod p].
Runtime is on the order of a minute for 1024 bits.
Note that no time masking is done for the modular exponentiation.
{b Note} The process might diverge if there are no suitable groups. This
happens with extremely small [bits] values. *)
(** A small catalog of standardized {!type-group}s. *)
module Group : sig
(** From RFC 2409: *)
val oakley_1 : group
val oakley_2 : group
(** From RFC 3526: *)
val oakley_5 : group
val oakley_14 : group
val oakley_15 : group
val oakley_16 : group
val oakley_17 : group
val oakley_18 : group
(** From RFC 5114: *)
val rfc_5114_1 : group
val rfc_5114_2 : group
val rfc_5114_3 : group
(** From draft-ietf-tls-negotiated-ff-dhe-08 *)
val ffdhe2048 : group
val ffdhe3072 : group
val ffdhe4096 : group
val ffdhe6144 : group
val ffdhe8192 : group
end
end
(** {b Z} Convert Z to big endian string and generate random Z values. *)
module Z_extra : sig
(** {1 Conversion to and from string} *)
val of_octets_be : ?bits:int -> string -> Z.t
(** [of_octets_be ~bits buf] interprets the bit pattern of [buf] as a
{{!Z.t}[t]} in big-endian.
If [~bits] is not given, the operation considers the entire [buf],
otherwise the initial [min ~bits (bit-length buf)] bits of [buf].
Assuming [n] is the number of bits to extract, the [n]-bit in [buf] is
always the least significant bit of the result. Therefore:
{ul
{- if the bit size [k] of [t] is larger than [n], [k - n] most
significant bits in the result are [0]; and}
{- if [k] is smaller than [n], the result contains [k] last of the [n]
first bits of [buf].}} *)
val to_octets_be : ?size:int -> Z.t -> string
(** [to_octets_be ~size t] is the big-endian representation of [t].
If [~size] is not given, it defaults to the minimal number of bytes
needed to represent [t], which is [bits t / 8] rounded up.
The least-significant bit of [t] is always the last bit in the result.
If the size is larger than needed, the output is padded with zero bits.
If it is smaller, the high bits in [t] are dropped. *)
val into_octets_be : Z.t -> bytes -> unit
(** [into_octets_be t buf] writes the big-endian representation of [t] into
[buf]. It behaves like {{!to_octets_be}[to_octets_be]}, with [~size]
spanning the entire [buf]. *)
(** {1 Random generation} *)
val gen : ?g:Mirage_crypto_rng.g -> Z.t -> Z.t
(** [gen ~g n] picks a value in the interval [\[0, n - 1\]] uniformly at random. *)
val gen_r : ?g:Mirage_crypto_rng.g -> Z.t -> Z.t -> Z.t
(** [gen_r ~g low high] picks a value from the interval [\[low, high - 1\]]
uniformly at random. *)
end

430
unikernel/duniverse/mirage-crypto/pk/rsa.ml Normal file
View file

@ -0,0 +1,430 @@
open Mirage_crypto.Uncommon
open Common
let two = Z.(~$2)
and three = Z.(~$3)
(* A constant-time [find_uint8] with a default value. *)
let ct_find_uint8 ~default ?off ~f cs =
let res = Eqaf.find_uint8 ?off ~f cs in
Eqaf.select_int (res + 1) default res
let (&.) f g = fun h -> f (g h)
type 'a or_digest = [ `Message of 'a | `Digest of string ]
module Digest_or (H : Digestif.S) = struct
let digest_or = function
| `Message msg -> H.(digest_string msg |> to_raw_string)
| `Digest digest ->
let n = String.length digest and m = H.digest_size in
if n = m then digest else
invalid_arg "(`Digest _): %d bytes, expecting %d" n m
end
exception Insufficient_key
type pub = { e : Z.t ; n : Z.t }
(* due to PKCS1 *)
let minimum_octets = 12
let minimum_bits = 8 * minimum_octets - 7
let pub ~e ~n =
(* We cannot verify a public key being good (this would require to verify "n"
being the multiplication of two prime numbers - figuring out which primes
were used is the security property of RSA).
but we validate to ensure our usage of powm_sec does not lead to
exceptions, and we avoid tiny public keys where PKCS1 / PSS would lead to
infinite loops or not work due to insufficient space for the header. *)
let* () =
guard Z.(n > zero && is_odd n && numbits n >= minimum_bits)
(`Msg "invalid modulus")
in
let* () = guard Z.(one < e && e < n) (`Msg "invalid exponent") in
(* NOTE that we could check for e being odd, or a prime, or 2^16+1, but
these are not requirements, neither for RSA nor for powm_sec *)
Ok { e ; n }
type priv = {
e : Z.t ; d : Z.t ; n : Z.t ;
p : Z.t ; q : Z.t ; dp : Z.t ; dq : Z.t ; q' : Z.t
}
let valid_prime name p =
guard Z.(p > zero && is_odd p && Z_extra.pseudoprime p)
(`Msg ("invalid prime " ^ name))
let rprime a b = Z.(gcd a b = one)
let valid_e ~e ~p ~q =
let* () =
guard (rprime e (Z.pred p) && rprime e (Z.pred q))
(`Msg "e is not coprime of p and q")
in
guard (Z_extra.pseudoprime e) (`Msg "exponent e is not a pseudoprime")
let priv ~e ~d ~n ~p ~q ~dp ~dq ~q' =
let* _ = pub ~e ~n in
let* () = valid_prime "p" p in
let* () = valid_prime "q" q in
let* () = guard (p <> q) (`Msg "p and q are the same number") in
let* () = valid_e ~e ~p ~q in
(* p and q are prime, and not equal -> multiplicative inverse exists *)
let* () = guard Z.(q' = invert q p) (`Msg "q' <> q ^ -1 mod p") in
let* () = guard Z.(n = p * q) (`Msg "modulus is not the product of p and q") in
let* () = guard Z.(one < d && d < n) (`Msg "invalid private exponent") in
let* () = guard Z.(dp = d mod (pred p)) (`Msg "dp <> d mod (p - 1)") in
let* () = guard Z.(dq = d mod (pred q)) (`Msg "dq <> d mod (q - 1)") in
(* e has been checked (valid_e) to be coprime to p-1 and q-1 ->
muliplicative inverse exists *)
let* () =
guard Z.(one = d * e mod (lcm (pred p) (pred q)))
(`Msg "1 <> d * e mod lcm (p - 1) (q - 1)")
in
Ok { e ; d ; n ; p ; q ; dp ; dq ; q' }
let priv_of_primes ~e ~p ~q =
let* () = valid_prime "p" p in
let* () = valid_prime "q" q in
let* () = guard (p <> q) (`Msg "p and q are the same prime") in
let* () = valid_e ~e ~p ~q in
let n = Z.(p * q) in
let* _ = pub ~e ~n in
(* valid_e checks e coprime to p-1 and q-1, a multiplicative inverse exists *)
let d = Z.(invert e (lcm (pred p) (pred q))) in
let dp = Z.(d mod (pred p))
and dq = Z.(d mod (pred q))
in
(* above we checked that p and q both are primes and not equal -> there
should be a multiplicate inverse *)
let q' = Z.invert q p in
(* does not need to check valid_priv, since it is valid by construction *)
Ok { e; d; n; p; q; dp; dq; q' }
(* Handbook of applied cryptography, 8.2.2 (i). *)
let priv_of_exp ?g ?(attempts=100) ~e ~d ~n () =
let* _ = pub ~e ~n in
let* () = guard Z.(one < d && d < n) (`Msg "invalid private exponent") in
let rec doit ~attempts =
let factor s t =
let rec go ax = function
| 0 -> None
| i' ->
let ax2 = Z.(ax * ax mod n) in
if Z.(ax <> one && ax <> pred n && ax2 = one) then
Some ax
else
go ax2 (i' - 1)
in
Option.map Z.(gcd n &. pred) (go Z.(powm (Z_extra.gen ?g n) t n) s)
in
if attempts > 0 then
let* s, t = Z_extra.strip_factor ~f:two Z.(e * d |> pred) in
match s with
| 0 -> Error (`Msg "invalid factor 0")
| _ -> match factor s t with
| None -> doit ~attempts:(attempts - 1)
| Some p ->
let q = Z.(div n p) in
priv_of_primes ~e ~p:(max p q) ~q:(min p q)
else Error (`Msg "attempts exceeded")
in
doit ~attempts
let rec generate ?g ?(e = Z.(~$0x10001)) ~bits () =
if bits < minimum_bits || e < three ||
(bits <= Z.numbits e || not (Z_extra.pseudoprime e))
then
invalid_arg "Rsa.generate: e: %a, bits: %d" Z.pp_print e bits;
let (pb, qb) = (bits / 2, bits - bits / 2) in
let (p, q) = Z_extra.(prime ?g ~msb:2 pb, prime ?g ~msb:2 qb) in
match priv_of_primes ~e ~p:(max p q) ~q:(min p q) with
| Error _ -> generate ?g ~e ~bits ()
| Ok priv -> priv
let pub_of_priv ({ e; n; _ } : priv) = { e ; n }
let pub_bits ({ n; _ } : pub) = Z.numbits n
and priv_bits ({ n; _ } : priv) = Z.numbits n
type mask = [ `No | `Yes | `Yes_with of Mirage_crypto_rng.g ]
let encrypt_unsafe ~key: ({ e; n } : pub) msg = Z.(powm msg e n)
let decrypt_unsafe ~crt_hardening ~key:({ e; d; n; p; q; dp; dq; q'} : priv) c =
let m1 = Z.(powm_sec c dp p)
and m2 = Z.(powm_sec c dq q) in
(* NOTE: neither erem, nor the multiplications (addition, subtraction) are
guaranteed to be constant time by gmp *)
let h = Z.(erem (q' * (m1 - m2)) p) in
let m = Z.(h * q + m2) in
(* counter Arjen Lenstra's CRT attack by verifying the signature. Since the
public exponent is small, this is not very expensive. Mentioned again
"Factoring RSA keys with TLS Perfect Forward Secrecy" (Weimer, 2015). *)
if not crt_hardening || Z.(powm_sec m e n) = c then
m
else
Z.(powm_sec c d n)
let decrypt_blinded_unsafe ~crt_hardening ?g ~key:({ e; n; _} as key : priv) c =
let r = until (rprime n) (fun _ -> Z_extra.gen_r ?g two n) in
(* since r and n are coprime, there must be a multiplicative inverse *)
let r' = Z.(invert r n) in
let c' = Z.(powm_sec r e n * c mod n) in
let x = decrypt_unsafe ~crt_hardening ~key c' in
Z.(r' * x mod n)
let (encrypt_z, decrypt_z) =
let check_params n msg =
if msg < two then invalid_arg "Rsa: message: %a" Z.pp_print msg;
if n <= msg then raise Insufficient_key in
(fun ~(key : pub) msg -> check_params key.n msg ; encrypt_unsafe ~key msg),
(fun ~crt_hardening ~mask ~(key : priv) msg ->
check_params key.n msg ;
match mask with
| `No -> decrypt_unsafe ~crt_hardening ~key msg
| `Yes -> decrypt_blinded_unsafe ~crt_hardening ~key msg
| `Yes_with g -> decrypt_blinded_unsafe ~crt_hardening ~g ~key msg )
let reformat out f msg =
Z_extra.(of_octets_be msg |> f |> to_octets_be ~size:(out // 8))
let encrypt ~key = reformat (pub_bits key) (encrypt_z ~key)
let decrypt ?(crt_hardening=false) ?(mask=`Yes) ~key =
reformat (priv_bits key) (decrypt_z ~crt_hardening ~mask ~key)
let bx00, bx01 = "\x00", "\x01"
module PKCS1 = struct
let min_pad = 8
(* XXX Generalize this into `Rng.samplev` or something. *)
let generate_with ?g ~f n =
let buf = Bytes.create n
and k = let b = Mirage_crypto_rng.block g in (n // b * b) in
let rec go nonce i j =
if i = n then Bytes.unsafe_to_string buf else
if j = k then go Mirage_crypto_rng.(generate ?g k) i 0 else
match String.get_uint8 nonce j with
| b when f b -> Bytes.set_uint8 buf i b ; go nonce (succ i) (succ j)
| _ -> go nonce i (succ j) in
go Mirage_crypto_rng.(generate ?g k) 0 0
let pad ~mark ~padding k msg =
let pad = padding (k - String.length msg - 3 |> imax min_pad) in
String.concat "" [ bx00 ; mark ; pad ; bx00 ; msg ]
let unpad ~mark ~is_pad buf =
let f = not &. is_pad in
let i = ct_find_uint8 ~default:2 ~off:2 ~f buf in
let c1 = String.get_uint8 buf 0 = 0x00
and c2 = String.get_uint8 buf 1 = mark
and c3 = String.get_uint8 buf i = 0x00
and c4 = min_pad <= i - 2 in
if c1 && c2 && c3 && c4 then
Some (String.sub buf (i + 1) (String.length buf - i - 1))
else None
let pad_01 =
let padding size = String.make size '\xff' in
pad ~mark:"\x01" ~padding
let pad_02 ?g = pad ~mark:"\x02" ~padding:(generate_with ?g ~f:((<>) 0x00))
let unpad_01 = unpad ~mark:0x01 ~is_pad:((=) 0xff)
let unpad_02 = unpad ~mark:0x02 ~is_pad:((<>) 0x00)
let padded pad transform keybits msg =
let n = keybits // 8 in
let p = pad n msg in
if String.length p = n then transform p else raise Insufficient_key
let unpadded unpad transform keybits msg =
if String.length msg = keybits // 8 then
try unpad (transform msg) with Insufficient_key -> None
else None
let sig_encode ?(crt_hardening = true) ?mask ~key msg =
padded pad_01 (decrypt ~crt_hardening ?mask ~key) (priv_bits key) msg
let sig_decode ~key msg =
unpadded unpad_01 (encrypt ~key) (pub_bits key) msg
let encrypt ?g ~key msg =
padded (pad_02 ?g) (encrypt ~key) (pub_bits key) msg
let decrypt ?(crt_hardening = false) ?mask ~key msg =
unpadded unpad_02 (decrypt ~crt_hardening ?mask ~key) (priv_bits key) msg
let asn_of_hash, detect =
let map = [
`MD5, "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10" ;
`SHA1, "\x30\x21\x30\x09\x06\x05\x2b\x0e\x03\x02\x1a\x05\x00\x04\x14" ;
`SHA224, "\x30\x2d\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x04\x05\x00\x04\x1c" ;
`SHA256, "\x30\x31\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x01\x05\x00\x04\x20" ;
`SHA384, "\x30\x41\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x02\x05\x00\x04\x30" ;
`SHA512, "\x30\x51\x30\x0d\x06\x09\x60\x86\x48\x01\x65\x03\x04\x02\x03\x05\x00\x04\x40"
]
in
(fun h -> List.assoc h map),
(fun buf -> List.find_opt (fun (_, d) -> String.starts_with ~prefix:d buf) map)
let sign ?(crt_hardening = true) ?mask ~hash ~key msg =
let module H = (val Digestif.module_of_hash' (hash :> Digestif.hash')) in
let module D = Digest_or(H) in
let msg' = asn_of_hash hash ^ D.digest_or msg in
sig_encode ~crt_hardening ?mask ~key msg'
let verify ~hashp ~key ~signature msg =
let (>>=) = Option.bind
and (>>|) = Fun.flip Option.map
in
Option.value
(sig_decode ~key signature >>= fun buf ->
detect buf >>| fun (hash, asn) ->
let module H = (val Digestif.module_of_hash' (hash :> Digestif.hash')) in
let module D = Digest_or(H) in
hashp hash && Eqaf.equal (asn ^ D.digest_or msg) buf)
~default:false
let min_key hash =
let module H = (val Digestif.module_of_hash' (hash :> Digestif.hash')) in
(String.length (asn_of_hash hash) + H.digest_size + min_pad + 2) * 8 + 1
end
module MGF1 (H : Digestif.S) = struct
let repr n =
let buf = Bytes.create 4 in
Bytes.set_int32_be buf 0 n;
Bytes.unsafe_to_string buf
(* Assumes len < 2^32 * H.digest_size. *)
let mgf ~seed len =
let rec go acc c = function
| 0 -> Bytes.sub (Bytes.concat Bytes.empty (List.rev acc)) 0 len
| n ->
let h = Bytes.create H.digest_size in
H.get_into_bytes (H.feedi_string H.empty (iter2 seed (repr c))) h;
go (h :: acc) Int32.(succ c) (pred n)
in
go [] 0l (len // H.digest_size)
let mask ~seed buf =
let mgf_data = mgf ~seed (String.length buf) in
unsafe_xor_into buf ~src_off:0 mgf_data ~dst_off:0 (String.length buf);
mgf_data
end
module OAEP (H : Digestif.S) = struct
module MGF = MGF1 (H)
let hlen = H.digest_size
let max_msg_bytes k = k - 2 * hlen - 2
let eme_oaep_encode ?g ?(label = "") k msg =
let seed = Mirage_crypto_rng.generate ?g hlen
and pad = String.make (max_msg_bytes k - String.length msg) '\x00' in
let db = String.concat "" [ H.(digest_string label |> to_raw_string) ; pad ; bx01 ; msg ] in
let mdb = Bytes.unsafe_to_string (MGF.mask ~seed db) in
let mseed = Bytes.unsafe_to_string (MGF.mask ~seed:mdb seed) in
String.concat "" [ bx00 ; mseed ; mdb ]
let eme_oaep_decode ?(label = "") msg =
let b0 = String.sub msg 0 1
and ms = String.sub msg 1 hlen
and mdb = String.sub msg (1 + hlen) (String.length msg - 1 - hlen)
in
let db = Bytes.unsafe_to_string (MGF.mask ~seed:(Bytes.unsafe_to_string (MGF.mask ~seed:mdb ms)) mdb) in
let i = ct_find_uint8 ~default:0 ~off:hlen ~f:((<>) 0x00) db in
let c1 = Eqaf.equal (String.sub db 0 hlen) H.(digest_string label |> to_raw_string)
and c2 = String.get_uint8 b0 0 = 0x00
and c3 = String.get_uint8 db i = 0x01 in
if c1 && c2 && c3 then Some (String.sub db (i + 1) (String.length db - i - 1)) else None
let encrypt ?g ?label ~key msg =
let k = pub_bits key // 8 in
if String.length msg > max_msg_bytes k then raise Insufficient_key
else encrypt ~key @@ eme_oaep_encode ?g ?label k msg
let decrypt ?(crt_hardening = false) ?mask ?label ~key em =
let k = priv_bits key // 8 in
if String.length em <> k || max_msg_bytes k < 0 then None else
try eme_oaep_decode ?label @@ decrypt ~crt_hardening ?mask ~key em
with Insufficient_key -> None
(* XXX Review rfc3447 7.1.2 and
* http://archiv.infsec.ethz.ch/education/fs08/secsem/Manger01.pdf
* again for timing properties. *)
(* XXX expose seed for deterministic testing? *)
end
module PSS (H: Digestif.S) = struct
module MGF = MGF1 (H)
module H1 = Digest_or (H)
let hlen = H.digest_size
let bxbc = "\xbc"
let b0mask embits = 0xff lsr ((8 - embits mod 8) mod 8)
let zero_8 = String.make 8 '\x00'
let digest ~salt msg =
H.to_raw_string @@ H.digesti_string @@ iter3 zero_8 (H1.digest_or msg) salt
let emsa_pss_encode ?g slen emlen msg =
let n = emlen // 8
and salt = Mirage_crypto_rng.generate ?g slen in
let h = digest ~salt msg in
let db = String.concat "" [ String.make (n - slen - hlen - 2) '\x00' ; bx01 ; salt ] in
let mdb = MGF.mask ~seed:h db in
Bytes.set_uint8 mdb 0 @@ Bytes.get_uint8 mdb 0 land b0mask emlen ;
String.concat "" [ Bytes.unsafe_to_string mdb ; h ; bxbc ]
let emsa_pss_verify slen emlen em msg =
let mdb = String.sub em 0 (String.length em - hlen - 1)
and h = String.sub em (String.length em - hlen - 1) hlen
and bxx = String.get_uint8 em (String.length em - 1)
in
let db = MGF.mask ~seed:h mdb in
Bytes.set_uint8 db 0 (Bytes.get_uint8 db 0 land b0mask emlen) ;
let db = Bytes.unsafe_to_string db in
let salt = String.sub db (String.length db - slen) slen in
let h' = digest ~salt:salt msg
and i = ct_find_uint8 ~default:0 ~f:((<>) 0x00) db in
let c1 = lnot (b0mask emlen) land String.get_uint8 mdb 0 = 0x00
and c2 = i = String.length em - hlen - slen - 2
and c3 = String.get_uint8 db i = 0x01
and c4 = bxx = 0xbc
and c5 = Eqaf.equal h h' in
c1 && c2 && c3 && c4 && c5
let sufficient_key ~slen kbits =
hlen + slen + 2 <= kbits / 8 (* 8 * (hlen + slen + 1) + 2 <= kbits *)
let sign ?g ?(crt_hardening = false) ?mask ?(slen = hlen) ~key msg =
let b = priv_bits key in
if not (sufficient_key ~slen b) then raise Insufficient_key
else
let msg' = emsa_pss_encode ?g (imax 0 slen) (b - 1) msg in
decrypt ~crt_hardening ?mask ~key msg'
let verify ?(slen = hlen) ~key ~signature msg =
let b = pub_bits key
and s = String.length signature in
s = b // 8 && sufficient_key ~slen b && try
let em = encrypt ~key signature in
let to_see = s - (b - 1) // 8 in
emsa_pss_verify (imax 0 slen) (b - 1) (String.sub em to_see (String.length em - to_see)) msg
with Insufficient_key -> false
end

135
unikernel/duniverse/mirage-crypto/pk/z_extra.ml Normal file
View file

@ -0,0 +1,135 @@
open Mirage_crypto.Uncommon
let bit_bound z = Z.size z * 64
let of_octets_be ?bits buf =
let rec loop acc i = function
| b when b >= 64 ->
let x = String.get_int64_be buf i in
let x = Z.of_int64_unsigned Int64.(shift_right_logical x 8) in
loop Z.(x + acc lsl 56) (i + 7) (b - 56)
| b when b >= 32 ->
let x = String.get_int32_be buf i in
let x = Z.of_int32_unsigned Int32.(shift_right_logical x 8) in
loop Z.(x + acc lsl 24) (i + 3) (b - 24)
| b when b >= 16 ->
let x = Z.of_int (String.get_uint16_be buf i) in
loop Z.(x + acc lsl 16) (i + 2) (b - 16)
| b when b >= 8 ->
let x = Z.of_int (String.get_uint8 buf i) in
loop Z.(x + acc lsl 8 ) (i + 1) (b - 8 )
| b when b > 0 ->
let x = String.get_uint8 buf i and b' = 8 - b in
Z.(of_int x asr b' + acc lsl b)
| _ -> acc in
loop Z.zero 0 @@ match bits with
| None -> String.length buf * 8
| Some b -> imin b (String.length buf * 8)
let byte1 = Z.of_int64 0xffL
and byte2 = Z.of_int64 0xffffL
and byte3 = Z.of_int64 0xffffffL
and byte7 = Z.of_int64 0xffffffffffffffL
let into_octets_be n buf =
let rec write n = function
| i when i >= 7 ->
Bytes.set_int64_be buf (i - 7) Z.(to_int64_unsigned (n land byte7)) ;
write Z.(n asr 56) (i - 7)
| i when i >= 3 ->
Bytes.set_int32_be buf (i - 3) Z.(to_int32_unsigned (n land byte3)) ;
write Z.(n asr 24) (i - 3)
| i when i >= 1 ->
Bytes.set_uint16_be buf (i - 1) Z.(to_int (n land byte2)) ;
write Z.(n asr 16) (i - 2)
| 0 -> Bytes.set_uint8 buf 0 Z.(to_int (n land byte1)) ;
| _ -> ()
in
write n (Bytes.length buf - 1)
let to_octets_be ?size n =
let buf = Bytes.create @@ match size with
| Some s -> imax 0 s
| None -> Z.numbits n // 8 in
into_octets_be n buf;
Bytes.unsafe_to_string buf
(* Handbook of Applied Cryptography, Table 4.4:
* Miller-Rabin rounds for composite probability <= 1/2^80. *)
let pseudoprime z =
let i = match Z.numbits z with
| i when i >= 1300 -> 2
| i when i >= 850 -> 3
| i when i >= 650 -> 4
| i when i >= 350 -> 8
| i when i >= 250 -> 12
| i when i >= 150 -> 18
| _ -> 27 in
Z.probab_prime z i <> 0
(* strip_factor ~f x = (s, t), where x = f^s t *)
let strip_factor ~f x =
let rec go n x =
let (x1, r) = Z.div_rem x f in
if r = Z.zero then go (succ n) x1 else Ok (n, x)
in
if Z.(~$2) <= f then
go 0 x
else
Error (`Msg ("factor_count: f: " ^ Z.to_string f))
let gen ?g n =
if n < Z.one then invalid_arg "Rng.gen: non-positive: %a" Z.pp_print n;
let bs = Mirage_crypto_rng.block g in
let bits = Z.(numbits (pred n)) in
let octets = bits // 8 in
let batch =
if Mirage_crypto_rng.strict g then octets else 2 * octets // bs * bs
in
let rec attempt buf =
if String.length buf >= octets then
let x = of_octets_be ~bits buf in
if x < n then x else attempt (String.sub buf octets (String.length buf - octets))
else attempt (Mirage_crypto_rng.generate ?g batch) in
attempt (Mirage_crypto_rng.generate ?g batch)
let rec gen_r ?g a b =
if Mirage_crypto_rng.strict g then
let x = gen ?g b in if x < a then gen_r ?g a b else x
else Z.(a + gen ?g (b - a))
let set_msb bits buf =
if bits > 0 then
let n = Bytes.length buf in
let rec go width = function
| i when i = n -> ()
| i when width < 8 ->
Bytes.set_uint8 buf i (Bytes.get_uint8 buf i lor (0xff lsl (8 - width)))
| i ->
Bytes.set_uint8 buf i 0xff ;
go (width - 8) (succ i)
in
go bits 0
let gen_bits ?g ?(msb = 0) bits =
let bytelen = bits // 8 in
let buf = Bytes.create bytelen in
Mirage_crypto_rng.generate_into ?g buf ~off:0 bytelen;
set_msb msb buf ;
of_octets_be ~bits (Bytes.unsafe_to_string buf)
(* Invalid combinations of ~bits and ~msb will loop forever, but there is no
* way to quickly determine upfront whether there are any primes in the
* interval.
* XXX Probability is distributed as inter-prime gaps. So?
*)
let rec prime ?g ?(msb = 1) bits =
let p = Z.(nextprime @@ gen_bits ?g ~msb bits) in
if p < Z.(one lsl bits) then p else prime ?g ~msb bits
(* XXX Add ~msb param for p? *)
let rec safe_prime ?g bits =
let q = prime ?g ~msb:1 (bits - 1) in
let p = Z.(q * ~$2 + ~$1) in
if pseudoprime p then (q, p) else safe_prime ?g bits

5
unikernel/duniverse/mirage-crypto/rng/dune Normal file
View file

@ -0,0 +1,5 @@
(library
(name mirage_crypto_rng)
(public_name mirage-crypto-rng)
(libraries mirage-crypto digestif logs)
(private_modules entropy fortuna hmac_drbg rng))

226
unikernel/duniverse/mirage-crypto/rng/entropy.ml Normal file
View file

@ -0,0 +1,226 @@
(*
* Copyright (c) 2014 Hannes Mehnert
* Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
* Copyright (c) 2014-2016 David Kaloper Meršinjak
* Copyright (c) 2015 Citrix Systems Inc
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* * Redistributions of source code must retain the above copyright notice, this
* list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above copyright notice,
* this list of conditions and the following disclaimer in the documentation
* and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
let src = Logs.Src.create "mirage-crypto-rng-entropy" ~doc:"Mirage crypto RNG Entropy"
module Log = (val Logs.src_log src : Logs.LOG)
let rdrand_calls = Atomic.make 0
let rdrand_failures = Atomic.make 0
let rdseed_calls = Atomic.make 0
let rdseed_failures = Atomic.make 0
module Cpu_native = struct
external cycles : unit -> int = "mc_cycle_counter" [@@noalloc]
external rdseed : bytes -> int -> bool = "mc_cpu_rdseed" [@@noalloc]
external rdrand : bytes -> int -> bool = "mc_cpu_rdrand" [@@noalloc]
external rng_type : unit -> int = "mc_cpu_rng_type" [@@noalloc]
let cpu_rng =
match rng_type () with
| 0 -> []
| 1 -> [ `Rdrand ]
| 2 -> [ `Rdseed ]
| 3 -> [ `Rdrand ; `Rdseed ]
| _ -> assert false
end
module S = Set.Make(struct
type t = int * string
(* only the name is relevant for comparison - the idx not *)
let compare ((_a, an) : int * string) ((_b, bn) : int * string) =
String.compare an bn
end)
let _sources = Atomic.make S.empty
type source = Rng.source
let register_source name =
let rec set () =
let sources = Atomic.get _sources in
let n = S.cardinal sources in
let source = (n, name) in
if Atomic.compare_and_set _sources sources (S.add source sources) then
source
else
set ()
in
set ()
let id (idx, _) = idx
let sources () = S.elements (Atomic.get _sources)
let pp_source ppf (idx, name) = Format.fprintf ppf "[%d] %s" idx name
let cpu_rng isn buf off = match isn with
| `Rdseed ->
Atomic.incr rdseed_calls;
let success = Cpu_native.rdseed buf off in
if not success then Atomic.incr rdseed_failures;
success
| `Rdrand ->
Atomic.incr rdrand_calls;
let success = Cpu_native.rdrand buf off in
if not success then Atomic.incr rdrand_failures;
success
let random preferred =
match Cpu_native.cpu_rng with
| [] -> None
| xs when List.mem preferred xs -> Some preferred
| y::_ -> Some y
let write_header source data =
Bytes.set_uint8 data 0 source;
Bytes.set_uint8 data 1 (Bytes.length data - 2)
let header source data =
let hdr = Bytes.create (2 + String.length data) in
Bytes.unsafe_blit_string data 0 hdr 2 (String.length data);
write_header source hdr;
Bytes.unsafe_to_string hdr
(* Note:
* `bootstrap` is not a simple feedback loop. It attempts to exploit CPU-level
* data races that lead to execution-time variability of identical instructions.
* See Whirlwind RNG:
* http://www.ieee-security.org/TC/SP2014/papers/Not-So-RandomNumbersinVirtualizedLinuxandtheWhirlwindRNG.pdf
*)
let whirlwind_bootstrap id =
let outer = 100
and inner_max = 1024
and a = ref 0
in
let buf = Bytes.create (outer * 2 + 2) in
for i = 0 to outer - 1 do
let tsc = Cpu_native.cycles () in
Bytes.set_uint16_le buf ((i + 1) * 2) tsc;
for j = 1 to tsc mod inner_max do
a := tsc / j - !a * i + 1
done
done;
write_header id buf;
Bytes.unsafe_to_string buf
let cpu_rng_bootstrap =
let rdrand_bootstrap id =
let rec go acc = function
| 0 -> acc
| n ->
let buf = Bytes.create 10 in
let r = cpu_rng `Rdrand buf 2 in
write_header id buf;
if not r then
go acc (pred n)
else
go (Bytes.unsafe_to_string buf :: acc) (pred n)
in
let result = go [] 512 |> String.concat "" in
if String.length result = 0 then
failwith "Too many RDRAND failures"
else
result
in
match random `Rdseed with
| None -> Error `Not_supported
| Some `Rdseed ->
let cpu_rng_bootstrap id =
let buf = Bytes.create 10 in
let r = cpu_rng `Rdseed buf 2 in
write_header id buf;
if not r then
if List.mem `Rdrand Cpu_native.cpu_rng then
rdrand_bootstrap id
else
failwith "RDSEED failed, and RDRAND not available"
else
Bytes.unsafe_to_string buf
in
Ok cpu_rng_bootstrap
| Some `Rdrand -> Ok rdrand_bootstrap
let bootstrap id =
match cpu_rng_bootstrap with
| Error `Not_supported -> whirlwind_bootstrap id
| Ok cpu_rng_bootstrap ->
try cpu_rng_bootstrap id with
| Failure f ->
Log.err (fun m -> m "CPU RNG bootstrap failed: %s, using whirlwind" f);
whirlwind_bootstrap id
let interrupt_hook () =
let buf = Bytes.create 4 in
let a = Cpu_native.cycles () in
Bytes.set_int32_le buf 0 (Int32.of_int a) ;
Bytes.unsafe_to_string buf
let timer_accumulator g =
let g = match g with None -> Some (Rng.default_generator ()) | Some g -> Some g in
let source = register_source "timer" in
let `Acc handle = Rng.accumulate g source in
(fun () -> handle (interrupt_hook ()))
let feed_pools g source f =
let g = match g with None -> Some (Rng.default_generator ()) | Some g -> Some g in
let `Acc handle = Rng.accumulate g source in
for _i = 0 to pred (Rng.pools g) do
match f () with
| Ok data -> handle data
| Error `No_random_available ->
(* should we log a message? *)
()
done
let cpu_rng =
match random `Rdrand with
| None -> Error `Not_supported
| Some insn ->
let cpu_rng g =
let randomf = cpu_rng insn
and source =
let s = match insn with `Rdrand -> "rdrand" | `Rdseed -> "rdseed" in
register_source s
in
let f () =
let buf = Bytes.create 8 in
if randomf buf 0 then
Ok (Bytes.unsafe_to_string buf)
else
Error `No_random_available
in
fun () -> feed_pools g source f
in
Ok cpu_rng
let rdrand_calls () = Atomic.get rdrand_calls
let rdrand_failures () = Atomic.get rdrand_failures
let rdseed_calls () = Atomic.get rdseed_calls
let rdseed_failures () = Atomic.get rdseed_failures

126
unikernel/duniverse/mirage-crypto/rng/fortuna.ml Normal file
View file

@ -0,0 +1,126 @@
(* NOTE: when modifying this file, please also check whether
rng/miou/pfortuna.ml needs to be updated. *)
open Mirage_crypto
open Mirage_crypto.Uncommon
module SHAd256 = struct
open Digestif
type t = SHA256.t
type ctx = SHA256.ctx
let empty = SHA256.empty
let get t = SHA256.(get t |> to_raw_string |> digest_string |> to_raw_string)
let digest x = SHA256.(digest_string x |> to_raw_string |> digest_string |> to_raw_string)
let digesti i = SHA256.(digesti_string i |> to_raw_string |> digest_string |> to_raw_string)
let feedi = SHA256.feedi_string
end
let block = 16
(* the minimal amount of bytes in a pool to trigger a reseed *)
let min_pool_size = 64
(* the minimal duration between two reseeds *)
let min_time_duration = 1_000_000_000L
(* number of pools *)
let pools = 32
(* XXX Locking!! *)
type g =
{ mutable ctr : AES.CTR.ctr
; mutable secret : string
; mutable key : AES.CTR.key
; pools : SHAd256.ctx array
; mutable pool0_size : int
; mutable reseed_count : int
; mutable last_reseed : int64
; time : (unit -> int64) option
}
let create ?time () =
let k = String.make 32 '\x00' in
{ ctr = (0L, 0L)
; secret = k
; key = AES.CTR.of_secret k
; pools = Array.make pools SHAd256.empty
; pool0_size = 0
; reseed_count = 0
; last_reseed = 0L
; time
}
let seeded ~g =
let lo, hi = g.ctr in
not (Int64.equal lo 0L && Int64.equal hi 0L)
(* XXX We might want to erase the old key. *)
let set_key ~g sec =
g.secret <- sec ;
g.key <- AES.CTR.of_secret sec
let reseedi ~g iter =
set_key ~g @@ SHAd256.digesti (fun f -> f g.secret; iter f);
g.ctr <- AES.CTR.add_ctr g.ctr 1L
let iter1 a f = f a
let reseed ~g cs = reseedi ~g (iter1 cs)
let generate_rekey ~g buf ~off len =
let b = len // block + 2 in
let n = b * block in
let r = AES.CTR.stream ~key:g.key ~ctr:g.ctr n in
Bytes.unsafe_blit_string r 0 buf off len;
let r2 = String.sub r (n - 32) 32 in
set_key ~g r2 ;
g.ctr <- AES.CTR.add_ctr g.ctr (Int64.of_int b)
let add_pool_entropy g =
if g.pool0_size > min_pool_size then
let should_reseed, now =
match g.time with
| None -> true, 0L
| Some f ->
let now = f () in
Int64.(sub now g.last_reseed > min_time_duration), now
in
if should_reseed then begin
g.reseed_count <- g.reseed_count + 1;
g.last_reseed <- now;
g.pool0_size <- 0;
reseedi ~g @@ fun add ->
for i = 0 to pools - 1 do
if g.reseed_count land ((1 lsl i) - 1) = 0 then
(SHAd256.get g.pools.(i) |> add; g.pools.(i) <- SHAd256.empty)
done
end
let generate_into ~g buf ~off len =
add_pool_entropy g;
if not (seeded ~g) then raise Rng.Unseeded_generator ;
let rec chunk off = function
| i when i <= 0 -> ()
| n ->
let n' = imin n 0x10000 in
generate_rekey ~g buf ~off n';
chunk (off + n') (n - n')
in
chunk off len
let add ~g (source, _) ~pool data =
let buf = Bytes.create 2
and pool = pool land (pools - 1)
and source = source land 0xff in
Bytes.set_uint8 buf 0 source;
Bytes.set_uint8 buf 1 (String.length data);
g.pools.(pool) <- SHAd256.feedi g.pools.(pool) (iter2 (Bytes.unsafe_to_string buf) data);
if pool = 0 then g.pool0_size <- g.pool0_size + String.length data
(* XXX
* Schneier recommends against using generator-imposed pool-seeding schedule
* but it just makes for a horrid api.
*)
let accumulate ~g source =
let pool = ref 0 in
`Acc (fun buf ->
add ~g source ~pool:!pool buf ;
incr pool)

52
unikernel/duniverse/mirage-crypto/rng/hmac_drbg.ml Normal file
View file

@ -0,0 +1,52 @@
module Make (H : Digestif.S) = struct
type g =
{ mutable k : string
; mutable v : string
; mutable seeded : bool
}
let block = H.digest_size
let (bx00, bx01) = "\x00", "\x01"
let k0 = String.make H.digest_size '\x00'
and v0 = String.make H.digest_size '\x01'
let create ?time:_ () = { k = k0 ; v = v0 ; seeded = false }
let seeded ~g = g.seeded
let reseed ~g buf =
let (k, v) = (g.k, g.v) in
let k = H.hmac_string ~key:k @@ String.concat "" [v; bx00; buf] |> H.to_raw_string in
let v = H.hmac_string ~key:k v |> H.to_raw_string in
let k = H.hmac_string ~key:k @@ String.concat "" [v; bx01; buf] |> H.to_raw_string in
let v = H.hmac_string ~key:k v |> H.to_raw_string in
g.k <- k ; g.v <- v ; g.seeded <- true
let generate_into ~g buf ~off len =
if not g.seeded then raise Rng.Unseeded_generator ;
let rec go off k v = function
| 0 -> v
| 1 ->
let v = H.hmac_string ~key:k v |> H.to_raw_string in
let len =
let rem = len mod H.digest_size in
if rem = 0 then H.digest_size else rem
in
Bytes.unsafe_blit_string v 0 buf off len;
v
| i ->
let v = H.hmac_string ~key:k v |> H.to_raw_string in
Bytes.unsafe_blit_string v 0 buf off H.digest_size;
go (off + H.digest_size) k v (pred i)
in
let v = go off g.k g.v Mirage_crypto.Uncommon.(len // H.digest_size) in
g.k <- H.hmac_string ~key:g.k (v ^ bx00) |> H.to_raw_string;
g.v <- H.hmac_string ~key:g.k v |> H.to_raw_string
(* XXX *)
let accumulate ~g:_ = invalid_arg "Implement Hmac_drbg.accumulate..."
let pools = 0
end

5
unikernel/duniverse/mirage-crypto/rng/miou/dune Normal file
View file

@ -0,0 +1,5 @@
(library
(name mirage_crypto_rng_miou_unix)
(public_name mirage-crypto-rng-miou-unix)
(libraries miou miou.unix mirage-crypto mirage-crypto-rng mirage-crypto-rng.unix digestif duration mtime.clock.os logs)
(modules mirage_crypto_rng_miou_unix pfortuna))

101
unikernel/duniverse/mirage-crypto/rng/miou/mirage_crypto_rng_miou_unix.ml Normal file
View file

@ -0,0 +1,101 @@
open Mirage_crypto_rng
module Pfortuna = Pfortuna
type _ Effect.t += Spawn : (unit -> unit) -> unit Effect.t
external reraise : exn -> 'a = "%reraise"
let periodic fn delta =
let rec one () =
fn ();
Miou_unix.sleep (Duration.to_f delta);
one () in
Effect.perform (Spawn one)
let getrandom delta source =
let fn () =
let per_pool = 8 in
let size = per_pool * pools None in
let random = Mirage_crypto_rng_unix.getrandom size in
let idx = ref 0 in
let fn () =
incr idx;
Ok (String.sub random (per_pool * (pred !idx)) per_pool)
in
Entropy.feed_pools None source fn in
periodic fn delta
let getrandom_init i =
let data = Mirage_crypto_rng_unix.getrandom 128 in
Entropy.header i data
let rdrand delta =
match Entropy.cpu_rng with
| Error `Not_supported -> ()
| Ok cpu_rng -> periodic (cpu_rng None) delta
let running = Atomic.make false
let switch fn =
let orphans = Miou.orphans () in
let open Effect.Deep in
let retc = Fun.id in
let exnc = reraise in
let effc : type c. c Effect.t -> ((c, 'r) continuation -> 'r) option
= function
| Spawn fn ->
ignore (Miou.async ~orphans fn);
Some (fun k -> continue k ())
| _ -> None in
match_with fn orphans { retc; exnc; effc }
let default_generator_already_set =
"Mirage_crypto_rng.default_generator has already \
been set (but not via Mirage_crypto_rng_miou). Please check \
that this is intentional"
let miou_generator_already_launched =
"Mirage_crypto_rng_miou.initialize has already been launched \
and a task is already seeding the RNG."
type rng = unit Miou.t
let rec compare_and_set ?(backoff= Miou_backoff.default) t a b =
if Atomic.compare_and_set t a b = false
then compare_and_set ~backoff:(Miou_backoff.once backoff) t a b
let rec clean_up sleep orphans = match Miou.care orphans with
| Some None | None -> Miou_unix.sleep (Duration.to_f sleep); clean_up sleep orphans
| Some (Some prm) -> Miou.await_exn prm; clean_up sleep orphans
let call_if_domain_available fn =
let available = Miou.Domain.available () in
let current = (Stdlib.Domain.self () :> int) in
if current = 0 && available > 0
|| current <> 0 && available > 1
then Miou.call fn
else Miou.async fn
let initialize (type a) ?g ?(sleep= Duration.of_sec 1) (rng : a generator) =
if Atomic.compare_and_set running false true
then begin
let seed =
let init = Entropy.[ bootstrap; whirlwind_bootstrap; bootstrap; getrandom_init ] in
List.mapi (fun i fn -> fn i) init |> String.concat "" in
let () =
try let _ = default_generator () in
Logs.warn (fun m -> m "%s" default_generator_already_set)
with No_default_generator -> () in
let rng = create ?g ~seed ~time:Mtime_clock.elapsed_ns rng in
set_default_generator rng;
call_if_domain_available @@ fun () -> switch @@ fun orphans ->
rdrand sleep;
let source = Entropy.register_source "getrandom" in
getrandom (Int64.mul sleep 10L) source;
clean_up sleep orphans
end else invalid_arg miou_generator_already_launched
let kill prm =
Miou.cancel prm;
compare_and_set running true false;
unset_default_generator ()

47
unikernel/duniverse/mirage-crypto/rng/miou/mirage_crypto_rng_miou_unix.mli Normal file
View file

@ -0,0 +1,47 @@
(** {b RNG} seeding on {b Miou_unix}.
This module initializes a RNG with [getrandom()], and CPU RNG. On BSD system
(FreeBSD, OpenBSD, MacOS) [getentropy()] is used instead of [getrandom()].
On Windows 10 or higher, [BCryptGenRandom()] is used with the default RNG.
Windows 8 or lower are not supported by this library.
*)
module Pfortuna : Mirage_crypto_rng.Generator
(** {b Pfortuna}, a {b domain-safe} CSPRNG
{{: https://www.schneier.com/fortuna.html} proposed} by Schneier. *)
type rng
(** Type of tasks seeding the RNG. *)
val initialize : ?g:'a -> ?sleep:int64 -> 'a Mirage_crypto_rng.generator -> rng
(** [initialize ?g ?sleep (module Generator)] will allow the RNG to operate in a
returned task. This task periodically launches sub-tasks that seed the
engine (using [getrandom()], [getentropy()] or [BCryptGenRandom()] depending
on the system). These sub-tasks must be cleaned periodically (in seconds)
according to the [sleep] parameter given (defaults to 1 second).
The user must then {!val:kill} the returned task at the end of the program
to be sure to clean everything. Otherwise, Miou will complain with the
exception [Still_has_children].
We strongly recommend using {!module:Pfortuna} as an RNG engine rather than
{!module:Mirage_crypto_rng.Fortuna}. The engine is launched in parallel with
the other tasks if at least one domain is available. To ensure that there is
no compromise in the values generated by a {i data-race}, [Pfortuna] is an
{b domain-safe} implementation of Fortuna.
The user cannot make any subsequent calls to [initialize]. In other words,
you can only initialise a single {!type:rng} task. You must {!val:kill} the
returned {!type:rng} if you want to re-initialise the RNG.
A basic usage of [mirage-crypto-rng-miou-unix] is:
{[
let () = Miou_unix.run @@ fun () ->
let rng = Mirage_crypto_rng_miou_unix.(initialize (module Pfortuna)) in
let str = Mirage_crypto_rng.generate 16 in
Format.printf "random: %S\n%!" str;
Mirage_crypto_rng_miou_unix.kill rng
]} *)
val kill : rng -> unit
(** [kill rng] terminates the {i background} task which seeds the RNG. *)

137
unikernel/duniverse/mirage-crypto/rng/miou/pfortuna.ml Normal file
View file

@ -0,0 +1,137 @@
(* Pfortuna is a re-implementation of Fortuna with a mutex. The goal of this
module is to provide a global and domain-safe RNG. The implementation use
[Miou.Mutex] instead of [Mutex] - [Pfortuna] is only available as part of
the [mirage-crypto-rng-miou-unix] package. Thus, in the context of Miou,
[Pfortuna] can be used and recommended in place of [Fortuna], so that the
user can generate random numbers in parallel in several domains.
{[
let () = Miou_unix.run @@ fun () ->
let rng = Mirage_crypto_rng_miou_unix.(initialize (module Pfortuna)) in
...
Mirage_crypto_rng_miou_unix.kill rng
]}
NOTE: when modifying this file, please also check whether rng/fortuna.ml
needs to be updated. *)
open Mirage_crypto
open Mirage_crypto.Uncommon
module SHAd256 = struct
open Digestif
type ctx = SHA256.ctx
let empty = SHA256.empty
let get t = SHA256.(get t |> to_raw_string |> digest_string |> to_raw_string)
let digesti i = SHA256.(digesti_string i |> to_raw_string |> digest_string |> to_raw_string)
let feedi = SHA256.feedi_string
end
let block = 16
(* the minimal amount of bytes in a pool to trigger a reseed *)
let min_pool_size = 64
(* the minimal duration between two reseeds *)
let min_time_duration = 1_000_000_000L
(* number of pools *)
let pools = 32
type t =
{ ctr : AES.CTR.ctr
; secret : string
; key : AES.CTR.key
; pools : SHAd256.ctx array
; pool0_size : int
; reseed_count : int
; last_reseed : int64
; time : (unit -> int64) option
}
type g = Miou.Mutex.t * t ref
let update (m, g) fn = Miou.Mutex.protect m @@ fun () -> g := fn !g
let get (m, g) fn = Miou.Mutex.protect m @@ fun () -> fn !g
let create ?time () =
let secret = String.make 32 '\000' in
let m = Miou.Mutex.create () in
let t =
{ ctr= (0L, 0L); secret; key= AES.CTR.of_secret secret
; pools= Array.make pools SHAd256.empty
; pool0_size= 0
; reseed_count= 0
; last_reseed= 0L
; time } in
(m, { contents= t })
let seeded ~t =
let lo, hi = t.ctr in
not (Int64.equal lo 0L && Int64.equal hi 0L)
let set_key ~t secret =
{ t with secret; key= AES.CTR.of_secret secret }
let reseedi ~t iter =
let t = set_key ~t (SHAd256.digesti (fun fn -> fn t.secret; iter fn)) in
{ t with ctr= AES.CTR.add_ctr t.ctr 1L }
let iter1 a f = f a
let reseed ~t cs = reseedi ~t (iter1 cs)
let generate_rekey ~t buf ~off len =
let b = len // block* 2 in
let n = b * block in
let r = AES.CTR.stream ~key:t.key ~ctr:t.ctr n in
Bytes.unsafe_blit_string r 0 buf off len;
let r2 = String.sub r (n - 32) 32 in
let t = set_key ~t r2 in
{ t with ctr= AES.CTR.add_ctr t.ctr (Int64.of_int b) }
let add_pool_entropy t =
if t.pool0_size > min_pool_size then
let should_reseed, now = match t.time with
| None -> true, 0L
| Some fn ->
let now = fn () in
Int64.(sub now t.last_reseed > min_time_duration), now in
if should_reseed then begin
let t = { t with reseed_count= t.reseed_count + 1
; last_reseed= now
; pool0_size= 0 } in
reseedi ~t @@ fun add ->
for i = 0 to pools - 1 do
if t.reseed_count land ((1 lsl i) - 1) = 0
then (SHAd256.get t.pools.(i) |> add; t.pools.(i) <- SHAd256.empty)
done
end else t else t
let generate_into ~t buf ~off len =
let t = add_pool_entropy t in
if not (seeded ~t) then raise Mirage_crypto_rng.Unseeded_generator;
let rec chunk t off = function
| i when i <= 0 -> t
| n ->
let n' = imin n 0x10000 in
let t = generate_rekey ~t buf ~off n' in
chunk t (off + n') (n - n') in
chunk t off len
let add ~t source ~pool data =
let buf = Bytes.create 2
and pool = pool land (pools - 1)
and source = Mirage_crypto_rng.Entropy.id source land 0xff in
Bytes.set_uint8 buf 0 source;
Bytes.set_uint8 buf 1 (String.length data);
t.pools.(pool) <- SHAd256.feedi t.pools.(pool) (iter2 (Bytes.unsafe_to_string buf) data);
if pool = 0 then { t with pool0_size= t.pool0_size + String.length data } else t
let accumulate ~g source =
let pool = ref 0 in
`Acc (fun buf ->
update g @@ fun t ->
let t = add ~t source ~pool:!pool buf in
incr pool; t)
let reseed ~g cs = update g @@ fun t -> reseed ~t cs
let generate_into ~g buf ~off len = update g @@ fun t -> generate_into ~t buf ~off len
let seeded ~g = get g @@ fun t -> seeded ~t

1
unikernel/duniverse/mirage-crypto/rng/miou/pfortuna.mli Normal file
View file

@ -0,0 +1 @@
include Mirage_crypto_rng.Generator

5
unikernel/duniverse/mirage-crypto/rng/mirage/dune Normal file
View file

@ -0,0 +1,5 @@
(library
(name mirage_crypto_rng_mirage)
(public_name mirage-crypto-rng-mirage)
(libraries lwt mirage-runtime mirage-crypto-rng mirage-sleep mirage-mtime
duration logs))

73
unikernel/duniverse/mirage-crypto/rng/mirage/mirage_crypto_rng_mirage.ml Normal file
View file

@ -0,0 +1,73 @@
(*
* Copyright (c) 2014 Hannes Mehnert
* Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
* Copyright (c) 2014-2016 David Kaloper Meršinjak
* Copyright (c) 2015 Citrix Systems Inc
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* * Redistributions of source code must retain the above copyright notice, this
* list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above copyright notice,
* this list of conditions and the following disclaimer in the documentation
* and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
let src = Logs.Src.create "mirage-crypto-rng-mirage" ~doc:"Mirage crypto RNG mirage"
module Log = (val Logs.src_log src : Logs.LOG)
open Mirage_crypto_rng
let rdrand_task delta =
match Entropy.cpu_rng with
| Error `Not_supported -> ()
| Ok cpu_rng ->
let open Lwt.Infix in
let rdrand = cpu_rng None in
Lwt.async (fun () ->
let rec one () =
rdrand ();
Mirage_sleep.ns delta >>=
one
in
one ())
let bootstrap_functions () =
Entropy.[ bootstrap ; bootstrap ; whirlwind_bootstrap ; bootstrap ]
let running = ref false
let initialize (type a) ?g ?(sleep = Duration.of_sec 1) (rng : a generator) =
if !running then
Lwt.fail_with "entropy collection already running"
else begin
(try
let _ = default_generator () in
Log.warn (fun m -> m "Mirage_crypto_rng.default_generator has already \
been set, check that this call is intentional");
with
No_default_generator -> ());
running := true;
let seed =
List.mapi (fun i f -> f i) (bootstrap_functions ()) |> String.concat ""
in
let rng = create ?g ~seed ~time:Mirage_mtime.elapsed_ns rng in
set_default_generator rng;
rdrand_task sleep;
Mirage_runtime.at_enter_iter (Entropy.timer_accumulator None);
Lwt.return_unit
end

35
unikernel/duniverse/mirage-crypto/rng/mirage/mirage_crypto_rng_mirage.mli Normal file
View file

@ -0,0 +1,35 @@
(*
* Copyright (c) 2014 Hannes Mehnert
* Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
* Copyright (c) 2014-2016 David Kaloper Meršinjak
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* * Redistributions of source code must retain the above copyright notice, this
* list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above copyright notice,
* this list of conditions and the following disclaimer in the documentation
* and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)
val initialize :
?g:'a -> ?sleep:int64 -> 'a Mirage_crypto_rng.generator -> unit Lwt.t
(** [initialize ~g ~sleep generator] sets the default generator to the
[generator] and sets up periodic entropy feeding for that rng. This
function fails ([Lwt.fail]) if it is called a second time. The argument
[~sleep] is measured in ns, and used as sleep between cpu assisted random
number collection. It defaults to one second. *)

5
unikernel/duniverse/mirage-crypto/rng/mirage_crypto_rng.ml Normal file
View file

@ -0,0 +1,5 @@
include Rng
module Fortuna = Fortuna
module Hmac_drbg = Hmac_drbg.Make
module Entropy = Entropy

303
unikernel/duniverse/mirage-crypto/rng/mirage_crypto_rng.mli Normal file
View file

@ -0,0 +1,303 @@
(** {1 Randomness} *)
(** Secure random number generation.
There are several parts of this module:
{ul
{- The {{!Generator}signature} of generator modules, together with a
facility to convert such modules into actual {{!g}generators}, and
functions that operate on this representation.}
{- A global generator instance, which needs to be initialized by calling
{!set_default_generator}.}}
*)
(** {1 Usage notes} *)
(** {b TL;DR} Don't forget to seed; don't maintain your own [g].
For common operations on Unix (independent of your asynchronous task
library, you can use /dev/urandom or getentropy(3) (actually getrandom(3) on
Linux, getentropy() on macOS and BSD systems, BCryptGenRandom on Windows).
Please ensure to call [Mirage_crypto_rng_unix.use_default], or
[Mirage_crypto_rng_unix.use_dev_urandom] (if you only want to use
/dev/urandom), or [Mirage_crypto_rng_unix.use_getentropy] (if you only want
to use getrandom/getentropy/BCryptGenRandom).
For fine-grained control (doing entropy harvesting, etc.), please continue
reading the documentation below. {b Please be aware that the feeding of
Fortuna and producing random numbers is not thread-safe} (it is on Miou_unix
via Pfortuna).
Suitable entropy feeding of generators are provided by other libraries
{{!Mirage_crypto_rng_mirage}mirage-crypto-rng-mirage} (for MirageOS),
and {{!Mirage_crypto_rng_miou_unix}mirage-crypto-miou-unix} (for Miou_unix).
The intention is that "initialize" in the respective sub-library is called
once, which sets the default generator and registers entropy
harvesting asynchronous tasks. The semantics is that the entropy is always
fed to the {{!default_generator}default generator}, which is not necessarily
the one set by "initialize". The reasoning behind this is that the default
generator should be used in most setting, and that should be fed a constant
stream of entropy.
The RNGs here are merely the deterministic part of a full random number
generation suite. For proper operation, they need to be seeded with a
high-quality entropy source.
Although this module exposes a more fine-grained interface, e.g. allowing
manual seeding of generators, this is intended either for implementing
entropy-harvesting modules, or very specialized purposes. Users of this
library should almost certainly use one of the above entropy libraries, and
avoid manually managing the generator seeding.
Similarly, although it is possible to swap the default generator and gain
control over the random stream, this is also intended for specialized
applications such as testing or similar scenarios where the RNG needs to be
fully deterministic (RFC 6979, deterministic usage of DSA), or as a
component of deterministic algorithms which internally rely on pseudorandom
streams.
In the general case, users should not maintain their local instances of
{{!g}g}. All of the generators in a process have to compete for entropy, and
it is likely that the overall result will have lower effective
unpredictability.
The recommended way to use these functions is either to accept an optional
generator and pass it down, or to ignore the generator altogether, as
illustrated in the {{!rng_examples}examples}.
*)
(** {1 Interface} *)
type g
(** A generator (PRNG) with its state. *)
exception Unseeded_generator
(** Thrown when using an uninitialized {{!g}generator}. *)
exception No_default_generator
(** Thrown when {!set_default_generator} has not been called. *)
(** Entropy sources and collection *)
module Entropy : sig
(** Entropy sources. *)
type source
val sources : unit -> source list
(** [sources ()] returns the list of available sources. *)
val pp_source : Format.formatter -> source -> unit
(** [pp_source ppf source] pretty-prints the entropy [source] on [ppf]. *)
val register_source : string -> source
(** [register_source name] registers [name] as entropy source. *)
(** {1 Bootstrap} *)
val whirlwind_bootstrap : int -> string
(** [whirlwind_bootstrap id] exploits CPU-level data races which lead to
execution-time variability. It returns 200 bytes random data prefixed
by [id].
See {{:http://www.ieee-security.org/TC/SP2014/papers/Not-So-RandomNumbersinVirtualizedLinuxandtheWhirlwindRNG.pdf}}
for further details. *)
val cpu_rng_bootstrap : (int -> string, [`Not_supported]) Result.t
(** [cpu_rng_bootstrap id] returns 8 bytes of random data using the CPU
RNG (rdseed). On 32bit platforms, only 4 bytes are filled.
The [id] is used as prefix. If only rdrand is available, the return
value is the concatenation of 512 calls to rdrand.
@raise Failure if rdrand fails 512 times, or if rdseed fails and rdrand
is not available.
*)
val bootstrap : int -> string
(** [bootstrap id] is either [cpu_rng_bootstrap], if the CPU supports it, or
[whirlwind_bootstrap] if not. *)
(** {1 Timer source} *)
val interrupt_hook : unit -> string
(** [interrupt_hook] collects lower bytes from the cycle counter, to be
used for entropy collection in the event loop. *)
val timer_accumulator : g option -> unit -> unit
(** [timer_accumulator g] is the accumulator for the timer source,
applying {!interrupt_hook} on each call. *)
(** {1 Periodic pulled sources} *)
val feed_pools : g option -> source -> (unit -> (string, [ `No_random_available ]) result) -> unit
(** [feed_pools g source f] feeds all pools of [g] using [source] by executing
[f] for each pool. *)
val cpu_rng : (g option -> unit -> unit, [`Not_supported]) Result.t
(** [cpu_rng g] uses the CPU RNG (rdrand or rdseed) to feed all pools
of [g]. It uses {!feed_pools} internally. If neither rdrand nor rdseed
are available, [`Not_supported] is returned. *)
val rdrand_calls : unit -> int
(** [rdrand_calls ()] returns the number of rdrand calls. *)
val rdrand_failures : unit -> int
(** [rdrand_failures ()] returns the number of rdrand failures. *)
val rdseed_calls : unit -> int
(** [rdseed_calls ()] returns the number of rdseed calls. *)
val rdseed_failures : unit -> int
(** [rdseed_failures ()] returns the number of rdseed failures. *)
(**/**)
val id : source -> int
(** [id source] is the identifier used for [source]. *)
val header : int -> string -> string
(** [header id data] constructs a unique header with [id], length of [data],
and [data]. *)
(**/**)
end
(** A single PRNG algorithm. *)
module type Generator = sig
type g
(** State type for this generator. *)
val block : int
(** Internally, this generator's {{!generate}generate} always produces
[k * block] bytes. *)
val create : ?time:(unit -> int64) -> unit -> g
(** Create a new, unseeded {{!g}g}. *)
val generate_into : g:g -> bytes -> off:int -> int -> unit
[@@alert unsafe "Does not do bounds checks. Use Mirage_crypto_rng.generate_into instead."]
(** [generate_into ~g buf ~off n] produces [n] uniformly distributed random
bytes into [buf] at offset [off], updating the state of [g].
Assumes that [buf] is at least [off + n] bytes long. Also assumes that
[off] and [n] are positive integers. Caution: do not use in your
application, use [Mirage_crypto_rng.generate_into] instead.
*)
val reseed : g:g -> string -> unit
(** [reseed ~g bytes] directly updates [g]. Its new state depends both on
[bytes] and the previous state.
A generator is seded after a single application of [reseed]. *)
val accumulate : g:g -> Entropy.source -> [`Acc of string -> unit]
(** [accumulate ~g] is a closure suitable for incrementally feeding
small amounts of environmentally sourced entropy into [g].
Its operation should be fast enough for repeated calling from e.g.
event loops. Systems with several distinct, stable entropy sources
should use stable [source] to distinguish their sources. *)
val seeded : g:g -> bool
(** [seeded ~g] is [true] iff operations won't throw
{{!Unseeded_generator}Unseeded_generator}. *)
val pools : int
(** [pools] is the amount of pools if any. *)
end
type 'a generator = (module Generator with type g = 'a)
(** Ready-to-use RNG algorithms. *)
(** {b Fortuna}, a CSPRNG {{: https://www.schneier.com/fortuna.html} proposed}
by Schneier. *)
module Fortuna : Generator
(** {b HMAC_DRBG}: A NIST-specified RNG based on HMAC construction over the
provided hash. *)
module Hmac_drbg (H : Digestif.S) : Generator
val create : ?g:'a -> ?seed:string -> ?strict:bool ->
?time:(unit -> int64) -> 'a generator -> g
(** [create ~g ~seed ~strict ~time module] uses a module conforming to the
{{!Generator}Generator} signature to instantiate the generic generator
{{!g}g}.
[g] is the state to use, otherwise a fresh one is created.
[seed] can be provided to immediately reseed the generator with.
[strict] puts the generator into a more standards-conformant, but slighty
slower mode. Useful if the outputs need to match published test-vectors.
[time] is used to limit the amount of reseedings. Fortuna uses at most once
every second. *)
val default_generator : unit -> g
(** [default_generator ()] is the default generator. Functions in this module
use this generator when not explicitly supplied one.
@raise No_default_generator if {!set_default_generator} has not been called. *)
val set_default_generator : g -> unit
(** [set_default_generator g] sets the default generator to [g]. This function
must be called once. *)
(**/**)
(* This function is only used by eio to set the default generator to None when
the entropy harvesting tasks are finished. *)
val unset_default_generator : unit -> unit
(** [unset_default_generator ()] sets the default generator to [None]. *)
(**/**)
val generate_into : ?g:g -> bytes -> ?off:int -> int -> unit
(** [generate_into ~g buf ~off len] invokes
{{!Generator.generate_into}generate_into} on [g] or
{{!generator}default generator}. The random data is put into [buf] starting
at [off] (defaults to 0) with [len] bytes.
@raise Invalid_argument if buffer is too small (it must be: [Bytes.length
buf - off >= n]) or [off] or [n] are negative.
*)
val generate : ?g:g -> int -> string
(** Invoke {!generate_into} on [g] or {{!generator}default generator} and a
freshly allocated string. *)
val block : g option -> int
(** {{!Generator.block}Block} size of [g] or
{{!generator}default generator}. *)
(**/**)
(* The following functions expose the seeding interface. They are meant to
* connect the RNG with entropy-providing libraries and subject to change.
* Client applications should not use them directly. *)
val reseed : ?g:g -> string -> unit
val accumulate : g option -> Entropy.source -> [`Acc of string -> unit]
val seeded : g option -> bool
val pools : g option -> int
val strict : g option -> bool
(**/**)
(** {1:rng_examples Examples}
Generating a random 13-byte string:
{[let cs = Rng.generate 13]}
Generating a list of string, passing down an optional {{!g}generator}:
{[let rec f1 ?g ~n i =
if i < 1 then [] else Rng.generate ?g n :: f1 ?g ~n (i - 1)]}
Generating a [Z.t] smaller than [10]:
{[let f2 ?g () = Mirage_crypto_pk.Z_extra.gen ?g Z.(~$10)]}
Creating a local Fortuna instance and using it as a key-derivation function:
{[let f3 secret =
let g = Rng.(create ~seed:secret (module Generators.Fortuna)) in
Rng.generate ~g 32]}
*)

99
unikernel/duniverse/mirage-crypto/rng/rng.ml Normal file
View file

@ -0,0 +1,99 @@
type source = int * string
exception Unseeded_generator
exception No_default_generator
let setup_rng =
"\nPlease setup your default random number generator. On Unix, the best \
path is to call [Mirage_crypto_rng_unix.use_default ()].\
\nBut you can use Fortuna (or any other RNG) and setup the seeding \
(done by default in MirageOS): \
\n\
\nTo initialize the RNG with a default generator, and set up entropy \
collection and periodic reseeding as a background task, do the \
following:\
\n If you are using MirageOS, use the random device in config.ml: \
`let main = Mirage.main \"Unikernel.Main\" (random @-> job)`, \
and `let () = register \"my_unikernel\" [main $ default_random]`. \
\n If you are using miou, execute \
`Mirage_crypto_rng_miou_unix.initialize (module Mirage_crypto_rng.Fortuna)` \
at startup."
let () = Printexc.register_printer (function
| Unseeded_generator ->
Some ("The RNG has not been seeded." ^ setup_rng)
| No_default_generator ->
Some ("The default generator is not yet initialized. " ^ setup_rng)
| _ -> None)
module type Generator = sig
type g
val block : int
val create : ?time:(unit -> int64) -> unit -> g
val generate_into : g:g -> bytes -> off:int -> int -> unit
[@@alert unsafe "Does not do bounds checks. Use Mirage_crypto_rng.generate_into instead."]
val reseed : g:g -> string -> unit
val accumulate : g:g -> source -> [`Acc of string -> unit]
val seeded : g:g -> bool
val pools : int
end
type 'a generator = (module Generator with type g = 'a)
type g = Generator : ('a * bool * 'a generator) -> g
let create (type a) ?g ?seed ?(strict=false) ?time (m : a generator) =
let module M = (val m) in
let g = Option.value g ~default:(M.create ?time ()) in
Option.iter (M.reseed ~g) seed;
Generator (g, strict, m)
let _default_generator = Atomic.make None
let set_default_generator g = Atomic.set _default_generator (Some g)
let unset_default_generator () = Atomic.set _default_generator None
let default_generator () =
match Atomic.get _default_generator with
| None -> raise No_default_generator
| Some g -> g
let get = function Some g -> g | None -> default_generator ()
let generate_into ?(g = default_generator ()) b ?(off = 0) n =
let Generator (g, _, m) = g in
let module M = (val m) in
if off < 0 || n < 0 then
invalid_arg ("negative offset " ^ string_of_int off ^ " or length " ^
string_of_int n);
if Bytes.length b - off < n then
invalid_arg "buffer too short";
begin[@alert "-unsafe"]
M.generate_into ~g b ~off n
end
let generate ?g n =
let data = Bytes.create n in
generate_into ?g data ~off:0 n;
Bytes.unsafe_to_string data
let reseed ?(g = default_generator ()) cs =
let Generator (g, _, m) = g in let module M = (val m) in M.reseed ~g cs
let accumulate g source =
let Generator (g, _, m) = get g in
let module M = (val m) in
M.accumulate ~g source
let seeded g =
let Generator (g, _, m) = get g in let module M = (val m) in M.seeded ~g
let block g =
let Generator (_, _, m) = get g in let module M = (val m) in M.block
let pools g =
let Generator (_, _, m) = get g in let module M = (val m) in M.pools
let strict g =
let Generator (_, s, _) = get g in s

10
unikernel/duniverse/mirage-crypto/rng/unix/discover.ml Normal file
View file

@ -0,0 +1,10 @@
let () =
let open Configurator.V1 in
main ~name:"rng_flags" (fun _t ->
let c_lib_flags =
match Sys.os_type with
| "Win32" | "Cygwin" -> ["-lbcrypt"]
| _ -> []
in
Flags.write_sexp "rng_c_flags.sexp" c_lib_flags
)

30
unikernel/duniverse/mirage-crypto/rng/unix/dune Normal file
View file

@ -0,0 +1,30 @@
(executable
(name discover)
(modules discover)
(libraries dune-configurator))
(rule
(targets rng_c_flags.sexp)
(action
(run ./discover.exe)))
(rule
(targets cflags_warn.sexp)
(action
(run ../../config/cfg.exe)))
(library
(name mirage_crypto_rng_unix)
(public_name mirage-crypto-rng.unix)
(modules mirage_crypto_rng_unix urandom getentropy)
(libraries mirage-crypto-rng unix logs threads.posix)
(foreign_stubs
(language c)
(include_dirs ../../src/native)
(names mc_getrandom_stubs))
(c_library_flags
(:include rng_c_flags.sexp)))
(env
(dev
(c_flags (:include cflags_warn.sexp))))

25
unikernel/duniverse/mirage-crypto/rng/unix/getentropy.ml Normal file
View file

@ -0,0 +1,25 @@
external getrandom_buf : bytes -> int -> int -> unit = "mc_getrandom" [@@noalloc]
type g = unit
(* The maximum value for length is GETENTROPY_MAX for `getentropy`: https://pubs.opengroup.org/onlinepubs/9799919799/functions/getentropy.html
The minimum acceptable value for GETENTROPY_MAX is 256 https://pubs.opengroup.org/onlinepubs/9799919799/basedefs/limits.h.html
The actual implementation may be one of `getrandom`, `getentropy`, or `BCryptGenRandom`, and will internally limit the maximum bytes read in one go and loop as needed if more bytes are requested and we get a short read.
*)
let block = 256
let create ?time:_ () = ()
let generate_into ~g:_ buf ~off len =
getrandom_buf buf off len
let reseed ~g:_ _data = ()
let accumulate ~g:_ _source =
`Acc (fun _data -> ())
let seeded ~g:_ = true
let pools = 0

87
unikernel/duniverse/mirage-crypto/rng/unix/mc_getrandom_stubs.c Normal file
View file

@ -0,0 +1,87 @@
#ifndef _MSC_VER
# include <unistd.h>
#endif
#include "mirage_crypto.h"
#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <caml/unixsupport.h>
#include <caml/bigarray.h>
#if defined(__ANDROID_API__) && __ANDROID_API__ < 28
// on Android 27 and earlier, we use Google's <sys/random.h> recommended arc4random_buf
# include <stdlib.h>
void raw_getrandom (uint8_t *data, size_t len) {
arc4random_buf(data, len);
}
#elif defined(__linux) || defined(__GNU__)
# include <errno.h>
// on Linux and GNU/Hurd, we use getrandom and loop
# if __GLIBC__ && __GLIBC__ <= 2 && __GLIBC_MINOR__ < 25
# include <sys/syscall.h>
# define getrandom(buf, len, flags) syscall(SYS_getrandom, (buf), (len), (flags))
# else
# include <sys/random.h>
# define getrandom(buf, len, flags) getrandom((buf), (len), (flags))
# endif
void raw_getrandom (uint8_t *data, size_t len) {
size_t off = 0;
ssize_t r = 0;
while (off < len) {
r = getrandom(data + off, len - off, 0);
if (r == -1) {
if (errno == EINTR) continue;
else uerror("getrandom", Nothing);
}
off += (size_t)r;
}
}
#elif (defined(__FreeBSD__) || defined(__FreeBSD_kernel__) || defined(__DragonFly__) || defined(__OpenBSD__) || defined(__APPLE__)) || defined(__NetBSD__)
// on BSD and macOS, loop (in pieces of 256) getentropy
#if defined(__APPLE__)
// on macOS, getentropy is defined in sys/random.h (on BSD in unistd.h)
#include <sys/random.h>
#endif
#include <sys/param.h>
void raw_getrandom (uint8_t *data, size_t len) {
size_t rlen = 0;
for (size_t i = 0; i <= len; i += 256) {
rlen = MIN(256, len - i);
if (getentropy(data + i, rlen) == -1) uerror("getentropy", Nothing);
}
}
#elif (defined(_WIN32))
/* There is a choice between using RtlGenRandom and BCryptGenRandom
* here, and Microsoft does not make the choice obvious. It appears
* that RtlGenRandom is best used when older Windows compatibility
* is of concern, but requires some gymnastics around binding it
* with the right calling convention.
*
* Therefore (https://github.com/mirage/mirage-crypto/pull/39) we
* have decided to go with the more modern Windows API with bcrypt,
* and make Windows 10 our minimum supported version of mirage-crypto.
*/
#include <windows.h>
#include <ntstatus.h>
#include <bcrypt.h>
void raw_getrandom(uint8_t *data, size_t len) {
NTSTATUS Status;
Status = BCryptGenRandom(NULL, data, len, BCRYPT_USE_SYSTEM_PREFERRED_RNG);
if (Status != STATUS_SUCCESS)
uerror("BCryptGenRandom", Nothing);
}
#else
#error "Retrieving random data not supported on this platform"
#endif
CAMLprim value mc_getrandom (value buf, value off, value len) {
raw_getrandom(_bp_uint8_off(buf, off), Long_val(len));
return Val_unit;
}

57
unikernel/duniverse/mirage-crypto/rng/unix/mirage_crypto_rng_unix.ml Normal file
View file

@ -0,0 +1,57 @@
open Mirage_crypto_rng
module Urandom = Urandom
module Getentropy = Getentropy
let use_dev_urandom () =
let g = create (module Urandom) in
set_default_generator g
let use_getentropy () =
let g = create (module Getentropy) in
set_default_generator g
let use_default () = use_getentropy ()
let src = Logs.Src.create "mirage-crypto-rng.unix" ~doc:"Mirage crypto RNG Unix"
module Log = (val Logs.src_log src : Logs.LOG)
external getrandom_buf : bytes -> int -> int -> unit = "mc_getrandom" [@@noalloc]
let getrandom_into buf ~off ~len =
getrandom_buf buf off len
let getrandom size =
let buf = Bytes.create size in
getrandom_into buf ~off:0 ~len:size;
Bytes.unsafe_to_string buf
let getrandom_init i =
let data = getrandom 128 in
Entropy.header i data
let running = Atomic.make false
let initialize (type a) ?g (rng : a generator) =
if Atomic.get running then
Log.debug
(fun m -> m "Mirage_crypto_rng_unix.initialize has already been called, \
ignoring this call.")
else begin
(try
let _ = default_generator () in
Log.warn (fun m -> m "Mirage_crypto_rng.default_generator has already \
been set, check that this call is intentional");
with
No_default_generator -> ());
Atomic.set running true ;
let seed =
let init =
Entropy.[ bootstrap ; whirlwind_bootstrap ; bootstrap ; getrandom_init ]
in
List.mapi (fun i f -> f i) init |> String.concat ""
in
let _ = Entropy.register_source "getrandom" in
set_default_generator (create ?g ~seed rng)
end

36
unikernel/duniverse/mirage-crypto/rng/unix/mirage_crypto_rng_unix.mli Normal file
View file

@ -0,0 +1,36 @@
(** {b RNG} seeding on {b Unix}.
This module initializes a Fortuna RNG with [getrandom()], and CPU RNG.
On BSD systems (FreeBSD, OpenBSD, macOS) [getentropy ()] is used instead
of [getrandom ()]. On Windows 10 or higher, [BCryptGenRandom()] is used
with the default RNG. Windows 8 or lower are not supported by this library.
*)
(** [initialize ~g rng] will bring the RNG into a working state. *)
val initialize : ?g:'a -> 'a Mirage_crypto_rng.generator -> unit
[@@deprecated "Use 'Mirage_crypto_rng_unix.use_default ()' instead."]
(** [getrandom size] returns a buffer of [size] filled with random bytes. *)
val getrandom : int -> string
(** A generator that opens /dev/urandom and reads from that file descriptor
data whenever random data is needed. The file descriptor is closed in
[at_exit]. *)
module Urandom : Mirage_crypto_rng.Generator
(** A generator using [getrandom(3)] on Linux, [getentropy(3)] on BSD and macOS,
and [BCryptGenRandom()] on Windows. *)
module Getentropy : Mirage_crypto_rng.Generator
(** [use_default ()] initializes the RNG [Mirage_crypto_rng.default_generator]
with a sensible default, at the moment using [Getentropy]. *)
val use_default : unit -> unit
(** [use_dev_random ()] initializes the RNG
[Mirage_crypto_rng.default_generator] with the [Urandom] generator. This
raises an exception if "/dev/urandom" cannot be opened. *)
val use_dev_urandom : unit -> unit
(** [use_getentropy ()] initializes the RNG [Mirage_crypto_rng.default_generator]
with the [Getentropy] generator. *)
val use_getentropy : unit -> unit

29
unikernel/duniverse/mirage-crypto/rng/unix/urandom.ml Normal file
View file

@ -0,0 +1,29 @@
type g = In_channel.t * Mutex.t
(* The OCaml runtime always reads at least IO_BUFFER_SIZE from an input channel, which is currently 64 KiB *)
let block = 65536
let create ?time:_ () =
let ic = In_channel.open_bin "/dev/urandom"
and mutex = Mutex.create ()
in
at_exit (fun () -> In_channel.close ic);
(ic, mutex)
let generate_into ~g:(ic, m) buf ~off len =
let finally () = Mutex.unlock m in
Mutex.lock m;
Fun.protect ~finally (fun () ->
match In_channel.really_input ic buf off len with
| None -> failwith "couldn't read enough bytes from /dev/urandom"
| Some () -> ())
let reseed ~g:_ _data = ()
let accumulate ~g:_ _source =
`Acc (fun _data -> ())
let seeded ~g:_ = true
let pools = 0

25
unikernel/duniverse/mirage-crypto/src/aead.ml Normal file
View file

@ -0,0 +1,25 @@
module type AEAD = sig
val tag_size : int
type key
val of_secret : string -> key
val authenticate_encrypt : key:key -> nonce:string -> ?adata:string ->
string -> string
val authenticate_decrypt : key:key -> nonce:string -> ?adata:string ->
string -> string option
val authenticate_encrypt_tag : key:key -> nonce:string -> ?adata:string ->
string -> string * string
val authenticate_decrypt_tag : key:key -> nonce:string -> ?adata:string ->
tag:string -> string -> string option
val authenticate_encrypt_into : key:key -> nonce:string ->
?adata:string -> string -> src_off:int -> bytes -> dst_off:int ->
tag_off:int -> int -> unit
val authenticate_decrypt_into : key:key -> nonce:string ->
?adata:string -> string -> src_off:int -> tag_off:int -> bytes ->
dst_off:int -> int -> bool
val unsafe_authenticate_encrypt_into : key:key -> nonce:string ->
?adata:string -> string -> src_off:int -> bytes -> dst_off:int ->
tag_off:int -> int -> unit
val unsafe_authenticate_decrypt_into : key:key -> nonce:string ->
?adata:string -> string -> src_off:int -> tag_off:int -> bytes ->
dst_off:int -> int -> bool
end

152
unikernel/duniverse/mirage-crypto/src/ccm.ml Normal file
View file

@ -0,0 +1,152 @@
open Uncommon
let block_size = 16
let flags bit6 len1 len2 =
bit6 lsl 6 + len1 lsl 3 + len2
let encode_len buf ~off size value =
let rec ass num = function
| 0 -> Bytes.set_uint8 buf off num
| m ->
Bytes.set_uint8 buf (off + m) (num land 0xff);
(ass [@tailcall]) (num lsr 8) (pred m)
in
ass value (pred size)
let set_format buf ?(off = 0) nonce flag_val value =
let n = String.length nonce in
let small_q = 15 - n in
(* first octet block:
0 : flags
1..15 - q : N
16 - q..15 : Q *)
Bytes.set_uint8 buf off flag_val;
Bytes.unsafe_blit_string nonce 0 buf (off + 1) n;
encode_len buf ~off:(off + n + 1) small_q value
let gen_adata a =
let llen, set_llen =
match String.length a with
| x when x < (1 lsl 16 - 1 lsl 8) ->
2, (fun buf off -> Bytes.set_uint16_be buf off x)
| x when Sys.int_size < 32 || x < (1 lsl 32) ->
6, (fun buf off ->
Bytes.set_uint16_be buf off 0xfffe;
Bytes.set_int32_be buf (off + 2) (Int32.of_int x))
| x ->
10, (fun buf off ->
Bytes.set_uint16_be buf off 0xffff;
Bytes.set_int64_be buf (off + 2) (Int64.of_int x))
in
let to_pad =
let leftover = (llen + String.length a) mod block_size in
block_size - leftover
in
llen + String.length a + to_pad,
fun buf off ->
set_llen buf off;
Bytes.unsafe_blit_string a 0 buf (off + llen) (String.length a);
Bytes.unsafe_fill buf (off + llen + String.length a) to_pad '\000'
let gen_ctr nonce i =
let n = String.length nonce in
let small_q = 15 - n in
let flag_val = flags 0 0 (small_q - 1) in
let buf = Bytes.create 16 in
set_format buf nonce flag_val i;
buf
let prepare_header nonce adata plen tlen =
let small_q = 15 - String.length nonce in
let b6 = if String.length adata = 0 then 0 else 1 in
let flag_val = flags b6 ((tlen - 2) / 2) (small_q - 1) in
if String.length adata = 0 then
let hdr = Bytes.create 16 in
set_format hdr nonce flag_val plen;
hdr
else
let len, set = gen_adata adata in
let buf = Bytes.create (16 + len) in
set_format buf nonce flag_val plen;
set buf 16;
buf
type mode = Encrypt | Decrypt
let crypto_core_into ~cipher ~mode ~key ~nonce ~adata src ~src_off dst ~dst_off len =
let cbcheader = prepare_header nonce adata len block_size in
let small_q = 15 - String.length nonce in
let ctr_flag_val = flags 0 0 (small_q - 1) in
let ctrblock i block dst_off =
Bytes.set_uint8 block dst_off ctr_flag_val;
Bytes.unsafe_blit_string nonce 0 block (dst_off + 1) (String.length nonce);
encode_len block ~off:(dst_off + String.length nonce + 1) small_q i;
cipher ~key (Bytes.unsafe_to_string block) ~src_off:dst_off block ~dst_off
in
let cbc iv src_off block dst_off =
unsafe_xor_into iv ~src_off block ~dst_off block_size ;
cipher ~key (Bytes.unsafe_to_string block) ~src_off:dst_off block ~dst_off
in
let iv =
let rec doit iv iv_off block block_off =
match Bytes.length block - block_off with
| 0 -> Bytes.sub iv iv_off block_size
| _ ->
cbc (Bytes.unsafe_to_string iv) iv_off block block_off;
(doit [@tailcall]) block block_off block (block_off + block_size)
in
doit (Bytes.make block_size '\x00') 0 cbcheader 0
in
let rec loop ctr src src_off dst dst_off len =
let cbcblock, cbc_off =
match mode with
| Encrypt -> src, src_off
| Decrypt -> Bytes.unsafe_to_string dst, dst_off
in
if len = 0 then
()
else if len < block_size then begin
let buf = Bytes.make block_size '\x00' in
Bytes.unsafe_blit dst dst_off buf 0 len ;
ctrblock ctr buf 0 ;
Bytes.unsafe_blit buf 0 dst dst_off len ;
unsafe_xor_into src ~src_off dst ~dst_off len ;
Bytes.unsafe_blit_string cbcblock cbc_off buf 0 len ;
Bytes.unsafe_fill buf len (block_size - len) '\x00';
cbc (Bytes.unsafe_to_string buf) 0 iv 0
end else begin
ctrblock ctr dst dst_off ;
unsafe_xor_into src ~src_off dst ~dst_off block_size ;
cbc cbcblock cbc_off iv 0 ;
(loop [@tailcall]) (succ ctr) src (src_off + block_size) dst (dst_off + block_size) (len - block_size)
end
in
loop 1 src src_off dst dst_off len;
iv
let crypto_core ~cipher ~mode ~key ~nonce ~adata data =
let datalen = String.length data in
let dst = Bytes.create datalen in
let t = crypto_core_into ~cipher ~mode ~key ~nonce ~adata data ~src_off:0 dst ~dst_off:0 datalen in
dst, t
let crypto_t t nonce cipher key =
let ctr = gen_ctr nonce 0 in
cipher ~key (Bytes.unsafe_to_string ctr) ~src_off:0 ctr ~dst_off:0 ;
unsafe_xor_into (Bytes.unsafe_to_string ctr) ~src_off:0 t ~dst_off:0 (Bytes.length t)
let unsafe_generation_encryption_into ~cipher ~key ~nonce ~adata src ~src_off dst ~dst_off ~tag_off len =
let t = crypto_core_into ~cipher ~mode:Encrypt ~key ~nonce ~adata src ~src_off dst ~dst_off len in
crypto_t t nonce cipher key ;
Bytes.unsafe_blit t 0 dst tag_off block_size
let unsafe_decryption_verification_into ~cipher ~key ~nonce ~adata src ~src_off ~tag_off dst ~dst_off len =
let tag = String.sub src tag_off block_size in
let t = crypto_core_into ~cipher ~mode:Decrypt ~key ~nonce ~adata src ~src_off dst ~dst_off len in
crypto_t t nonce cipher key ;
Eqaf.equal tag (Bytes.unsafe_to_string t)

162
unikernel/duniverse/mirage-crypto/src/chacha20.ml Normal file
View file

@ -0,0 +1,162 @@
(* Based on https://github.com/abeaumont/ocaml-chacha.git *)
open Uncommon
let block = 64
type key = string
let of_secret a = a
let chacha20_block state idx key_stream =
Native.Chacha.round 10 state key_stream idx
let init ctr ~key ~nonce =
let ctr_off = 48 in
let set_ctr32 b v = Bytes.set_int32_le b ctr_off v
and set_ctr64 b v = Bytes.set_int64_le b ctr_off v
in
let inc32 b = set_ctr32 b (Int32.add (Bytes.get_int32_le b ctr_off) 1l)
and inc64 b = set_ctr64 b (Int64.add (Bytes.get_int64_le b ctr_off) 1L)
in
let s, key, init_ctr, nonce_off, inc =
match String.length key, String.length nonce, Int64.shift_right ctr 32 = 0L with
| 32, 12, true ->
let ctr = Int64.to_int32 ctr in
"expand 32-byte k", key, (fun b -> set_ctr32 b ctr), 52, inc32
| 32, 12, false ->
invalid_arg "Counter too big for IETF mode (32 bit counter)"
| 32, 8, _ ->
"expand 32-byte k", key, (fun b -> set_ctr64 b ctr), 56, inc64
| 16, 8, _ ->
let k = key ^ key in
"expand 16-byte k", k, (fun b -> set_ctr64 b ctr), 56, inc64
| _ -> invalid_arg "Valid parameters are nonce 12 bytes and key 32 bytes \
(counter 32 bit), or nonce 8 byte and key 16 or 32 \
bytes (counter 64 bit)."
in
let state = Bytes.create block in
Bytes.unsafe_blit_string s 0 state 0 16 ;
Bytes.unsafe_blit_string key 0 state 16 32 ;
init_ctr state ;
Bytes.unsafe_blit_string nonce 0 state nonce_off (String.length nonce) ;
state, inc
let crypt_into ~key ~nonce ~ctr src ~src_off dst ~dst_off len =
let state, inc = init ctr ~key ~nonce in
let block_count = len // block in
let last_len =
let last = len mod block in
if last = 0 then block else last
in
let rec loop i = function
| 0 -> ()
| 1 ->
if last_len = block then begin
chacha20_block state (dst_off + i) dst ;
Native.xor_into_bytes src (src_off + i) dst (dst_off + i) block
end else begin
let buf = Bytes.create block in
chacha20_block state 0 buf ;
Native.xor_into_bytes src (src_off + i) buf 0 last_len ;
Bytes.unsafe_blit buf 0 dst (dst_off + i) last_len
end
| n ->
chacha20_block state (dst_off + i) dst ;
Native.xor_into_bytes src (src_off + i) dst (dst_off + i) block ;
inc state;
(loop [@tailcall]) (i + block) (n - 1)
in
loop 0 block_count
let crypt ~key ~nonce ?(ctr = 0L) data =
let l = String.length data in
let res = Bytes.create l in
crypt_into ~key ~nonce ~ctr data ~src_off:0 res ~dst_off:0 l;
Bytes.unsafe_to_string res
module P = Poly1305.It
let tag_size = P.mac_size
let generate_poly1305_key ~key ~nonce =
crypt ~key ~nonce (String.make 32 '\000')
let mac_into ~key ~adata src ~src_off len dst ~dst_off =
let pad16 l =
let len = l mod 16 in
if len = 0 then "" else String.make (16 - len) '\000'
and len_buf =
let data = Bytes.create 16 in
Bytes.set_int64_le data 0 (Int64.of_int (String.length adata));
Bytes.set_int64_le data 8 (Int64.of_int len);
Bytes.unsafe_to_string data
in
let p1 = pad16 (String.length adata) and p2 = pad16 len in
P.unsafe_mac_into ~key [ adata, 0, String.length adata ;
p1, 0, String.length p1 ;
src, src_off, len ;
p2, 0, String.length p2 ;
len_buf, 0, String.length len_buf ]
dst ~dst_off
let unsafe_authenticate_encrypt_into ~key ~nonce ?(adata = "") src ~src_off dst ~dst_off ~tag_off len =
let poly1305_key = generate_poly1305_key ~key ~nonce in
crypt_into ~key ~nonce ~ctr:1L src ~src_off dst ~dst_off len;
mac_into ~key:poly1305_key ~adata (Bytes.unsafe_to_string dst) ~src_off:dst_off len dst ~dst_off:tag_off
let authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len =
if String.length src - src_off < len then
invalid_arg "Chacha20: src length %u - src_off %u < len %u"
(String.length src) src_off len;
if Bytes.length dst - dst_off < len then
invalid_arg "Chacha20: dst length %u - dst_off %u < len %u"
(Bytes.length dst) dst_off len;
if Bytes.length dst - tag_off < tag_size then
invalid_arg "Chacha20: dst length %u - tag_off %u < tag_size %u"
(Bytes.length dst) tag_off tag_size;
unsafe_authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len
let authenticate_encrypt ~key ~nonce ?adata data =
let l = String.length data in
let dst = Bytes.create (l + tag_size) in
unsafe_authenticate_encrypt_into ~key ~nonce ?adata data ~src_off:0 dst ~dst_off:0 ~tag_off:l l;
Bytes.unsafe_to_string dst
let authenticate_encrypt_tag ~key ~nonce ?adata data =
let r = authenticate_encrypt ~key ~nonce ?adata data in
String.sub r 0 (String.length data), String.sub r (String.length data) tag_size
let unsafe_authenticate_decrypt_into ~key ~nonce ?(adata = "") src ~src_off ~tag_off dst ~dst_off len =
let poly1305_key = generate_poly1305_key ~key ~nonce in
let ctag = Bytes.create tag_size in
mac_into ~key:poly1305_key ~adata src ~src_off len ctag ~dst_off:0;
crypt_into ~key ~nonce ~ctr:1L src ~src_off dst ~dst_off len;
Eqaf.equal (String.sub src tag_off tag_size) (Bytes.unsafe_to_string ctag)
let authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len =
if String.length src - src_off < len then
invalid_arg "Chacha20: src length %u - src_off %u < len %u"
(String.length src) src_off len;
if Bytes.length dst - dst_off < len then
invalid_arg "Chacha20: dst length %u - dst_off %u < len %u"
(Bytes.length dst) dst_off len;
if String.length src - tag_off < tag_size then
invalid_arg "Chacha20: src length %u - tag_off %u < tag_size %u"
(String.length src) tag_off tag_size;
unsafe_authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len
let authenticate_decrypt ~key ~nonce ?adata data =
if String.length data < tag_size then
None
else
let l = String.length data - tag_size in
let r = Bytes.create l in
if unsafe_authenticate_decrypt_into ~key ~nonce ?adata data ~src_off:0 ~tag_off:l r ~dst_off:0 l then
Some (Bytes.unsafe_to_string r)
else
None
let authenticate_decrypt_tag ~key ~nonce ?adata ~tag data =
let cdata = data ^ tag in
authenticate_decrypt ~key ~nonce ?adata cdata

614
unikernel/duniverse/mirage-crypto/src/cipher_block.ml Normal file
View file

@ -0,0 +1,614 @@
open Uncommon
module Block = struct
module type Core = sig
type ekey
type dkey
val of_secret : string -> ekey * dkey
val e_of_secret : string -> ekey
val d_of_secret : string -> dkey
val key : int array
val block : int
(* XXX currently unsafe point *)
val encrypt : key:ekey -> blocks:int -> string -> int -> bytes -> int -> unit
val decrypt : key:dkey -> blocks:int -> string -> int -> bytes -> int -> unit
end
module type ECB = sig
type key
val of_secret : string -> key
val key_sizes : int array
val block_size : int
val encrypt : key:key -> string -> string
val decrypt : key:key -> string -> string
val encrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
val decrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
val unsafe_encrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
val unsafe_decrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
end
module type CBC = sig
type key
val of_secret : string -> key
val key_sizes : int array
val block_size : int
val encrypt : key:key -> iv:string -> string -> string
val decrypt : key:key -> iv:string -> string -> string
val next_iv : ?off:int -> string -> iv:string -> string
val encrypt_into : key:key -> iv:string -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
val decrypt_into : key:key -> iv:string -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
val unsafe_encrypt_into : key:key -> iv:string -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
val unsafe_decrypt_into : key:key -> iv:string -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
val unsafe_encrypt_into_inplace : key:key -> iv:string ->
bytes -> dst_off:int -> int -> unit
end
module type CTR = sig
type key
val of_secret : string -> key
val key_sizes : int array
val block_size : int
type ctr
val add_ctr : ctr -> int64 -> ctr
val next_ctr : ?off:int -> string -> ctr:ctr -> ctr
val ctr_of_octets : string -> ctr
val stream : key:key -> ctr:ctr -> int -> string
val encrypt : key:key -> ctr:ctr -> string -> string
val decrypt : key:key -> ctr:ctr -> string -> string
val stream_into : key:key -> ctr:ctr -> bytes -> off:int -> int -> unit
val encrypt_into : key:key -> ctr:ctr -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
val decrypt_into : key:key -> ctr:ctr -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
val unsafe_stream_into : key:key -> ctr:ctr -> bytes -> off:int -> int -> unit
val unsafe_encrypt_into : key:key -> ctr:ctr -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
val unsafe_decrypt_into : key:key -> ctr:ctr -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
end
module type GCM = sig
include Aead.AEAD
val key_sizes : int array
val block_size : int
end
module type CCM16 = sig
include Aead.AEAD
val key_sizes : int array
val block_size : int
end
end
module Counters = struct
module type S = sig
type ctr
val size : int
val add : ctr -> int64 -> ctr
val of_octets : string -> ctr
val unsafe_count_into : ctr -> bytes -> off:int -> blocks:int -> unit
end
module C64be = struct
type ctr = int64
let size = 8
let of_octets cs = String.get_int64_be cs 0
let add = Int64.add
let unsafe_count_into t buf ~off ~blocks =
let ctr = Bytes.create 8 in
Bytes.set_int64_be ctr 0 t;
Native.count8be ~ctr buf ~off ~blocks
end
module C128be = struct
type ctr = int64 * int64
let size = 16
let of_octets cs =
let buf = Bytes.unsafe_of_string cs in
Bytes.(get_int64_be buf 0, get_int64_be buf 8)
let add (w1, w0) n =
let w0' = Int64.add w0 n in
let flip = if Int64.logxor w0 w0' < 0L then w0' > w0 else w0' < w0 in
((if flip then Int64.succ w1 else w1), w0')
let unsafe_count_into (w1, w0) buf ~off ~blocks =
let ctr = Bytes.create 16 in
Bytes.set_int64_be ctr 0 w1; Bytes.set_int64_be ctr 8 w0;
Native.count16be ~ctr buf ~off ~blocks
end
module C128be32 = struct
include C128be
let add (w1, w0) n =
let hi = 0xffffffff00000000L and lo = 0x00000000ffffffffL in
(w1, Int64.(logor (logand hi w0) (add n w0 |> logand lo)))
let unsafe_count_into (w1, w0) buf ~off ~blocks =
let ctr = Bytes.create 16 in
Bytes.set_int64_be ctr 0 w1; Bytes.set_int64_be ctr 8 w0;
Native.count16be4 ~ctr buf ~off ~blocks
end
end
let check_offset ~tag ~buf ~off ~len actual_len =
if off < 0 then
invalid_arg "%s: %s off %u < 0"
tag buf off;
if actual_len - off < len then
invalid_arg "%s: %s length %u - off %u < len %u"
tag buf actual_len off len
[@@inline]
module Modes = struct
module ECB_of (Core : Block.Core) : Block.ECB = struct
type key = Core.ekey * Core.dkey
let (key_sizes, block_size) = Core.(key, block)
let of_secret = Core.of_secret
let unsafe_ecb xform key src src_off dst dst_off len =
xform ~key ~blocks:(len / block_size) src src_off dst dst_off
let ecb xform key src src_off dst dst_off len =
if len mod block_size <> 0 then
invalid_arg "ECB: length %u not of block size" len;
check_offset ~tag:"ECB" ~buf:"src" ~off:src_off ~len (String.length src);
check_offset ~tag:"ECB" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
unsafe_ecb xform key src src_off dst dst_off len
let encrypt_into ~key:(key, _) src ~src_off dst ~dst_off len =
ecb Core.encrypt key src src_off dst dst_off len
let unsafe_encrypt_into ~key:(key, _) src ~src_off dst ~dst_off len =
unsafe_ecb Core.encrypt key src src_off dst dst_off len
let decrypt_into ~key:(_, key) src ~src_off dst ~dst_off len =
ecb Core.decrypt key src src_off dst dst_off len
let unsafe_decrypt_into ~key:(_, key) src ~src_off dst ~dst_off len =
unsafe_ecb Core.decrypt key src src_off dst dst_off len
let encrypt ~key src =
let len = String.length src in
let dst = Bytes.create len in
encrypt_into ~key src ~src_off:0 dst ~dst_off:0 len;
Bytes.unsafe_to_string dst
let decrypt ~key src =
let len = String.length src in
let dst = Bytes.create len in
decrypt_into ~key src ~src_off:0 dst ~dst_off:0 len;
Bytes.unsafe_to_string dst
end
module CBC_of (Core : Block.Core) : Block.CBC = struct
type key = Core.ekey * Core.dkey
let (key_sizes, block_size) = Core.(key, block)
let block = block_size
let of_secret = Core.of_secret
let check_block_size ~iv len =
if String.length iv <> block then
invalid_arg "CBC: IV length %u not of block size" (String.length iv);
if len mod block <> 0 then
invalid_arg "CBC: argument length %u not of block size"
len
[@@inline]
let next_iv ?(off = 0) cs ~iv =
check_block_size ~iv (String.length cs - off) ;
if String.length cs > off then
String.sub cs (String.length cs - block_size) block_size
else iv
let unsafe_encrypt_into_inplace ~key:(key, _) ~iv dst ~dst_off len =
let rec loop iv iv_i dst_i = function
| 0 -> ()
| b ->
Native.xor_into_bytes iv iv_i dst dst_i block ;
Core.encrypt ~key ~blocks:1 (Bytes.unsafe_to_string dst) dst_i dst dst_i ;
(loop [@tailcall]) (Bytes.unsafe_to_string dst) dst_i (dst_i + block) (b - 1)
in
loop iv 0 dst_off (len / block)
let unsafe_encrypt_into ~key ~iv src ~src_off dst ~dst_off len =
Bytes.unsafe_blit_string src src_off dst dst_off len;
unsafe_encrypt_into_inplace ~key ~iv dst ~dst_off len
let encrypt_into ~key ~iv src ~src_off dst ~dst_off len =
check_block_size ~iv len;
check_offset ~tag:"CBC" ~buf:"src" ~off:src_off ~len (String.length src);
check_offset ~tag:"CBC" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
unsafe_encrypt_into ~key ~iv src ~src_off dst ~dst_off len
let encrypt ~key ~iv src =
let dst = Bytes.create (String.length src) in
encrypt_into ~key ~iv src ~src_off:0 dst ~dst_off:0 (String.length src);
Bytes.unsafe_to_string dst
let unsafe_decrypt_into ~key:(_, key) ~iv src ~src_off dst ~dst_off len =
let b = len / block in
if b > 0 then begin
Core.decrypt ~key ~blocks:b src src_off dst dst_off ;
Native.xor_into_bytes iv 0 dst dst_off block ;
Native.xor_into_bytes src src_off dst (dst_off + block) ((b - 1) * block) ;
end
let decrypt_into ~key ~iv src ~src_off dst ~dst_off len =
check_block_size ~iv len;
check_offset ~tag:"CBC" ~buf:"src" ~off:src_off ~len (String.length src);
check_offset ~tag:"CBC" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
unsafe_decrypt_into ~key ~iv src ~src_off dst ~dst_off len
let decrypt ~key ~iv src =
let len = String.length src in
let msg = Bytes.create len in
decrypt_into ~key ~iv src ~src_off:0 msg ~dst_off:0 len;
Bytes.unsafe_to_string msg
end
module CTR_of (Core : Block.Core) (Ctr : Counters.S) :
Block.CTR with type key = Core.ekey and type ctr = Ctr.ctr =
struct
(* FIXME: CTR has more room for speedups. Like stitching. *)
assert (Core.block = Ctr.size)
type key = Core.ekey
type ctr = Ctr.ctr
let (key_sizes, block_size) = Core.(key, block)
let of_secret = Core.e_of_secret
let unsafe_stream_into ~key ~ctr buf ~off len =
let blocks = imax 0 len / block_size in
Ctr.unsafe_count_into ctr buf ~off ~blocks ;
Core.encrypt ~key ~blocks (Bytes.unsafe_to_string buf) off buf off ;
let slack = imax 0 len mod block_size in
if slack <> 0 then begin
let buf' = Bytes.create block_size in
let ctr = Ctr.add ctr (Int64.of_int blocks) in
Ctr.unsafe_count_into ctr buf' ~off:0 ~blocks:1 ;
Core.encrypt ~key ~blocks:1 (Bytes.unsafe_to_string buf') 0 buf' 0 ;
Bytes.unsafe_blit buf' 0 buf (off + blocks * block_size) slack
end
let stream_into ~key ~ctr buf ~off len =
check_offset ~tag:"CTR" ~buf:"buf" ~off ~len (Bytes.length buf);
unsafe_stream_into ~key ~ctr buf ~off len
let stream ~key ~ctr n =
let buf = Bytes.create n in
unsafe_stream_into ~key ~ctr buf ~off:0 n;
Bytes.unsafe_to_string buf
let unsafe_encrypt_into ~key ~ctr src ~src_off dst ~dst_off len =
unsafe_stream_into ~key ~ctr dst ~off:dst_off len;
Uncommon.unsafe_xor_into src ~src_off dst ~dst_off len
let encrypt_into ~key ~ctr src ~src_off dst ~dst_off len =
check_offset ~tag:"CTR" ~buf:"src" ~off:src_off ~len (String.length src);
check_offset ~tag:"CTR" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
unsafe_encrypt_into ~key ~ctr src ~src_off dst ~dst_off len
let encrypt ~key ~ctr src =
let len = String.length src in
let dst = Bytes.create len in
encrypt_into ~key ~ctr src ~src_off:0 dst ~dst_off:0 len;
Bytes.unsafe_to_string dst
let decrypt = encrypt
let decrypt_into = encrypt_into
let unsafe_decrypt_into = unsafe_encrypt_into
let add_ctr = Ctr.add
let next_ctr ?(off = 0) msg ~ctr =
add_ctr ctr (Int64.of_int @@ (String.length msg - off) // block_size)
let ctr_of_octets = Ctr.of_octets
end
module GHASH : sig
type key
val derive : string -> key
val digesti : key:key -> (string Uncommon.iter) -> string
val digesti_off_len : key:key -> (string * int * int) Uncommon.iter -> string
val tagsize : int
end = struct
type key = string
let keysize = Native.GHASH.keysize ()
let tagsize = 16
let derive cs =
assert (String.length cs >= tagsize);
let k = Bytes.create keysize in
Native.GHASH.keyinit cs k;
Bytes.unsafe_to_string k
let digesti_off_len ~key i =
let res = Bytes.make tagsize '\x00' in
i (fun (cs, off, len) -> Native.GHASH.ghash key res cs off len);
Bytes.unsafe_to_string res
let digesti ~key i =
let res = Bytes.make tagsize '\x00' in
i (fun cs -> Native.GHASH.ghash key res cs 0 (String.length cs));
Bytes.unsafe_to_string res
end
module GCM_of (C : Block.Core) : Block.GCM = struct
assert (C.block = 16)
module CTR = CTR_of (C) (Counters.C128be32)
type key = { key : C.ekey ; hkey : GHASH.key }
let tag_size = GHASH.tagsize
let key_sizes, block_size = C.(key, block)
let z128 = String.make block_size '\x00'
let of_secret cs =
let h = Bytes.create block_size in
let key = C.e_of_secret cs in
C.encrypt ~key ~blocks:1 z128 0 h 0;
{ key ; hkey = GHASH.derive (Bytes.unsafe_to_string h) }
let bits64 cs = Int64.of_int (String.length cs * 8)
let pack64s a b =
let cs = Bytes.create 16 in
Bytes.set_int64_be cs 0 a;
Bytes.set_int64_be cs 8 b;
Bytes.unsafe_to_string cs
let counter ~hkey nonce = match String.length nonce with
| 0 -> invalid_arg "GCM: invalid nonce of length 0"
| 12 ->
let (w1, w2) = String.get_int64_be nonce 0, String.get_int32_be nonce 8 in
(w1, Int64.(shift_left (of_int32 w2) 32 |> add 1L))
| _ ->
CTR.ctr_of_octets @@
GHASH.digesti ~key:hkey @@ iter2 nonce (pack64s 0L (bits64 nonce))
let unsafe_tag_into ~key ~hkey ~ctr ?(adata = "") cdata ~off ~len dst ~tag_off =
CTR.unsafe_encrypt_into ~key ~ctr
(GHASH.digesti_off_len ~key:hkey
(iter3 (adata, 0, String.length adata) (cdata, off, len)
(pack64s (bits64 adata) (Int64.of_int (len * 8)), 0, 16)))
~src_off:0 dst ~dst_off:tag_off tag_size
let unsafe_authenticate_encrypt_into ~key:{ key; hkey } ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len =
let ctr = counter ~hkey nonce in
CTR.(unsafe_encrypt_into ~key ~ctr:(add_ctr ctr 1L) src ~src_off dst ~dst_off len);
unsafe_tag_into ~key ~hkey ~ctr ?adata (Bytes.unsafe_to_string dst) ~off:dst_off ~len dst ~tag_off
let authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len =
check_offset ~tag:"GCM" ~buf:"src" ~off:src_off ~len (String.length src);
check_offset ~tag:"GCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
check_offset ~tag:"GCM" ~buf:"dst tag" ~off:tag_off ~len:tag_size (Bytes.length dst);
unsafe_authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len
let authenticate_encrypt ~key ~nonce ?adata data =
let l = String.length data in
let dst = Bytes.create (l + tag_size) in
unsafe_authenticate_encrypt_into ~key ~nonce ?adata data ~src_off:0 dst ~dst_off:0 ~tag_off:l l;
Bytes.unsafe_to_string dst
let authenticate_encrypt_tag ~key ~nonce ?adata data =
let r = authenticate_encrypt ~key ~nonce ?adata data in
String.sub r 0 (String.length data),
String.sub r (String.length data) tag_size
let unsafe_authenticate_decrypt_into ~key:{ key; hkey } ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len =
let ctr = counter ~hkey nonce in
CTR.(unsafe_encrypt_into ~key ~ctr:(add_ctr ctr 1L) src ~src_off dst ~dst_off len);
let ctag = Bytes.create tag_size in
unsafe_tag_into ~key ~hkey ~ctr ?adata src ~off:src_off ~len ctag ~tag_off:0;
Eqaf.equal (String.sub src tag_off tag_size) (Bytes.unsafe_to_string ctag)
let authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len =
check_offset ~tag:"GCM" ~buf:"src" ~off:src_off ~len (String.length src);
check_offset ~tag:"GCM" ~buf:"src tag" ~off:tag_off ~len:tag_size (String.length src);
check_offset ~tag:"GCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
unsafe_authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len
let authenticate_decrypt ~key ~nonce ?adata cdata =
if String.length cdata < tag_size then
None
else
let l = String.length cdata - tag_size in
let data = Bytes.create l in
if unsafe_authenticate_decrypt_into ~key ~nonce ?adata cdata ~src_off:0 ~tag_off:l data ~dst_off:0 l then
Some (Bytes.unsafe_to_string data)
else
None
let authenticate_decrypt_tag ~key ~nonce ?adata ~tag:tag_data cipher =
let cdata = cipher ^ tag_data in
authenticate_decrypt ~key ~nonce ?adata cdata
end
module CCM16_of (C : Block.Core) : Block.CCM16 = struct
assert (C.block = 16)
let tag_size = C.block
type key = C.ekey
let of_secret sec = C.e_of_secret sec
let (key_sizes, block_size) = C.(key, block)
let cipher ~key src ~src_off dst ~dst_off =
C.encrypt ~key ~blocks:1 src src_off dst dst_off
let unsafe_authenticate_encrypt_into ~key ~nonce ?(adata = "") src ~src_off dst ~dst_off ~tag_off len =
Ccm.unsafe_generation_encryption_into ~cipher ~key ~nonce ~adata
src ~src_off dst ~dst_off ~tag_off len
let valid_nonce nonce =
let nsize = String.length nonce in
if nsize < 7 || nsize > 13 then
invalid_arg "CCM: nonce length not between 7 and 13: %u" nsize
let authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len =
check_offset ~tag:"CCM" ~buf:"src" ~off:src_off ~len (String.length src);
check_offset ~tag:"CCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
check_offset ~tag:"CCM" ~buf:"dst tag" ~off:tag_off ~len:tag_size (Bytes.length dst);
valid_nonce nonce;
unsafe_authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len
let authenticate_encrypt ~key ~nonce ?adata cs =
valid_nonce nonce;
let l = String.length cs in
let dst = Bytes.create (l + tag_size) in
unsafe_authenticate_encrypt_into ~key ~nonce ?adata cs ~src_off:0 dst ~dst_off:0 ~tag_off:l l;
Bytes.unsafe_to_string dst
let authenticate_encrypt_tag ~key ~nonce ?adata cs =
let res = authenticate_encrypt ~key ~nonce ?adata cs in
String.sub res 0 (String.length cs), String.sub res (String.length cs) tag_size
let unsafe_authenticate_decrypt_into ~key ~nonce ?(adata = "") src ~src_off ~tag_off dst ~dst_off len =
Ccm.unsafe_decryption_verification_into ~cipher ~key ~nonce ~adata src ~src_off ~tag_off dst ~dst_off len
let authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len =
check_offset ~tag:"CCM" ~buf:"src" ~off:src_off ~len (String.length src);
check_offset ~tag:"CCM" ~buf:"src tag" ~off:tag_off ~len:tag_size (String.length src);
check_offset ~tag:"CCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
valid_nonce nonce;
unsafe_authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len
let authenticate_decrypt ~key ~nonce ?adata data =
if String.length data < tag_size then
None
else
let dlen = String.length data - tag_size in
let dst = Bytes.create dlen in
if authenticate_decrypt_into ~key ~nonce ?adata data ~src_off:0 ~tag_off:dlen dst ~dst_off:0 dlen then
Some (Bytes.unsafe_to_string dst)
else
None
let authenticate_decrypt_tag ~key ~nonce ?adata ~tag cs =
authenticate_decrypt ~key ~nonce ?adata (cs ^ tag)
end
end
module AES = struct
module Core : Block.Core = struct
let key = [| 16; 24; 32 |]
let block = 16
type ekey = string * int
type dkey = string * int
let of_secret_with init key =
let rounds =
match String.length key with
| 16 | 24 | 32 -> String.length key / 4 + 6
| _ -> invalid_arg "AES.of_secret: key length %u" (String.length key)
in
let rk = Bytes.create (Native.AES.rk_s rounds) in
init key rk rounds ;
Bytes.unsafe_to_string rk, rounds
let derive_d ?e buf rk rs = Native.AES.derive_d buf rk rs e
let e_of_secret = of_secret_with Native.AES.derive_e
let d_of_secret = of_secret_with (derive_d ?e:None)
let of_secret secret =
let (e, _) as ekey = e_of_secret secret in
(ekey, of_secret_with (derive_d ~e) secret)
(* XXX arg order ocaml<->c slows down *)
(* XXX bounds checks *)
let encrypt ~key:(e, rounds) ~blocks src off1 dst off2 =
Native.AES.enc src off1 dst off2 e rounds blocks
let decrypt ~key:(d, rounds) ~blocks src off1 dst off2 =
Native.AES.dec src off1 dst off2 d rounds blocks
end
module ECB = Modes.ECB_of (Core)
module CBC = Modes.CBC_of (Core)
module CTR = Modes.CTR_of (Core) (Counters.C128be)
module GCM = Modes.GCM_of (Core)
module CCM16 = Modes.CCM16_of (Core)
end
module DES = struct
module Core : Block.Core = struct
let key = [| 24 |]
let block = 8
type ekey = string
type dkey = string
let k_s = Native.DES.k_s ()
let gen_of_secret ~direction key =
if String.length key <> 24 then
invalid_arg "DES.of_secret: key length %u" (String.length key) ;
let key = Bytes.of_string key in
let keybuf = Bytes.create k_s in
Native.DES.des3key key direction keybuf;
Bytes.unsafe_to_string keybuf
let e_of_secret = gen_of_secret ~direction:0
let d_of_secret = gen_of_secret ~direction:1
let of_secret secret = (e_of_secret secret, d_of_secret secret)
let encrypt ~key ~blocks src off1 dst off2 =
Native.DES.ddes src off1 dst off2 blocks key
let decrypt = encrypt
end
module ECB = Modes.ECB_of (Core)
module CBC = Modes.CBC_of (Core)
module CTR = Modes.CTR_of (Core) (Counters.C64be)
end
let accelerated =
let flags =
(match Native.misc_mode () with 1 -> [`XOR] | _ -> []) @
(match Native.AES.mode () with 1 -> [`AES] | _ -> []) @
(match Native.GHASH.mode () with 1 -> [`GHASH] | _ -> []) in
flags

54
unikernel/duniverse/mirage-crypto/src/cipher_stream.ml Normal file
View file

@ -0,0 +1,54 @@
open Uncommon
module type Stream = sig
type key
type result = { message : string ; key : key }
val of_secret : string -> key
val encrypt : key:key -> string -> result
val decrypt : key:key -> string -> result
end
module ARC4 = struct
type key = int * int * int array
type result = { message : string ; key : key }
let of_secret buf =
let len = String.length buf in
if len < 1 || len > 256 then invalid_arg "ARC4.of_secret: key size %d" len;
let s = Array.init 256 (fun x -> x) in
let rec loop j = function
| 256 -> ()
| i ->
let x = String.get_uint8 buf (i mod len) in
let si = s.(i) in
let j = (j + si + x) land 0xff in
let sj = s.(j) in
s.(i) <- sj ; s.(j) <- si ;
(loop [@tailcall]) j (succ i)
in
( loop 0 0 ; (0, 0, s) )
let encrypt ~key:(i, j, s') buf =
let s = Array.copy s'
and len = String.length buf in
let res = Bytes.create len in
let rec mix i j = function
| n when n = len -> (i, j, s)
| n ->
let i = succ i land 0xff in
let si = s.(i) in
let j = (j + si) land 0xff in
let sj = s.(j) in
s.(i) <- sj ; s.(j) <- si ;
let k = s.((si + sj) land 0xff) in
Bytes.set_uint8 res n (k lxor String.get_uint8 buf n);
(mix [@tailcall]) i j (succ n)
in
let key' = mix i j 0 in
{ key = key' ; message = Bytes.unsafe_to_string res }
let decrypt = encrypt
end

31
unikernel/duniverse/mirage-crypto/src/dune Normal file
View file

@ -0,0 +1,31 @@
(library
(name mirage_crypto)
(public_name mirage-crypto)
(libraries eqaf)
(private_modules aead chacha20 ccm cipher_block cipher_stream native
poly1305 uncommon)
(foreign_stubs
(language c)
(names detect_cpu_features misc misc_sse aes_generic aes_aesni ghash_generic
ghash_pclmul ghash_ctmul des_generic chacha poly1305-donna
entropy_cpu_stubs)
(flags
(:standard)
(:include cflags_optimized.sexp)))
(foreign_stubs
(language c)
(names chacha_generic)
(flags
(:standard)
(:include cflags.sexp))))
(env
(dev
(c_flags (:include cflags_warn.sexp))))
(include_subdirs unqualified)
(rule
(targets cflags.sexp cflags_optimized.sexp cflags_warn.sexp)
(action
(run ../config/cfg.exe)))

6
unikernel/duniverse/mirage-crypto/src/mirage_crypto.ml Normal file
View file

@ -0,0 +1,6 @@
module Uncommon = Uncommon
module Poly1305 = Poly1305.It
module type AEAD = Aead.AEAD
include Cipher_block
module Chacha20 = Chacha20
include Cipher_stream

570
unikernel/duniverse/mirage-crypto/src/mirage_crypto.mli Normal file
View file

@ -0,0 +1,570 @@
(** Simpler crypto
Mirage-crypto is a cryptographic library.
The overarching API principle is simply mapping inputs to outputs, wherever
feasible.
Similar algorithms in the same class (like {{!Hash}hashes} or
{{!Cipher_block}block ciphers}) are presented as distinct modules sharing
the same signature.
The opam package mirage-crypto-rng provides a cryptographically secure
pseudo-random number generator, the package mirage-crypto-pk provides
public key cryptography.
*)
(**/**)
(** A treasure-trove of random utilities.
This is largely an internal API used in related sub-libraries or tests. As
such, it is prone to breakage. *)
module Uncommon : sig
val (//) : int -> int -> int
(** [x // y] is the ceiling division [ceil (x / y)].
[x // y] is [0] for any non-positive [x].
@raise Division_by_zero when [y < 1]. *)
val imin : int -> int -> int
val imax : int -> int -> int
val iter2 : 'a -> 'a -> ('a -> unit) -> unit
val iter3 : 'a -> 'a -> 'a -> ('a -> unit) -> unit
val xor : string -> string -> string
val unsafe_xor_into : string -> src_off:int -> bytes -> dst_off:int -> int -> unit
val invalid_arg : ('a, Format.formatter, unit, unit, unit, 'b) format6 -> 'a
end
(**/**)
(** The poly1305 message authentication code *)
module Poly1305 : sig
type 'a iter = ('a -> unit) -> unit
type t
(** Represents a running mac computation, suitable for appending inputs. *)
val mac_size : int
(** [mac_size] is the size of the output. *)
val empty : key:string -> t
(** [empty] is the empty context with the given [key].
@raise Invalid_argument if key is not 32 bytes. *)
val feed : t -> string -> t
(** [feed t msg] adds the information in [msg] to [t]. *)
val feedi : t -> string iter -> t
(** [feedi t iter] feeds iter into [t]. *)
val get : t -> string
(** [get t] is the mac corresponding to [t]. *)
val mac : key:string -> string -> string
(** [mac ~key msg] is the all-in-one mac computation:
[get (feed (empty ~key) msg)]. *)
val maci : key:string -> string iter -> string
(** [maci ~key iter] is the all-in-one mac computation:
[get (feedi (empty ~key) iter)]. *)
val mac_into : key:string -> (string * int * int) list -> bytes -> dst_off:int -> unit
(** [mac_into ~key datas dst dst_off] computes the [mac] of [datas]. *)
(**/**)
val unsafe_mac_into : key:string -> (string * int * int) list -> bytes -> dst_off:int -> unit
(** [unsafe_mac_into ~key datas dst dst_off] is {!mac_into} without bounds checks. *)
(**/**)
end
(** {1 Symmetric-key cryptography} *)
(** Authenticated encryption with associated data.
This defines a uniform interface of symmetrics cryptographic algorithms
which encrypt, and also protect the integrity of the data. Additional data,
only used for integrity protection, not encrypted and not part of the
ciphertext, can be passed in optionally. This prevents the same ciphertext
being used at a different location. See
{{:https://tools.ietf.org/html/rfc5116}RFC 5116} for further description.
*)
module type AEAD = sig
val tag_size : int
(** The size of the authentication tag. *)
type key
(** The abstract type for the key. *)
val of_secret : string -> key
(** [of_secret secret] constructs the encryption key corresponding to
[secret].
@raise Invalid_argument if the length of [secret] is not a valid key size.
*)
(** {1 Authenticated encryption and decryption with inline tag} *)
val authenticate_encrypt : key:key -> nonce:string -> ?adata:string ->
string -> string
(** [authenticate_encrypt ~key ~nonce ~adata msg] encrypts [msg] with [key]
and [nonce], and appends an authentication tag computed over the encrypted
[msg], using [key], [nonce], and [adata].
@raise Invalid_argument if [nonce] is not of the right size. *)
val authenticate_decrypt : key:key -> nonce:string -> ?adata:string ->
string -> string option
(** [authenticate_decrypt ~key ~nonce ~adata msg] splits [msg] into encrypted
data and authentication tag, computes the authentication tag using [key],
[nonce], and [adata], and decrypts the encrypted data. If the
authentication tags match, the decrypted data is returned.
@raise Invalid_argument if [nonce] is not of the right size. *)
(** {1 Authenticated encryption and decryption with tag provided separately} *)
val authenticate_encrypt_tag : key:key -> nonce:string ->
?adata:string -> string -> string * string
(** [authenticate_encrypt_tag ~key ~nonce ~adata msg] encrypts [msg] with [key]
and [nonce]. The computed authentication tag is returned separately as
second part of the tuple.
@raise Invalid_argument if [nonce] is not of the right size. *)
val authenticate_decrypt_tag : key:key -> nonce:string ->
?adata:string -> tag:string -> string -> string option
(** [authenticate_decrypt ~key ~nonce ~adata ~tag msg] computes the
authentication tag using [key], [nonce], and [adata], and decrypts the
encrypted data. If the authentication tags match, the decrypted data is
returned.
@raise Invalid_argument if [nonce] is not of the right size. *)
(** {1 Authenticated encryption and decryption into existing buffers} *)
val authenticate_encrypt_into : key:key -> nonce:string ->
?adata:string -> string -> src_off:int -> bytes -> dst_off:int ->
tag_off:int -> int -> unit
(** [authenticate_encrypt_into ~key ~nonce ~adata msg ~src_off dst ~dst_off ~tag_off len]
encrypts [len] bytes of [msg] starting at [src_off] with [key] and [nonce]. The output
is put into [dst] at [dst_off], the tag into [dst] at [tag_off].
@raise Invalid_argument if [nonce] is not of the right size.
@raise Invalid_argument if [String.length msg - src_off < len].
@raise Invalid_argument if [Bytes.length dst - dst_off < len].
@raise Invalid_argument if [Bytes.length dst - tag_off < tag_size].
*)
val authenticate_decrypt_into : key:key -> nonce:string ->
?adata:string -> string -> src_off:int -> tag_off:int -> bytes ->
dst_off:int -> int -> bool
(** [authenticate_decrypt_into ~key ~nonce ~adata msg ~src_off ~tag_off dst ~dst_off len]
computes the authentication tag using [key], [nonce], and [adata], and
decrypts the [len] bytes encrypted data from [msg] starting at [src_off] into [dst]
starting at [dst_off]. If the authentication tags match, [true] is
returned, and the decrypted data is in [dst].
@raise Invalid_argument if [nonce] is not of the right size.
@raise Invalid_argument if [String.length msg - src_off < len].
@raise Invalid_argument if [Bytes.length dst - dst_off < len].
@raise Invalid_argument if [String.length msg - tag_off < tag_size]. *)
(**/**)
val unsafe_authenticate_encrypt_into : key:key -> nonce:string ->
?adata:string -> string -> src_off:int -> bytes -> dst_off:int ->
tag_off:int -> int -> unit
(** [unsafe_authenticate_encrypt_into] is {!authenticate_encrypt_into}, but
without bounds checks.
@raise Invalid_argument if [nonce] is not of the right size.
This may cause memory issues if an invariant is violated:
{ul
{- [String.length msg - src_off >= len].}
{- [Bytes.length dst - dst_off >= len].}
{- [Bytes.length dst - tag_off >= tag_size].}} *)
val unsafe_authenticate_decrypt_into : key:key -> nonce:string ->
?adata:string -> string -> src_off:int -> tag_off:int -> bytes ->
dst_off:int -> int -> bool
(** [unsafe_authenticate_decrypt_into] is {!authenticate_decrypt_into}, but
without bounds checks.
@raise Invalid_argument if [nonce] is not of the right size.
This may cause memory issues if an invariant is violated:
{ul
{- [String.length msg - src_off >= len].}
{- [Bytes.length dst - dst_off >= len].}
{- [String.length msg - tag_off >= tag_size].}} *)
(**/**)
end
(** Block ciphers.
Each algorithm, and each mode of operation, is contained in its own separate
module. *)
(** Module types for various block cipher modes of operation. *)
module Block : sig
(** Modes of operation: *)
(** {e Electronic Codebook} "mode". *)
module type ECB = sig
type key
val of_secret : string -> key
(** Construct the encryption key corresponding to [secret].
@raise Invalid_argument if the length of [secret] is not in
{{!key_sizes}[key_sizes]}. *)
val key_sizes : int array
(** Key sizes allowed with this cipher. *)
val block_size : int
(** The size of a single block. *)
val encrypt : key:key -> string -> string
(** [encrypt ~key src] encrypts [src] into a freshly allocated buffer of the
same size using [key].
@raise Invalid_argument if the length of [src] is not a multiple of
{!block_size}. *)
val decrypt : key:key -> string -> string
(** [decrypt ~key src] decrypts [src] into a freshly allocated buffer of the
same size using [key].
@raise Invalid_argument if the length of [src] is not a multiple of
{!block_size}. *)
val encrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
(** [encrypt_into ~key src ~src_off dst dst_off len] encrypts [len] octets
from [src] starting at [src_off] into [dst] starting at [dst_off].
@raise Invalid_argument if [len] is not a multiple of {!block_size}.
@raise Invalid_argument if [src_off < 0 || String.length src - src_off < len].
@raise Invalid_argument if [dst_off < 0 || Bytes.length dst - dst_off < len]. *)
val decrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
(** [decrypt_into ~key src ~src_off dst dst_off len] decrypts [len] octets
from [src] starting at [src_off] into [dst] starting at [dst_off].
@raise Invalid_argument if [len] is not a multiple of {!block_size}.
@raise Invalid_argument if [src_off < 0 || String.length src - src_off < len].
@raise Invalid_argument if [dst_off < 0 || Bytes.length dst - dst_off < len]. *)
(**/**)
val unsafe_encrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
(** [unsafe_encrypt_into] is {!encrypt_into}, but without bounds checks.
This may cause memory issues if an invariant is violated:
{ul
{- [len] must be a multiple of {!block_size},}
{- [src_off >= 0 && String.length src - src_off >= len],}
{- [dst_off >= 0 && Bytes.length dst - dst_off >= len].}} *)
val unsafe_decrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
(** [unsafe_decrypt_into] is {!decrypt_into}, but without bounds checks.
This may cause memory issues if an invariant is violated:
{ul
{- [len] must be a multiple of {!block_size},}
{- [src_off >= 0 && String.length src - src_off >= len],}
{- [dst_off >= 0 && Bytes.length dst - dst_off >= len].}} *)
(**/**)
end
(** {e Cipher-block chaining} mode. *)
module type CBC = sig
type key
val of_secret : string -> key
(** Construct the encryption key corresponding to [secret].
@raise Invalid_argument if the length of [secret] is not in
{{!key_sizes}[key_sizes]}. *)
val key_sizes : int array
(** Key sizes allowed with this cipher. *)
val block_size : int
(** The size of a single block. *)
val encrypt : key:key -> iv:string -> string -> string
(** [encrypt ~key ~iv msg] is [msg] encrypted under [key], using [iv] as the
CBC initialization vector.
@raise Invalid_argument if [iv] is not [block_size], or [msg] is not
[k * block_size] long. *)
val decrypt : key:key -> iv:string -> string -> string
(** [decrypt ~key ~iv msg] is the inverse of [encrypt].
@raise Invalid_argument if [iv] is not [block_size], or [msg] is not
[k * block_size] long. *)
val next_iv : ?off:int -> string -> iv:string -> string
(** [next_iv ~iv ciphertext ~off] is the first [iv] {e following} the
encryption that used [iv] to produce [ciphertext].
For protocols which perform inter-message chaining, this is the [iv]
for the next message.
It is either [iv], when [String.length ciphertext - off = 0], or the
last block of [ciphertext]. Note that
{[encrypt ~iv msg1 || encrypt ~iv:(next_iv ~iv (encrypt ~iv msg1)) msg2
== encrypt ~iv (msg1 || msg2)]}
@raise Invalid_argument if the length of [iv] is not [block_size].
@raise Invalid_argument if the length of [ciphertext] is not a multiple
of [block_size]. *)
val encrypt_into : key:key -> iv:string -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
(** [encrypt_into ~key ~iv src ~src_off dst dst_off len] encrypts [len]
octets from [src] starting at [src_off] into [dst] starting at [dst_off].
@raise Invalid_argument if the length of [iv] is not {!block_size}.
@raise Invalid_argument if [len] is not a multiple of {!block_size}.
@raise Invalid_argument if [src_off < 0 || String.length src - src_off < len].
@raise Invalid_argument if [dst_off < 0 || Bytes.length dst - dst_off < len]. *)
val decrypt_into : key:key -> iv:string -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
(** [decrypt_into ~key ~iv src ~src_off dst dst_off len] decrypts [len]
octets from [src] starting at [src_off] into [dst] starting at [dst_off].
@raise Invalid_argument if the length of [iv] is not {!block_size}.
@raise Invalid_argument if [len] is not a multiple of {!block_size}.
@raise Invalid_argument if [src_off < 0 || String.length src - src_off < len].
@raise Invalid_argument if [dst_off < 0 || Bytes.length dst - dst_off < len]. *)
(**/**)
val unsafe_encrypt_into : key:key -> iv:string -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
(** [unsafe_encrypt_into] is {!encrypt_into}, but without bounds checks.
This may casue memory issues if an invariant is violated:
{ul
{- the length of [iv] must be {!block_size},}
{- [len] must be a multiple of {!block_size},}
{- [src_off >= 0 && String.length src - src_off >= len],}
{- [dst_off >= 0 && Bytes.length dst - dst_off >= len].}} *)
val unsafe_decrypt_into : key:key -> iv:string -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
(** [unsafe_decrypt_into] is {!decrypt_into}, but without bounds checks.
This may casue memory issues if an invariant is violated:
{ul
{- the length of [iv] must be {!block_size},}
{- [len] must be a multiple of {!block_size},}
{- [src_off >= 0 && String.length src - src_off >= len],}
{- [dst_off >= 0 && Bytes.length dst - dst_off >= len].}} *)
val unsafe_encrypt_into_inplace : key:key -> iv:string ->
bytes -> dst_off:int -> int -> unit
(** [unsafe_encrypt_into_inplace] is {!unsafe_encrypt_into}, but assumes
that [dst] already contains the mesage to be encrypted.
This may casue memory issues if an invariant is violated:
{ul
{- the length of [iv] must be {!block_size},}
{- [len] must be a multiple of {!block_size},}
{- [src_off >= 0 && String.length src - src_off >= len],}
{- [dst_off >= 0 && Bytes.length dst - dst_off >= len].}} *)
(**/**)
end
(** {e Counter} mode. *)
module type CTR = sig
type key
val of_secret : string -> key
(** Construct the encryption key corresponding to [secret].
@raise Invalid_argument if the length of [secret] is not in
{{!key_sizes}[key_sizes]}. *)
val key_sizes : int array
(** Key sizes allowed with this cipher. *)
val block_size : int
(** The size of a single block. *)
type ctr
val add_ctr : ctr -> int64 -> ctr
(** [add_ctr ctr n] adds [n] to [ctr]. *)
val next_ctr : ?off:int -> string -> ctr:ctr -> ctr
(** [next_ctr ~off msg ~ctr] is the state of the counter after encrypting or
decrypting [msg] at offset [off] with the counter [ctr].
For protocols which perform inter-message chaining, this is the
counter for the next message.
It is computed as [C.add ctr (ceil (len msg / block_size))]. Note that
if [len msg1 = k * block_size],
{[encrypt ~ctr msg1 || encrypt ~ctr:(next_ctr ~ctr msg1) msg2
== encrypt ~ctr (msg1 || msg2)]}
*)
val ctr_of_octets : string -> ctr
(** [ctr_of_octets buf] converts the value of [buf] into a counter. *)
val stream : key:key -> ctr:ctr -> int -> string
(** [stream ~key ~ctr n] is the raw keystream.
Keystream is the concatenation of successive encrypted counter states.
If [E(x)] is the single block [x] encrypted under [key], then keystream
is the first [n] bytes of
[E(ctr) || E(add ctr 1) || E(add ctr 2) || ...].
Note that
{[stream ~key ~ctr (k * block_size) || stream ~key ~ctr:(add ctr k) x
== stream ~key ~ctr (k * block_size + x)]}
In other words, it is possible to restart a keystream at [block_size]
boundaries by manipulating the counter. *)
val encrypt : key:key -> ctr:ctr -> string -> string
(** [encrypt ~key ~ctr msg] is
[stream ~key ~ctr (len msg) lxor msg]. *)
val decrypt : key:key -> ctr:ctr -> string -> string
(** [decrypt] is [encrypt]. *)
val stream_into : key:key -> ctr:ctr -> bytes -> off:int -> int -> unit
(** [stream_into ~key ~ctr dst ~off len] is the raw key stream put into
[dst] starting at [off].
@raise Invalid_argument if [Bytes.length dst - off < len]. *)
val encrypt_into : key:key -> ctr:ctr -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
(** [encrypt_into ~key ~ctr src ~src_off dst ~dst_off len] produces the
key stream into [dst] at [dst_off], and then xors it with [src] at
[src_off].
@raise Invalid_argument if [dst_off < 0 || Bytes.length dst - dst_off < len].
@raise Invalid_argument if [src_off < 0 || String.length src - src_off < len]. *)
val decrypt_into : key:key -> ctr:ctr -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
(** [decrypt_into] is {!encrypt_into}. *)
(**/**)
val unsafe_stream_into : key:key -> ctr:ctr -> bytes -> off:int -> int -> unit
(** [unsafe_stream_into] is {!stream_into}, but without bounds checks.
This may cause memory issues if the invariant is violated:
{ul
{- [off >= 0 && Bytes.length buf - off >= len].}} *)
val unsafe_encrypt_into : key:key -> ctr:ctr -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
(** [unsafe_encrypt_into] is {!encrypt_into}, but without bounds checks.
This may cause memory issues if an invariant is violated:
{ul
{- [dst_off >= 0 && Bytes.length dst - dst_off >= len],}
{- [src_off >= 0 && String.length src - src_off >= len].}} *)
val unsafe_decrypt_into : key:key -> ctr:ctr -> string -> src_off:int ->
bytes -> dst_off:int -> int -> unit
(** [unsafe_decrypt_into] is {!unsafe_encrypt_into}. *)
(**/**)
end
(** {e Galois/Counter Mode}. *)
module type GCM = sig
include AEAD
val key_sizes : int array
(** Key sizes allowed with this cipher. *)
val block_size : int
(** The size of a single block. *)
end
(** {e Counter with CBC-MAC} mode. *)
module type CCM16 = sig
include AEAD
val key_sizes : int array
(** Key sizes allowed with this cipher. *)
val block_size : int
(** The size of a single block. *)
end
end
module AES : sig
module ECB : Block.ECB
module CBC : Block.CBC
module CTR : Block.CTR with type ctr = int64 * int64
module GCM : Block.GCM
module CCM16 : Block.CCM16
end
module DES : sig
module ECB : Block.ECB
module CBC : Block.CBC
module CTR : Block.CTR with type ctr = int64
end
val accelerated : [`XOR | `AES | `GHASH] list
(** Operations using non-portable, hardware-dependent implementation in
this build of the library. *)
(** The ChaCha20 cipher proposed by D.J. Bernstein. *)
module Chacha20 : sig
include AEAD
val crypt : key:key -> nonce:string -> ?ctr:int64 -> string -> string
(** [crypt ~key ~nonce ~ctr data] generates a ChaCha20 key stream using
the [key], and [nonce]. The [ctr] defaults to 0. The generated key
stream is of the same length as [data], and the output is the XOR
of the key stream and [data]. This implements, depending on the size
of the [nonce] (8 or 12 bytes) both the original specification (where
the counter is 8 byte, same as the nonce) and the IETF RFC 8439
specification (where nonce is 12 bytes, and counter 4 bytes).
@raise Invalid_argument if invalid parameters are provided. Valid
parameters are: [key] must be 32 bytes and [nonce] 12 bytes for the
IETF mode (and counter fit into 32 bits), or [key] must be either 16
bytes or 32 bytes and [nonce] 8 bytes.
*)
end
(** General stream cipher type. *)
module type Stream = sig
type key
type result = { message : string ; key : key }
val of_secret : string -> key
val encrypt : key:key -> string -> result
val decrypt : key:key -> string -> result
end
(** {e Alleged Rivest Cipher 4}. *)
module ARC4 : Stream

51
unikernel/duniverse/mirage-crypto/src/native.ml Normal file
View file

@ -0,0 +1,51 @@
module AES = struct
external enc : string -> int -> bytes -> int -> string -> int -> int -> unit = "mc_aes_enc_bc" "mc_aes_enc" [@@noalloc]
external dec : string -> int -> bytes -> int -> string -> int -> int -> unit = "mc_aes_dec_bc" "mc_aes_dec" [@@noalloc]
external derive_e : string -> bytes -> int -> unit = "mc_aes_derive_e_key" [@@noalloc]
external derive_d : string -> bytes -> int -> string option -> unit = "mc_aes_derive_d_key" [@@noalloc]
external rk_s : int -> int = "mc_aes_rk_size" [@@noalloc]
external mode : unit -> int = "mc_aes_mode" [@@noalloc]
end
module DES = struct
external ddes : string -> int -> bytes -> int -> int -> string -> unit = "mc_des_ddes_bc" "mc_des_ddes" [@@noalloc]
external des3key : bytes -> int -> bytes -> unit = "mc_des_des3key" [@@noalloc]
external k_s : unit -> int = "mc_des_key_size" [@@noalloc]
end
module Chacha = struct
external round : int -> bytes -> bytes -> int -> unit = "mc_chacha_round" [@@noalloc]
end
module Poly1305 = struct
external init : bytes -> string -> unit = "mc_poly1305_init" [@@noalloc]
external update : bytes -> string -> int -> int -> unit = "mc_poly1305_update" [@@noalloc]
external finalize : bytes -> bytes -> int -> unit = "mc_poly1305_finalize" [@@noalloc]
external ctx_size : unit -> int = "mc_poly1305_ctx_size" [@@noalloc]
external mac_size : unit -> int = "mc_poly1305_mac_size" [@@noalloc]
end
module GHASH = struct
external keysize : unit -> int = "mc_ghash_key_size" [@@noalloc]
external keyinit : string -> bytes -> unit = "mc_ghash_init_key" [@@noalloc]
external ghash : string -> bytes -> string -> int -> int -> unit = "mc_ghash" [@@noalloc]
external mode : unit -> int = "mc_ghash_mode" [@@noalloc]
end
(* XXX TODO
* Unsolved: bounds-checked XORs are slowing things down considerably... *)
external xor_into_bytes : string -> int -> bytes -> int -> int -> unit = "mc_xor_into_bytes" [@@noalloc]
external count8be : ctr:bytes -> bytes -> off:int -> blocks:int -> unit = "mc_count_8_be" [@@noalloc]
external count16be : ctr:bytes -> bytes -> off:int -> blocks:int -> unit = "mc_count_16_be" [@@noalloc]
external count16be4 : ctr:bytes -> bytes -> off:int -> blocks:int -> unit = "mc_count_16_be_4" [@@noalloc]
external misc_mode : unit -> int = "mc_misc_mode" [@@noalloc]
external _detect_cpu_features : unit -> unit = "mc_detect_cpu_features" [@@noalloc]
external _detect_entropy : unit -> unit = "mc_entropy_detect"
let () =
_detect_cpu_features ();
_detect_entropy ()

Some files were not shown because too many files have changed in this diff Show more