├── .github └── workflows │ └── test.yml ├── .gitignore ├── .merlin ├── .ocamlformat ├── .test-mirage.sh ├── .travis.yml ├── CHANGES.md ├── LICENSE.md ├── Makefile ├── README.md ├── digestif.opam ├── dune-project ├── fuzz ├── c │ └── dune ├── dune ├── fuzz.ml └── ocaml │ └── dune ├── mirage ├── _tags ├── config.ml └── unikernel.ml ├── src-c ├── digestif.ml ├── digestif_native.ml ├── dune └── native │ ├── bitfn.h │ ├── blake2.c │ ├── blake2b.c │ ├── blake2b.h │ ├── blake2s.c │ ├── blake2s.h │ ├── digestif.h │ ├── md5.c │ ├── md5.h │ ├── misc.c │ ├── ripemd160.c │ ├── ripemd160.h │ ├── sha1.c │ ├── sha1.h │ ├── sha256.c │ ├── sha256.h │ ├── sha3.c │ ├── sha3.h │ ├── sha512.c │ ├── sha512.h │ ├── stubs.c │ ├── whirlpool.c │ └── whirlpool.h ├── src-ocaml ├── baijiu_blake2b.ml ├── baijiu_blake2s.ml ├── baijiu_keccak_256.ml ├── baijiu_md5.ml ├── baijiu_rmd160.ml ├── baijiu_sha1.ml ├── baijiu_sha224.ml ├── baijiu_sha256.ml ├── baijiu_sha3.ml ├── baijiu_sha384.ml ├── baijiu_sha3_224.ml ├── baijiu_sha3_256.ml ├── baijiu_sha3_384.ml ├── baijiu_sha3_512.ml ├── baijiu_sha512.ml ├── baijiu_whirlpool.ml ├── digestif.ml ├── dune └── xor.ml ├── src ├── digestif.mli ├── digestif_bi.ml ├── digestif_by.ml ├── digestif_conv.ml ├── digestif_eq.ml └── dune └── test ├── blake2b.test ├── blake2s.test ├── c └── dune ├── conv ├── dune └── test_conv.ml ├── keccak_256.txt ├── ocaml └── dune ├── sha3_224_fips_202.txt ├── sha3_256_fips_202.txt ├── sha3_384_fips_202.txt ├── sha3_512_fips_202.txt ├── test.ml ├── test_cve.ml └── test_runes.ml /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Cross-platform tests 2 | 3 | on: 4 | pull_request: 5 | push: 6 | branches: 7 | - 'master' 8 | 9 | jobs: 10 | test-with-setup-ocaml: 11 | strategy: 12 | fail-fast: false 13 | matrix: 14 | os: 15 | - windows-latest 16 | - ubuntu-latest 17 | - macos-latest 18 | ocaml-compiler: 19 | - '4.13.x' 20 | runs-on: ${{ matrix.os }} 21 | name: test-ocaml / ${{ matrix.os }}-${{ matrix.ocaml-compiler }} 22 | steps: 23 | - name: Checkout code 24 | uses: actions/checkout@v4 25 | 26 | - name: Hack Git CRLF for ocaml/setup-ocaml issue #529 27 | if: ${{ startsWith(matrix.os, 'windows-') }} 28 | run: | 29 | & "C:\Program Files\Git\bin\git.exe" config --system core.autocrlf input 30 | 31 | - name: OCaml ${{ matrix.ocaml-compiler }} with Dune cache 32 | uses: ocaml/setup-ocaml@v3 33 | if: ${{ !startsWith(matrix.os, 'windows-') }} 34 | with: 35 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 36 | dune-cache: true 37 | - name: OCaml ${{ matrix.ocaml-compiler }} without Dune cache 38 | uses: ocaml/setup-ocaml@v3 39 | if: ${{ startsWith(matrix.os, 'windows-') }} 40 | with: 41 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 42 | dune-cache: false 43 | - name: Install/build/test 44 | run: | 45 | opam install . --deps-only --with-test 46 | opam exec -- dune build --display=short 47 | opam exec -- dune runtest --display=short 48 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | setup.data 3 | setup.log 4 | doc/*.html 5 | *.native 6 | *.byte 7 | *.so 8 | lib/decompress_conf.ml 9 | *.tar.gz 10 | _tests 11 | lib_test/files 12 | zpipe 13 | c/dpipe 14 | *.install 15 | *~ 16 | .merlin 17 | _opam 18 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | S common 2 | S src-c 3 | S src-ocaml 4 | 5 | B _build/** 6 | 7 | PKG ocamlbuild alcotest 8 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.21.0 2 | break-infix = fit-or-vertical 3 | parse-docstrings = true 4 | indicate-multiline-delimiters=no 5 | nested-match=align 6 | sequence-style=separator 7 | break-before-in=auto 8 | if-then-else=keyword-first 9 | dock-collection-brackets=true 10 | break-collection-expressions=wrap 11 | -------------------------------------------------------------------------------- /.test-mirage.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -ex 4 | 5 | opam install -y mirage 6 | (cd mirage && mirage configure -t unix && make depends && mirage build && ./digestif_test && mirage clean && cd ..) || exit 1 7 | (cd mirage && mirage configure -t hvt && make depends && mirage build && mirage clean && cd ..) || exit 1 8 | if [ $(uname -m) = "amd64" ] || [ $(uname -m) = "x86_64" ]; then 9 | (cd mirage && mirage configure -t xen && make depend && mirage build && mirage clean && cd ..) || exit 1 10 | fi 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | install: 3 | - wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh 4 | - wget https://raw.githubusercontent.com/dinosaure/ocaml-travisci-skeleton/master/.travis-docgen.sh 5 | script: bash -ex .travis-opam.sh 6 | sudo: true 7 | env: 8 | global: 9 | - PACKAGE=digestif 10 | matrix: 11 | - OCAML_VERSION=4.03 12 | - OCAML_VERSION=4.04 13 | - OCAML_VERSION=4.05 14 | - OCAML_VERSION=4.06 15 | - OCAML_VERSION=4.07 16 | - OCAML_VERSION=4.08 DEPOPTS="ocaml-freestanding" 17 | - OCAML_VERSION=4.08 18 | - OCAML_VERSION=4.09 TESTS=false POST_INSTALL_HOOK=./.test-mirage.sh 19 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ### v1.3.0 2025-04-14 Paris (France) 2 | 3 | - Use `CAMLextern` rather than `extern` in `caml_*` forward declarations to 4 | support bytecode linking on Windows (@jonahbeckford, #157) 5 | - Add `x-maintenance-intent` into OPAM file (@hannesm, #158) 6 | - Implement _feedable_ hmac (@reynir, #155) 7 | 8 | ### v1.2.0 2024-03-18 Paris (France) 9 | 10 | - Update the description to include SHA3 (@Leonidas-from-XIV, #146) 11 | - Add a new type `hash'`, a polymorphic variant (@reynir, @dinosaure, #150) 12 | - Lint `fmt` dependency lower-bound (@reynir, #152) 13 | - Add `get_into_bytes` function and a fuzzer about it (@reynir, @dinosaure, #149) 14 | 15 | ### v1.1.4 2023-03-23 Paris (France) 16 | 17 | - Add a test about CVE-2022-37454 (@dinosaure, #143) 18 | - Lint the distribution and delete the `pkg-config` dependency (@dinosuare, 1eff5c5) 19 | - Fix primitives used for bytes and fix the support of `js_of_ocaml` 5 (@hhugo, #144) 20 | 21 | ### v1.1.3 2022-10-20 Paris (France) 22 | 23 | - Support MSVC compiler (@jonahbeckford, #137) 24 | - Fix CI on Windows (`test_conv.ml` requires `/dev/urandom`) (@dinosaure, #138) 25 | - Fix threads support (@dinosaure, #140) 26 | - Delete the META trick needed for MirageOS 3 when we install `digestif` (@dinosaure, #141) 27 | This version of `digestif` breaks the compatibility with MirageOS 3 28 | and `ocaml-freestanding`. This PR should unlock the ability to 29 | use `dune-cache`. 30 | 31 | ### v1.1.2 2022-04-08 Paris (France) 32 | 33 | - Minor update on the README.md (@punchagan, #133) 34 | - Support only OCaml >= 4.08, update with `ocamlformat.0.21.0` and remove `bigarray-compat` 35 | dependency (@hannesm, #134) 36 | 37 | ### v1.1.1 2022-03-28 Paradou (France) 38 | 39 | - Hide C functions (`sha3_keccakf`) (@hannesm, #125) 40 | - Use `ocaml` to run `install.ml` instead of a shebang (@Nymphium, #127) 41 | - Use `command -v` instead of `which` (@Numphium, #126) 42 | - Add `@since` meta-data in documentation (@c-cube, @dinosaure, #128) 43 | - Update the README.md (@dinosaure, @mimoo, #130) 44 | - `ocaml-solo5` provides `__ocaml_solo5__` instead of `__ocaml_freestanding__` (@dinosaure, #131) 45 | 46 | ### v1.1.0 2021-10-11 Paris (France) 47 | 48 | - Add Keccak256 module (ethereum padding) (@maxtori, @dinosaure, #118) 49 | - Update README.md to include the documentation (@mimoo, @dinosaure, 65a5c12) 50 | - Remove deprecated function from `fmt` library (@dinosaure, #121) 51 | - **NOTE**: This version lost the support of OCaml 4.03 and OCaml 4.04. 52 | 53 | ### v1.0.1 2020-02-08 Paris (France) 54 | 55 | - Fix `esy` support (@dinosaure, #115) 56 | - Fix big-endian support (@dinosaure, #113) 57 | 58 | ### v1.0.0 2020-11-02 Paris (France) 59 | 60 | - **breaking changes** Upgrade the library with MirageOS 3.9 (new layout of artifacts) 61 | Add tests about compilation of unikernels (execution and link) 62 | (#105, @dinosaure, @hannesm) 63 | - Fix `esy` installation (#104, @dinosaure) 64 | - **breaking changes** Better GADT (#103, @dinosaure) 65 | As far as I can tell, nobody really use this part of `digestif`. 66 | The idea is to provide a GADT which contains the type of the hash. 67 | From third-part libraries point-of-view, it's better to _pattern-match_ with 68 | such information instead to use a polymorphic variant (as before). 69 | - **breaking changes** key used for HMAC is a constant `string` (#101, @dinosaure, @hannesm) 70 | The key should not follow the same type as the digest value (`string`, `bytes`, `bigstring`). 71 | This update restricts the user to user only constant key (as a `string`). 72 | 73 | ### v0.9.0 2020-07-10 Paris (France) 74 | 75 | - Add sha3 implementation (#98), @lyrm, @dinosaure, @hannesm and @cfcs 76 | 77 | ### v0.8.1 2020-06-15 Paris (France) 78 | 79 | - Move to `dune.2.6.0` (#97) 80 | - Apply `ocamlformat.0.14.2` (#97) 81 | - Fix tests according `alcotest.1.0.0` (#95) 82 | 83 | ### v0.8.0 2019-20-09 Saint Louis (Sénégal) 84 | 85 | - Fake version to prioritize dune's variants instead of 86 | old linking trick 87 | - Use `stdlib-shims` to keep compatibility with < ocaml.4.07.0 88 | 89 | ### v0.7.3 2019-07-09 Paris (France) 90 | 91 | - Fix bug about specialization of BLAKE2{B,S} (#85, #86) 92 | reported by @samoht, fixed by @dinosaure, reviewed by @hannes and @cfcs 93 | 94 | ### v0.7.2 2019-05-16 Paris (France) 95 | 96 | - Add conflict with `< mirage-xen-posix.3.1.0` packages (@hannesm) 97 | - Add a note on README.md about the linking-trick and order of dependencies (@rizo) 98 | - Use experimental feature of variants with `dune` (@dinosaure, review @rgrinberg) 99 | 100 | `digestif` requires at least `dune.1.9.2` 101 | 102 | ### v0.7.1 2018-11-15 Paris (France) 103 | 104 | - Cross compilation adjustments (@hannesm) (# 76) 105 | - Add the WHIRLPOOL hash algorithm (@clecat) (#77) 106 | - Backport fix on opam file (@dinosaure, @kit-ty-kate) 107 | 108 | ### v0.7 2018-10-15 Paris (France) 109 | 110 | - Fixed HMAC on BLAKE2{S,B} (@emillon) (#46, #51) 111 | - Fixed `convenient_of_hex` (@dinosaure, @hannesm, @cfcs) (#55) 112 | - Add `of_raw_string`/`to_raw_string` (@samoht) (#57) 113 | - Test `digestif` on solo5 and xen backends (@samoht) 114 | - *breaking change*, commont type `t` is an abstract type (#58, #56) 115 | - Fixed META file (@dinosaure, @g2p) (#75) 116 | - New dependency `eqaf` (@dinosaure, @cfcs, @hannesm) (constant-time equal function) (#33, #34, #48, #50, #52, #65) 117 | - Remove `Obj.magic` in common implementation (@dinosaure, @samoht) (#61, #62) 118 | - Add conveniences functions in common implementation (@hcarty) (#63) 119 | - Add option-returning functions in common implementation (@harcty) (#63) 120 | - Verify length of string on `of_raw_string` function (@hcarty) (#63) 121 | - Release runtime lock (@andersfugmann, @dinosaure, @cfcs) (#69, #70) 122 | - Bounds check (@cfcs, @dinosaure) (#71, #72) 123 | - Fixed linking problem (@andersfugmann, @g2p, @dinosaure) (#49, #53, #73, #74) 124 | - Update OPAM file (@dinosaure) 125 | 126 | ### v0.6.1 2018-07-24 Paris (France) 127 | 128 | - *breaking change* API: Digestif implements a true linking trick. End-user need 129 | to explicitely link with `digestif.{c,ocaml}` and it needs to be the first of 130 | your dependencies. 131 | - move to `jbuilder`/`dune` 132 | 133 | ### v0.6 2018-07-05 Paris (France) 134 | 135 | - *breaking change* API: 136 | From a consensus between people who use `digestif`, we decide to delete `*.Bytes.*` and `*.Bigstring.*` sub-modules. 137 | We replace it by `feed_{bytes,string,bigstring}` (`digest_`, and `hmac_` too) 138 | - *breaking change* semantic: streaming and referentially transparent 139 | Add `feedi_{bytes,string,bigstring}`, `digesti_{bytes,string,bigstring}` and `hmaci_{bytes,string,bigstring}` 140 | (@hannesm, @cfcs) 141 | - Constant time for `eq`/`neq` functions 142 | (@cfcs) 143 | - *breaking change* semantic on `compare` and `unsafe_compare`: 144 | `compare` is not a lexicographical comparison function (rename to `unsafe_compare`) 145 | (@cfcs) 146 | - Add `consistent_of_hex` (@hannesm, @cfcs) 147 | 148 | ### v0.4 2017-10-30 Mysore / ಮೈಸೂರು (India) 149 | 150 | - Add an automatised test suit 151 | - Add the RIPEMD160 hash algorithm 152 | - Add the BLAKE2S hash algorithm 153 | - Update authors 154 | - Add `feed_bytes` and `feed_bigstring` for `Bytes` and `Bigstring` 155 | 156 | ### v0.3 2017-07-21 Phnom Penh (Cambodia) 157 | 158 | - Fixed issue #6 159 | - Make a new test suit 160 | 161 | ### v0.2 2017-07-05 Phnom Penh (Cambodia) 162 | 163 | - Implementation of the hash function in pure OCaml 164 | - Link improvement (à la `mtime`) to decide to use the C stub or the OCaml implementation 165 | - Improvement of the common interface (pretty-print, type t, etc.) 166 | 167 | ### v0.1 2017-05-12 Rạch Giá (Vietnam) 168 | 169 | - First release 170 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2014 oklm-wsh 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all clean test 2 | 3 | all: 4 | dune build 5 | 6 | test: 7 | dune runtest 8 | 9 | clean: 10 | dune clean 11 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Digestif - Hash algorithms in C and OCaml 2 | ========================================= 3 | 4 | Digestif is a toolbox which implements hashes: 5 | 6 | * MD5 7 | * SHA1 8 | * SHA2 9 | * SHA3 10 | * WHIRLPOOL 11 | * BLAKE2B 12 | * BLAKE2S 13 | * RIPEMD160 14 | 15 | Digestif uses a trick about linking and let the end-user to choose which 16 | implementation he wants to use. We provide 2 implementations: 17 | 18 | * C implementation with `digestif.c` 19 | * OCaml implementation with `digestif.ocaml` 20 | 21 | Both are well-tested. However, OCaml implementation is slower than the C 22 | implementation. 23 | 24 | **Note**: The linking trick requires `digestif.c` or `digestif.ocaml` to be the 25 | first of your dependencies. 26 | 27 | Documentation: https://mirage.github.io/digestif/ 28 | 29 | Contact: Romain Calascibetta `` 30 | 31 | ## Install & Usage 32 | 33 | The library is available on [OPAM](https://opam.ocaml.org/packages/digestif/). You can install it via: 34 | ```sh 35 | $ opam install digestif 36 | ``` 37 | 38 | This is a simple program which implements `sha1sum`: 39 | ```sh 40 | $ cat >sha1sum.ml < Digestif.SHA1.get ctx 45 | | len -> 46 | let ctx = Digestif.SHA1.feed_bytes ctx ~off:0 ~len tmp in 47 | go ctx 48 | | exception End_of_file -> Digestif.SHA1.get ctx in 49 | go Digestif.SHA1.empty 50 | 51 | let () = match Sys.argv with 52 | | [| _; filename; |] when Sys.file_exists filename -> 53 | let ic = open_in filename in 54 | let hash = sum ic in 55 | close_in ic ; print_endline (Digestif.SHA1.to_hex hash) 56 | | [| _ |] -> 57 | let hash = sum stdin in 58 | print_endline (Digestif.SHA1.to_hex hash) 59 | | _ -> Format.eprintf "%s []\n%!" Sys.argv.(0) 60 | EOF 61 | $ cat >dune <= 4.03.0 (may be less but need test) 101 | * `base-bytes` meta-package 102 | * `base-bigarray` meta-package 103 | * `dune` to build the project 104 | 105 | If you want to compile the test program, you need: 106 | 107 | * `alcotest` 108 | 109 | ## Credits 110 | 111 | This work is from the [nocrypto](https://github.com/mirleft/nocrypto) library 112 | and the Vincent hanquez's work in 113 | [ocaml-sha](https://github.com/vincenthz/ocaml-sha). 114 | 115 | All credits appear in the begin of files and this library is motivated by two 116 | reasons: 117 | * delete the dependancy with `nocrypto` if you don't use the encryption (and 118 | common) part 119 | * aggregate all hashes functions in one library 120 | -------------------------------------------------------------------------------- /digestif.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "digestif" 3 | maintainer: [ "Eyyüb Sari " 4 | "Romain Calascibetta " ] 5 | authors: [ "Eyyüb Sari " 6 | "Romain Calascibetta " ] 7 | homepage: "https://github.com/mirage/digestif" 8 | bug-reports: "https://github.com/mirage/digestif/issues" 9 | dev-repo: "git+https://github.com/mirage/digestif.git" 10 | doc: "https://mirage.github.io/digestif/" 11 | license: "MIT" 12 | synopsis: "Hashes implementations (SHA*, RIPEMD160, BLAKE2* and MD5)" 13 | description: """ 14 | Digestif is a toolbox to provide hashes implementations in C and OCaml. 15 | 16 | It uses the linking trick and user can decide at the end to use the C implementation or the OCaml implementation. 17 | 18 | We provides implementation of: 19 | * MD5 20 | * SHA1 21 | * SHA224 22 | * SHA256 23 | * SHA384 24 | * SHA512 25 | * SHA3 26 | * Keccak-256 27 | * WHIRLPOOL 28 | * BLAKE2B 29 | * BLAKE2S 30 | * RIPEMD160 31 | """ 32 | 33 | build: [ 34 | [ "dune" "build" "-p" name "-j" jobs ] 35 | [ "dune" "runtest" "-p" name "-j" jobs ] {with-test} 36 | ] 37 | install: [ 38 | [ "dune" "install" "-p" name ] {with-test} 39 | [ "ocaml" "./test/test_runes.ml" ] {with-test} 40 | ] 41 | 42 | depends: [ 43 | "ocaml" {>= "4.08.0"} 44 | "dune" {>= "2.6.0"} 45 | "eqaf" 46 | "fmt" {with-test & >= "0.8.7"} 47 | "alcotest" {with-test} 48 | "bos" {with-test} 49 | "astring" {with-test} 50 | "fpath" {with-test} 51 | "rresult" {with-test} 52 | "ocamlfind" {with-test} 53 | "crowbar" {with-test} 54 | ] 55 | 56 | conflicts: [ 57 | "mirage-xen" {< "6.0.0"} 58 | "ocaml-freestanding" 59 | ] 60 | x-maintenance-intent: [ "(latest)" ] 61 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.6) 2 | (name digestif) 3 | -------------------------------------------------------------------------------- /fuzz/c/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name fuzz) 3 | (libraries digestif.c crowbar)) 4 | 5 | (rule 6 | (copy# ../fuzz.ml fuzz.ml)) 7 | -------------------------------------------------------------------------------- /fuzz/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (copy# fuzz.ml fuzz_c.ml)) 3 | 4 | (rule 5 | (copy# fuzz.ml fuzz_ocaml.ml)) 6 | 7 | (executable 8 | (name fuzz_c) 9 | (modules fuzz_c) 10 | (libraries digestif.c crowbar)) 11 | 12 | (executable 13 | (name fuzz_ocaml) 14 | (modules fuzz_ocaml) 15 | (libraries digestif.ocaml crowbar)) 16 | 17 | (rule 18 | (alias runtest) 19 | (action 20 | (run ./fuzz_ocaml.exe))) 21 | 22 | (rule 23 | (alias runtest) 24 | (action 25 | (run ./fuzz_c.exe))) 26 | -------------------------------------------------------------------------------- /fuzz/fuzz.ml: -------------------------------------------------------------------------------- 1 | open Crowbar 2 | 3 | type pack = Pack : 'a Digestif.hash -> pack 4 | 5 | let hash = 6 | choose 7 | [ 8 | const (Pack Digestif.sha1); const (Pack Digestif.sha256); 9 | const (Pack Digestif.sha512); 10 | ] 11 | 12 | let with_get_into_bytes off len (type ctx) 13 | (module Hash : Digestif.S with type ctx = ctx) (ctx : ctx) = 14 | let buf = Bytes.create len in 15 | let () = 16 | try Hash.get_into_bytes ctx ~off buf 17 | with Invalid_argument e -> ( 18 | (* Skip if the invalid argument is valid; otherwise fail *) 19 | match Bytes.sub buf off Hash.digest_size with 20 | | _ -> failf "Hash.get_into_bytes: Invalid_argument %S" e 21 | | exception Invalid_argument _ -> bad_test ()) in 22 | Bytes.sub_string buf off Hash.digest_size 23 | 24 | let () = 25 | add_test ~name:"get_into_bytes" [ hash; int8; range 1024; bytes ] 26 | @@ fun (Pack hash) off len bytes -> 27 | let (module Hash) = Digestif.module_of hash in 28 | let ctx = Hash.empty in 29 | let ctx = Hash.feed_string ctx bytes in 30 | let a = with_get_into_bytes off len (module Hash) ctx in 31 | let b = Hash.(to_raw_string (get ctx)) in 32 | check_eq ~eq:String.equal a b 33 | -------------------------------------------------------------------------------- /fuzz/ocaml/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name fuzz) 3 | (libraries digestif.ocaml crowbar)) 4 | 5 | (rule 6 | (copy# ../fuzz.ml fuzz.ml)) 7 | -------------------------------------------------------------------------------- /mirage/_tags: -------------------------------------------------------------------------------- 1 | true: package(digestif.c) 2 | -------------------------------------------------------------------------------- /mirage/config.ml: -------------------------------------------------------------------------------- 1 | open Mirage 2 | 3 | let main = foreign "Unikernel.Make" (console @-> job) 4 | let packages = [ package "digestif" ] 5 | let () = register ~packages "digestif-test" [ main $ default_console ] 6 | -------------------------------------------------------------------------------- /mirage/unikernel.ml: -------------------------------------------------------------------------------- 1 | module Make (Console : Mirage_console.S) = struct 2 | let log console fmt = Format.kasprintf (Console.log console) fmt 3 | 4 | let start console = 5 | let hash = Digestif.SHA1.digest_string "Hello World!" in 6 | log console "%a" Digestif.SHA1.pp hash 7 | end 8 | -------------------------------------------------------------------------------- /src-c/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name digestif_c) 3 | (public_name digestif.c) 4 | (implements digestif) 5 | (libraries eqaf) 6 | (private_modules digestif_native digestif_eq digestif_conv digestif_by 7 | digestif_bi) 8 | (foreign_stubs 9 | (language c) 10 | (names blake2b blake2s md5 ripemd160 sha1 sha256 sha512 sha3 whirlpool misc 11 | stubs) 12 | (flags 13 | (:standard -I./native/))) 14 | (flags 15 | (:standard -no-keep-locs))) 16 | 17 | (include_subdirs unqualified) 18 | 19 | (copy_files# ../src/*.ml) 20 | -------------------------------------------------------------------------------- /src-c/native/bitfn.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2006-2009 Vincent Hanquez 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 1. Redistributions of source code must retain the above copyright 8 | * notice, this list of conditions and the following disclaimer. 9 | * 2. Redistributions in binary form must reproduce the above copyright 10 | * notice, this list of conditions and the following disclaimer in the 11 | * documentation and/or other materials provided with the distribution. 12 | * 13 | * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 14 | * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 15 | * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 16 | * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 17 | * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 18 | * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 19 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 20 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 22 | * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | */ 24 | 25 | #ifndef BITFN_H 26 | #define BITFN_H 27 | 28 | #include 29 | #include 30 | 31 | #if !defined(__cpluplus) && (!defined(__STDC_VERSION__) || __STDC_VERSION__ < 199901L) 32 | #if defined(_MSC_VER) 33 | #define __INLINE __inline 34 | #elif defined(__GNUC__) 35 | #define __INLINE __inline__ 36 | #else 37 | #define __INLINE 38 | #endif 39 | #else 40 | #define __INLINE inline 41 | #endif 42 | 43 | static __INLINE void secure_zero_memory(void *v, size_t n) 44 | { 45 | static void *(*const volatile memset_v)(void *, int, size_t) = &memset; 46 | memset_v(v, 0, n); 47 | } 48 | 49 | #ifndef NO_INLINE_ASM 50 | /**********************************************************/ 51 | # if (defined(__i386__)) 52 | # define ARCH_HAS_SWAP32 53 | static __INLINE uint32_t bitfn_swap32(uint32_t a) 54 | { 55 | __asm__ ("bswap %0" : "=r" (a) : "0" (a)); 56 | return a; 57 | } 58 | /**********************************************************/ 59 | # elif (defined(__arm__)) 60 | # define ARCH_HAS_SWAP32 61 | static __INLINE uint32_t bitfn_swap32(uint32_t a) 62 | { 63 | uint32_t tmp = a; 64 | __asm__ volatile ("eor %1, %0, %0, ror #16\n" 65 | "bic %1, %1, #0xff0000\n" 66 | "mov %0, %0, ror #8\n" 67 | "eor %0, %0, %1, lsr #8\n" 68 | : "=r" (a), "=r" (tmp) : "0" (a), "1" (tmp)); 69 | return a; 70 | } 71 | /**********************************************************/ 72 | # elif defined(__x86_64__) 73 | # define ARCH_HAS_SWAP32 74 | # define ARCH_HAS_SWAP64 75 | static __INLINE uint32_t bitfn_swap32(uint32_t a) 76 | { 77 | __asm__ ("bswap %0" : "=r" (a) : "0" (a)); 78 | return a; 79 | } 80 | 81 | static __INLINE uint64_t bitfn_swap64(uint64_t a) 82 | { 83 | __asm__ ("bswap %0" : "=r" (a) : "0" (a)); 84 | return a; 85 | } 86 | 87 | # endif 88 | #endif /* NO_INLINE_ASM */ 89 | /**********************************************************/ 90 | 91 | #ifndef ARCH_HAS_ROL32 92 | static __INLINE uint32_t rol32(uint32_t word, uint32_t shift) 93 | { 94 | return (word << shift) | (word >> (32 - shift)); 95 | } 96 | #endif 97 | 98 | #ifndef ARCH_HAS_ROR32 99 | static __INLINE uint32_t ror32(uint32_t word, uint32_t shift) 100 | { 101 | return (word >> shift) | (word << (32 - shift)); 102 | } 103 | #endif 104 | 105 | #ifndef ARCH_HAS_ROL64 106 | static __INLINE uint64_t rol64(uint64_t word, uint32_t shift) 107 | { 108 | return (word << shift) | (word >> (64 - shift)); 109 | } 110 | #endif 111 | 112 | #ifndef ARCH_HAS_ROR64 113 | static __INLINE uint64_t ror64(uint64_t word, uint32_t shift) 114 | { 115 | return (word >> shift) | (word << (64 - shift)); 116 | } 117 | #endif 118 | 119 | #ifndef ARCH_HAS_SWAP32 120 | static __INLINE uint32_t bitfn_swap32(uint32_t a) 121 | { 122 | return (a << 24) | ((a & 0xff00) << 8) | ((a >> 8) & 0xff00) | (a >> 24); 123 | } 124 | #endif 125 | 126 | #ifndef ARCH_HAS_ARRAY_SWAP32 127 | static __INLINE void array_swap32(uint32_t *d, uint32_t *s, uint32_t nb) 128 | { 129 | while (nb--) 130 | *d++ = bitfn_swap32(*s++); 131 | } 132 | #endif 133 | 134 | #ifndef ARCH_HAS_SWAP64 135 | static __INLINE uint64_t bitfn_swap64(uint64_t a) 136 | { 137 | return ((uint64_t) bitfn_swap32((uint32_t) (a >> 32))) | 138 | (((uint64_t) bitfn_swap32((uint32_t) a)) << 32); 139 | } 140 | #endif 141 | 142 | #ifndef ARCH_HAS_ARRAY_SWAP64 143 | static __INLINE void array_swap64(uint64_t *d, uint64_t *s, uint32_t nb) 144 | { 145 | while (nb--) 146 | *d++ = bitfn_swap64(*s++); 147 | } 148 | #endif 149 | 150 | #ifndef ARCH_HAS_MEMORY_ZERO 151 | static __INLINE void memory_zero(void *ptr, uint32_t len) 152 | { 153 | uint32_t *ptr32 = ptr; 154 | uint8_t *ptr8; 155 | int i; 156 | 157 | for (i = 0; (uint32_t) i < len / 4; i++) 158 | *ptr32++ = 0; 159 | if (len % 4) { 160 | ptr8 = (uint8_t *) ptr32; 161 | for (i = len % 4; i >= 0; i--) 162 | ptr8[i] = 0; 163 | } 164 | } 165 | #endif 166 | 167 | #ifndef ARCH_HAS_ARRAY_COPY32 168 | static __INLINE void array_copy32(uint32_t *d, uint32_t *s, uint32_t nb) 169 | { 170 | while (nb--) *d++ = *s++; 171 | } 172 | #endif 173 | 174 | #ifndef ARCH_HAS_ARRAY_COPY64 175 | static __INLINE void array_copy64(uint64_t *d, uint64_t *s, uint32_t nb) 176 | { 177 | while (nb--) *d++ = *s++; 178 | } 179 | #endif 180 | 181 | static __INLINE uint64_t load64( const void *src ) 182 | { 183 | #if defined(NATIVE_LITTLE_ENDIAN) 184 | uint64_t w; 185 | memcpy(&w, src, sizeof w); 186 | return w; 187 | #else 188 | const uint8_t *p = ( const uint8_t * )src; 189 | return (( uint64_t )( p[0] ) << 0) | 190 | (( uint64_t )( p[1] ) << 8) | 191 | (( uint64_t )( p[2] ) << 16) | 192 | (( uint64_t )( p[3] ) << 24) | 193 | (( uint64_t )( p[4] ) << 32) | 194 | (( uint64_t )( p[5] ) << 40) | 195 | (( uint64_t )( p[6] ) << 48) | 196 | (( uint64_t )( p[7] ) << 56) ; 197 | #endif 198 | } 199 | 200 | static __INLINE uint32_t load32( const void *src ) 201 | { 202 | #if defined(NATIVE_LITTLE_ENDIAN) 203 | uint32_t w; 204 | memcpy(&w, src, sizeof w); 205 | return w; 206 | #else 207 | const uint8_t *p = ( const uint8_t * )src; 208 | return (( uint32_t )( p[0] ) << 0) | 209 | (( uint32_t )( p[1] ) << 8) | 210 | (( uint32_t )( p[2] ) << 16) | 211 | (( uint32_t )( p[3] ) << 24) ; 212 | #endif 213 | } 214 | 215 | static __INLINE void store32( void *dst, uint32_t w ) 216 | { 217 | #if defined(NATIVE_LITTLE_ENDIAN) 218 | memcpy(dst, &w, sizeof w); 219 | #else 220 | uint8_t *p = ( uint8_t * )dst; 221 | p[0] = (uint8_t)(w >> 0); 222 | p[1] = (uint8_t)(w >> 8); 223 | p[2] = (uint8_t)(w >> 16); 224 | p[3] = (uint8_t)(w >> 24); 225 | #endif 226 | } 227 | 228 | static __INLINE void store64( void *dst, uint64_t w ) 229 | { 230 | #if defined(NATIVE_LITTLE_ENDIAN) 231 | memcpy(dst, &w, sizeof w); 232 | #else 233 | uint8_t *p = ( uint8_t * )dst; 234 | p[0] = (uint8_t)(w >> 0); 235 | p[1] = (uint8_t)(w >> 8); 236 | p[2] = (uint8_t)(w >> 16); 237 | p[3] = (uint8_t)(w >> 24); 238 | p[4] = (uint8_t)(w >> 32); 239 | p[5] = (uint8_t)(w >> 40); 240 | p[6] = (uint8_t)(w >> 48); 241 | p[7] = (uint8_t)(w >> 56); 242 | #endif 243 | } 244 | 245 | #ifdef __MINGW32__ 246 | # define LITTLE_ENDIAN 1234 247 | # define BYTE_ORDER LITTLE_ENDIAN 248 | #elif defined(__FreeBSD__) || defined(__DragonFly__) || defined(__NetBSD__) 249 | # include 250 | #elif defined(__OpenBSD__) || defined(__SVR4) 251 | # include 252 | #elif defined(__APPLE__) 253 | # include 254 | #elif defined( BSD ) && ( BSD >= 199103 ) 255 | # include 256 | #elif defined( __QNXNTO__ ) && defined( __LITTLEENDIAN__ ) 257 | # define LITTLE_ENDIAN 1234 258 | # define BYTE_ORDER LITTLE_ENDIAN 259 | #elif defined( __QNXNTO__ ) && defined( __BIGENDIAN__ ) 260 | # define BIG_ENDIAN 1234 261 | # define BYTE_ORDER BIG_ENDIAN 262 | #elif defined(_MSC_VER) 263 | # define LITTLE_ENDIAN 1234 264 | # define BYTE_ORDER LITTLE_ENDIAN 265 | #else 266 | # include 267 | #endif 268 | /* big endian to cpu */ 269 | #if LITTLE_ENDIAN == BYTE_ORDER 270 | 271 | # define be32_to_cpu(a) bitfn_swap32(a) 272 | # define cpu_to_be32(a) bitfn_swap32(a) 273 | # define le32_to_cpu(a) (a) 274 | # define cpu_to_le32(a) (a) 275 | # define be64_to_cpu(a) bitfn_swap64(a) 276 | # define cpu_to_be64(a) bitfn_swap64(a) 277 | # define le64_to_cpu(a) (a) 278 | # define cpu_to_le64(a) (a) 279 | 280 | # define cpu_to_le32_array(d, s, l) array_copy32(d, s, l) 281 | # define le32_to_cpu_array(d, s, l) array_copy32(d, s, l) 282 | # define cpu_to_be32_array(d, s, l) array_swap32(d, s, l) 283 | # define be32_to_cpu_array(d, s, l) array_swap32(d, s, l) 284 | 285 | # define cpu_to_le64_array(d, s, l) array_copy64(d, s, l) 286 | # define le64_to_cpu_array(d, s, l) array_copy64(d, s, l) 287 | # define cpu_to_be64_array(d, s, l) array_swap64(d, s, l) 288 | # define be64_to_cpu_array(d, s, l) array_swap64(d, s, l) 289 | 290 | # define ror32_be(a, s) rol32(a, s) 291 | # define rol32_be(a, s) ror32(a, s) 292 | 293 | # define ARCH_IS_LITTLE_ENDIAN 294 | 295 | #elif BIG_ENDIAN == BYTE_ORDER 296 | 297 | # define be32_to_cpu(a) (a) 298 | # define cpu_to_be32(a) (a) 299 | # define be64_to_cpu(a) (a) 300 | # define cpu_to_be64(a) (a) 301 | # define le64_to_cpu(a) bitfn_swap64(a) 302 | # define cpu_to_le64(a) bitfn_swap64(a) 303 | # define le32_to_cpu(a) bitfn_swap32(a) 304 | # define cpu_to_le32(a) bitfn_swap32(a) 305 | 306 | # define cpu_to_le32_array(d, s, l) array_swap32(d, s, l) 307 | # define le32_to_cpu_array(d, s, l) array_swap32(d, s, l) 308 | # define cpu_to_be32_array(d, s, l) array_copy32(d, s, l) 309 | # define be32_to_cpu_array(d, s, l) array_copy32(d, s, l) 310 | 311 | # define cpu_to_le64_array(d, s, l) array_swap64(d, s, l) 312 | # define le64_to_cpu_array(d, s, l) array_swap64(d, s, l) 313 | # define cpu_to_be64_array(d, s, l) array_copy64(d, s, l) 314 | # define be64_to_cpu_array(d, s, l) array_copy64(d, s, l) 315 | 316 | # define ror32_be(a, s) ror32(a, s) 317 | # define rol32_be(a, s) rol32(a, s) 318 | 319 | # define ARCH_IS_BIG_ENDIAN 320 | 321 | #else 322 | # error "endian not supported" 323 | #endif 324 | 325 | #endif /* !BITFN_H */ 326 | -------------------------------------------------------------------------------- /src-c/native/blake2.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mirage/digestif/46968733c813b53271f9dc091c3bf06c12d16814/src-c/native/blake2.c -------------------------------------------------------------------------------- /src-c/native/blake2b.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include "blake2b.h" 3 | #include "bitfn.h" 4 | 5 | static const uint64_t IV[8] = 6 | { 7 | 0x6a09e667f3bcc908ULL, 0xbb67ae8584caa73bULL, 8 | 0x3c6ef372fe94f82bULL, 0xa54ff53a5f1d36f1ULL, 9 | 0x510e527fade682d1ULL, 0x9b05688c2b3e6c1fULL, 10 | 0x1f83d9abfb41bd6bULL, 0x5be0cd19137e2179ULL 11 | }; 12 | 13 | static const uint8_t sigma[12][16] = 14 | { 15 | { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 } , 16 | { 14, 10, 4, 8, 9, 15, 13, 6, 1, 12, 0, 2, 11, 7, 5, 3 } , 17 | { 11, 8, 12, 0, 5, 2, 15, 13, 10, 14, 3, 6, 7, 1, 9, 4 } , 18 | { 7, 9, 3, 1, 13, 12, 11, 14, 2, 6, 5, 10, 4, 0, 15, 8 } , 19 | { 9, 0, 5, 7, 2, 4, 10, 15, 14, 1, 11, 12, 6, 8, 3, 13 } , 20 | { 2, 12, 6, 10, 0, 11, 8, 3, 4, 13, 7, 5, 15, 14, 1, 9 } , 21 | { 12, 5, 1, 15, 14, 13, 4, 10, 0, 7, 6, 3, 9, 2, 8, 11 } , 22 | { 13, 11, 7, 14, 12, 1, 3, 9, 5, 0, 15, 4, 8, 6, 2, 10 } , 23 | { 6, 15, 14, 9, 11, 3, 0, 8, 12, 2, 13, 7, 1, 4, 10, 5 } , 24 | { 10, 2, 8, 4, 7, 6, 1, 5, 15, 11, 9, 14, 3, 12, 13 , 0 } , 25 | { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 } , 26 | { 14, 10, 4, 8, 9, 15, 13, 6, 1, 12, 0, 2, 11, 7, 5, 3 } 27 | }; 28 | 29 | #include 30 | 31 | static const struct blake2b_param P[] = 32 | { { BLAKE2B_OUTBYTES /* digest_length */ 33 | , 0 /* key_length */ 34 | , 1 /* fanout */ 35 | , 1 /* depth */ 36 | , 0 /* leaf_length */ 37 | , 0 /* node_offset */ 38 | , 0 /* xof_length */ 39 | , 0 /* node_depth */ 40 | , 0 /* inner_length */ 41 | , { 0 } /* reserver[14] */ 42 | , { 0 } /* salt[BLAKE2B_SLATBYTES] */ 43 | , { 0 } /* personal[BLAKE2B_PERSONALBYTES] */ } }; 44 | 45 | static void blake2b_increment_counter( struct blake2b_ctx *ctx, const uint64_t inc ) 46 | { 47 | ctx->t[0] += inc; 48 | ctx->t[1] += ( ctx->t[0] < inc ); 49 | } 50 | 51 | static void blake2b_set_lastnode( struct blake2b_ctx *ctx ) 52 | { 53 | ctx->f[1] = (uint64_t)-1; 54 | } 55 | 56 | static void blake2b_set_lastblock( struct blake2b_ctx *ctx ) 57 | { 58 | if( ctx->last_node ) blake2b_set_lastnode( ctx ); 59 | 60 | ctx->f[0] = (uint64_t)-1; 61 | } 62 | 63 | #define G(r,i,a,b,c,d) \ 64 | do { \ 65 | a = a + b + m[sigma[r][2*i+0]]; \ 66 | d = ror64(d ^ a, 32); \ 67 | c = c + d; \ 68 | b = ror64(b ^ c, 24); \ 69 | a = a + b + m[sigma[r][2*i+1]]; \ 70 | d = ror64(d ^ a, 16); \ 71 | c = c + d; \ 72 | b = ror64(b ^ c, 63); \ 73 | } while(0) 74 | 75 | #define R(r) \ 76 | do { \ 77 | G(r,0,v[ 0],v[ 4],v[ 8],v[12]); \ 78 | G(r,1,v[ 1],v[ 5],v[ 9],v[13]); \ 79 | G(r,2,v[ 2],v[ 6],v[10],v[14]); \ 80 | G(r,3,v[ 3],v[ 7],v[11],v[15]); \ 81 | G(r,4,v[ 0],v[ 5],v[10],v[15]); \ 82 | G(r,5,v[ 1],v[ 6],v[11],v[12]); \ 83 | G(r,6,v[ 2],v[ 7],v[ 8],v[13]); \ 84 | G(r,7,v[ 3],v[ 4],v[ 9],v[14]); \ 85 | } while(0) 86 | 87 | static void blake2b_compress(struct blake2b_ctx *ctx, const uint8_t block[BLAKE2B_BLOCKBYTES]) 88 | { 89 | uint64_t m[16]; 90 | uint64_t v[16]; 91 | size_t i; 92 | 93 | for( i = 0; i < 16; ++i ) { 94 | m[i] = load64( block + i * sizeof( m[i] ) ); 95 | } 96 | 97 | for( i = 0; i < 8; ++i ) { 98 | v[i] = ctx->h[i]; 99 | } 100 | 101 | v[ 8] = IV[0]; 102 | v[ 9] = IV[1]; 103 | v[10] = IV[2]; 104 | v[11] = IV[3]; 105 | v[12] = IV[4] ^ ctx->t[0]; 106 | v[13] = IV[5] ^ ctx->t[1]; 107 | v[14] = IV[6] ^ ctx->f[0]; 108 | v[15] = IV[7] ^ ctx->f[1]; 109 | 110 | R( 0 ); 111 | R( 1 ); 112 | R( 2 ); 113 | R( 3 ); 114 | R( 4 ); 115 | R( 5 ); 116 | R( 6 ); 117 | R( 7 ); 118 | R( 8 ); 119 | R( 9 ); 120 | R( 10 ); 121 | R( 11 ); 122 | 123 | for( i = 0; i < 8; ++i ) 124 | ctx->h[i] = ctx->h[i] ^ v[i] ^ v[i + 8]; 125 | } 126 | 127 | #undef G 128 | #undef R 129 | 130 | void digestif_blake2b_update( struct blake2b_ctx *ctx, uint8_t *data, uint32_t inlen ) 131 | { 132 | const unsigned char * in = (const unsigned char *) data; 133 | 134 | if( inlen > 0 ) 135 | { 136 | size_t left = ctx->buflen; 137 | size_t fill = BLAKE2B_BLOCKBYTES - left; 138 | 139 | if( inlen > fill ) 140 | { 141 | ctx->buflen = 0; 142 | memcpy( ctx->buf + left, in, fill ); 143 | blake2b_increment_counter( ctx, BLAKE2B_BLOCKBYTES ); 144 | blake2b_compress( ctx, ctx->buf ); 145 | in += fill; 146 | inlen -= fill; 147 | 148 | while (inlen > BLAKE2B_BLOCKBYTES) 149 | { 150 | blake2b_increment_counter( ctx, BLAKE2B_BLOCKBYTES ); 151 | blake2b_compress( ctx, in ); 152 | in += BLAKE2B_BLOCKBYTES; 153 | inlen -= BLAKE2B_BLOCKBYTES; 154 | } 155 | } 156 | 157 | memcpy( ctx->buf + ctx->buflen, in, inlen ); 158 | ctx->buflen += inlen; 159 | } 160 | } 161 | 162 | void digestif_blake2b_init_with_outlen_and_key(struct blake2b_ctx *ctx, size_t outlen, const void *key, size_t keylen) 163 | { 164 | struct blake2b_param P[1]; 165 | const unsigned char * p = ( const uint8_t * )( P ); 166 | size_t i; 167 | 168 | memset( ctx, 0, sizeof( struct blake2b_ctx ) ); 169 | 170 | P->digest_length = (uint8_t) outlen; 171 | P->key_length = (uint8_t) keylen; 172 | P->fanout = 1; 173 | P->depth = 1; 174 | P->leaf_length = 0; 175 | P->node_offset = 0; 176 | P->xof_length = 0; 177 | P->node_depth = 0; 178 | P->inner_length = 0; 179 | 180 | memset( P->reserved, 0, sizeof( P->reserved ) ); 181 | memset( P->salt, 0, sizeof( P->salt ) ); 182 | memset( P->personal, 0, sizeof( P->personal ) ); 183 | 184 | for( i = 0; i < 8; ++i ) 185 | ctx->h[i] = IV[i] ^ load64(p + sizeof(uint64_t) * i); 186 | 187 | ctx->outlen = P->digest_length; 188 | 189 | if( keylen > 0 ) 190 | { 191 | uint8_t block[BLAKE2B_BLOCKBYTES]; 192 | memset( block, 0, BLAKE2B_BLOCKBYTES ); 193 | memcpy( block, key, keylen ); 194 | digestif_blake2b_update( ctx, block, BLAKE2B_BLOCKBYTES ); 195 | secure_zero_memory( block, BLAKE2B_BLOCKBYTES ); 196 | } 197 | } 198 | 199 | void digestif_blake2b_init(struct blake2b_ctx *ctx) 200 | { 201 | digestif_blake2b_init_with_outlen_and_key(ctx, BLAKE2B_OUTBYTES, NULL, 0); 202 | } 203 | 204 | void digestif_blake2b_finalize( struct blake2b_ctx *ctx, uint8_t *out ) 205 | { 206 | uint8_t buffer[BLAKE2B_OUTBYTES] = { 0 }; 207 | size_t i; 208 | 209 | blake2b_increment_counter( ctx, ctx->buflen ); 210 | blake2b_set_lastblock( ctx ); 211 | memset( ctx->buf + ctx->buflen, 0, BLAKE2B_BLOCKBYTES - ctx->buflen ); 212 | blake2b_compress( ctx, ctx->buf ); 213 | 214 | for( i = 0; i < 8; ++i ) 215 | store64(buffer + sizeof( ctx->h[i] ) * i, ctx->h[i]); 216 | 217 | secure_zero_memory( out, ctx->outlen * sizeof(uint8_t) ); 218 | memcpy( out, buffer, (ctx->outlen < BLAKE2B_OUTBYTES) ? ctx->outlen : BLAKE2B_OUTBYTES ); 219 | secure_zero_memory( buffer, sizeof(buffer) ); 220 | } 221 | -------------------------------------------------------------------------------- /src-c/native/blake2b.h: -------------------------------------------------------------------------------- 1 | #ifndef CRYPTOHASH_BLAKE2B_H 2 | #define CRYPTOHASH_BLAKE2B_H 3 | 4 | #include 5 | 6 | #if defined(_MSC_VER) 7 | #define PACKED(x) __pragma(pack(push, 1)) x __pragma(pack(pop)) 8 | #else 9 | #define PACKED(x) x __attribute((packed)) 10 | #endif 11 | 12 | enum blake2b_constant 13 | { 14 | BLAKE2B_BLOCKBYTES = 128, 15 | BLAKE2B_OUTBYTES = 64, 16 | BLAKE2B_KEYBYTES = 64, 17 | BLAKE2B_SALTBYTES = 16, 18 | BLAKE2B_PERSONALBYTES = 16 19 | }; 20 | 21 | struct blake2b_ctx 22 | { 23 | uint64_t h[8]; 24 | uint64_t t[2]; 25 | uint64_t f[2]; 26 | uint8_t buf[BLAKE2B_BLOCKBYTES]; 27 | size_t buflen; 28 | size_t outlen; 29 | uint8_t last_node; 30 | }; 31 | 32 | PACKED(struct blake2b_param 33 | { 34 | uint8_t digest_length; /* 1 */ 35 | uint8_t key_length; /* 2 */ 36 | uint8_t fanout; /* 3 */ 37 | uint8_t depth; /* 4 */ 38 | uint32_t leaf_length; /* 8 */ 39 | uint32_t node_offset; /* 12 */ 40 | uint32_t xof_length; /* 16 */ 41 | uint8_t node_depth; /* 17 */ 42 | uint8_t inner_length; /* 18 */ 43 | uint8_t reserved[14]; /* 32 */ 44 | uint8_t salt[BLAKE2B_SALTBYTES]; /* 48 */ 45 | uint8_t personal[BLAKE2B_PERSONALBYTES]; /* 64 */ 46 | }); 47 | 48 | #define BLAKE2B_DIGEST_SIZE BLAKE2B_BLOCKBYTES 49 | #define BLAKE2B_CTX_SIZE (sizeof(struct blake2b_ctx)) 50 | 51 | void digestif_blake2b_init(struct blake2b_ctx *ctx); 52 | void digestif_blake2b_init_with_outlen_and_key(struct blake2b_ctx *ctx, size_t outlen, const void *key, size_t keylen); 53 | void digestif_blake2b_update(struct blake2b_ctx *ctx, uint8_t *data, uint32_t len); 54 | void digestif_blake2b_finalize(struct blake2b_ctx *ctx, uint8_t *out); 55 | 56 | #endif 57 | -------------------------------------------------------------------------------- /src-c/native/blake2s.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include "blake2s.h" 3 | #include "bitfn.h" 4 | 5 | static const uint32_t IV[8] = 6 | { 7 | 0x6A09E667UL, 0xBB67AE85UL, 0x3C6EF372UL, 0xA54FF53AUL, 8 | 0x510E527FUL, 0x9B05688CUL, 0x1F83D9ABUL, 0x5BE0CD19UL 9 | }; 10 | 11 | static const uint8_t sigma[10][16] = 12 | { 13 | { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 } , 14 | { 14, 10, 4, 8, 9, 15, 13, 6, 1, 12, 0, 2, 11, 7, 5, 3 } , 15 | { 11, 8, 12, 0, 5, 2, 15, 13, 10, 14, 3, 6, 7, 1, 9, 4 } , 16 | { 7, 9, 3, 1, 13, 12, 11, 14, 2, 6, 5, 10, 4, 0, 15, 8 } , 17 | { 9, 0, 5, 7, 2, 4, 10, 15, 14, 1, 11, 12, 6, 8, 3, 13 } , 18 | { 2, 12, 6, 10, 0, 11, 8, 3, 4, 13, 7, 5, 15, 14, 1, 9 } , 19 | { 12, 5, 1, 15, 14, 13, 4, 10, 0, 7, 6, 3, 9, 2, 8, 11 } , 20 | { 13, 11, 7, 14, 12, 1, 3, 9, 5, 0, 15, 4, 8, 6, 2, 10 } , 21 | { 6, 15, 14, 9, 11, 3, 0, 8, 12, 2, 13, 7, 1, 4, 10, 5 } , 22 | { 10, 2, 8, 4, 7, 6, 1, 5, 15, 11, 9, 14, 3, 12, 13 , 0 } , 23 | }; 24 | 25 | #include 26 | 27 | static const struct blake2s_param P[] = 28 | { { BLAKE2S_OUTBYTES /* digest_length */ 29 | , 0 /* key_length */ 30 | , 1 /* fanout */ 31 | , 1 /* depth */ 32 | , 0 /* leaf_length */ 33 | , 0 /* node_offset */ 34 | , 0 /* xof_length */ 35 | , 0 /* node_depth */ 36 | , 0 /* inner_length */ 37 | , { 0 } /* salt */ 38 | , { 0 } /* personal */ } }; 39 | 40 | static void blake2s_increment_counter( struct blake2s_ctx *ctx, const uint32_t inc ) 41 | { 42 | ctx->t[0] += inc; 43 | ctx->t[1] += ( ctx->t[0] < inc ); 44 | } 45 | 46 | static void blake2s_set_lastnode( struct blake2s_ctx *ctx ) 47 | { 48 | ctx->f[1] = (uint32_t)-1; 49 | } 50 | 51 | static void blake2s_set_lastblock( struct blake2s_ctx *ctx ) 52 | { 53 | if( ctx->last_node ) blake2s_set_lastnode( ctx ); 54 | 55 | ctx->f[0] = (uint32_t)-1; 56 | } 57 | 58 | #define G(r,i,a,b,c,d) \ 59 | do { \ 60 | a = a + b + m[sigma[r][2*i+0]]; \ 61 | d = ror32(d ^ a, 16); \ 62 | c = c + d; \ 63 | b = ror32(b ^ c, 12); \ 64 | a = a + b + m[sigma[r][2*i+1]]; \ 65 | d = ror32(d ^ a, 8); \ 66 | c = c + d; \ 67 | b = ror32(b ^ c, 7); \ 68 | } while(0) 69 | 70 | #define ROUND(r) \ 71 | do { \ 72 | G(r,0,v[ 0],v[ 4],v[ 8],v[12]); \ 73 | G(r,1,v[ 1],v[ 5],v[ 9],v[13]); \ 74 | G(r,2,v[ 2],v[ 6],v[10],v[14]); \ 75 | G(r,3,v[ 3],v[ 7],v[11],v[15]); \ 76 | G(r,4,v[ 0],v[ 5],v[10],v[15]); \ 77 | G(r,5,v[ 1],v[ 6],v[11],v[12]); \ 78 | G(r,6,v[ 2],v[ 7],v[ 8],v[13]); \ 79 | G(r,7,v[ 3],v[ 4],v[ 9],v[14]); \ 80 | } while(0) 81 | 82 | static void blake2s_compress(struct blake2s_ctx *ctx, const uint8_t block[BLAKE2S_BLOCKBYTES]) 83 | { 84 | uint32_t m[16]; 85 | uint32_t v[16]; 86 | size_t i; 87 | 88 | for( i = 0; i < 16; ++i ) { 89 | m[i] = load32( block + i * sizeof( m[i] ) ); 90 | } 91 | 92 | for( i = 0; i < 8; ++i ) { 93 | v[i] = ctx->h[i]; 94 | } 95 | 96 | v[ 8] = IV[0]; 97 | v[ 9] = IV[1]; 98 | v[10] = IV[2]; 99 | v[11] = IV[3]; 100 | v[12] = ctx->t[0] ^ IV[4]; 101 | v[13] = ctx->t[1] ^ IV[5]; 102 | v[14] = ctx->f[0] ^ IV[6]; 103 | v[15] = ctx->f[1] ^ IV[7]; 104 | 105 | ROUND( 0 ); 106 | ROUND( 1 ); 107 | ROUND( 2 ); 108 | ROUND( 3 ); 109 | ROUND( 4 ); 110 | ROUND( 5 ); 111 | ROUND( 6 ); 112 | ROUND( 7 ); 113 | ROUND( 8 ); 114 | ROUND( 9 ); 115 | 116 | for( i = 0; i < 8; ++i ) 117 | ctx->h[i] = ctx->h[i] ^ v[i] ^ v[i + 8]; 118 | } 119 | 120 | #undef G 121 | #undef ROUND 122 | 123 | void digestif_blake2s_update( struct blake2s_ctx *ctx, uint8_t *data, uint32_t inlen ) 124 | { 125 | const unsigned char * in = (const unsigned char *) data; 126 | 127 | if( inlen > 0 ) 128 | { 129 | size_t left = ctx->buflen; 130 | size_t fill = BLAKE2S_BLOCKBYTES - left; 131 | 132 | if( inlen > fill ) 133 | { 134 | ctx->buflen = 0; 135 | memcpy( ctx->buf + left, in, fill ); 136 | blake2s_increment_counter( ctx, BLAKE2S_BLOCKBYTES ); 137 | blake2s_compress( ctx, ctx->buf ); 138 | in += fill; 139 | inlen -= fill; 140 | 141 | while (inlen > BLAKE2S_BLOCKBYTES) 142 | { 143 | blake2s_increment_counter( ctx, BLAKE2S_BLOCKBYTES ); 144 | blake2s_compress( ctx, in ); 145 | in += BLAKE2S_BLOCKBYTES; 146 | inlen -= BLAKE2S_BLOCKBYTES; 147 | } 148 | } 149 | 150 | memcpy( ctx->buf + ctx->buflen, in, inlen ); 151 | ctx->buflen += inlen; 152 | } 153 | } 154 | 155 | void digestif_blake2s_init_with_outlen_and_key(struct blake2s_ctx *ctx, size_t outlen, const void *key, size_t keylen) 156 | { 157 | struct blake2s_param P[1]; 158 | const unsigned char * p = ( const uint8_t * )( P ); 159 | size_t i; 160 | 161 | memset( ctx, 0, sizeof( struct blake2s_ctx ) ); 162 | 163 | P->digest_length = (uint8_t) outlen; 164 | P->key_length = (uint8_t) keylen; 165 | P->fanout = 1; 166 | P->depth = 1; 167 | P->leaf_length = 0; 168 | P->node_offset = 0; 169 | P->xof_length = 0; 170 | P->node_depth = 0; 171 | P->inner_length = 0; 172 | 173 | memset( P->salt, 0, sizeof( P->salt ) ); 174 | memset( P->personal, 0, sizeof( P->personal ) ); 175 | 176 | for( i = 0; i < 8; ++i ) 177 | ctx->h[i] = IV[i] ^ load32(p + sizeof(uint32_t) * i); 178 | 179 | ctx->outlen = P->digest_length; 180 | 181 | if( keylen > 0 ) 182 | { 183 | uint8_t block[BLAKE2S_BLOCKBYTES]; 184 | memset( block, 0, BLAKE2S_BLOCKBYTES ); 185 | memcpy( block, key, keylen ); 186 | digestif_blake2s_update( ctx, block, BLAKE2S_BLOCKBYTES ); 187 | secure_zero_memory( block, BLAKE2S_BLOCKBYTES ); 188 | } 189 | } 190 | 191 | void digestif_blake2s_init(struct blake2s_ctx *ctx) 192 | { 193 | digestif_blake2s_init_with_outlen_and_key(ctx, BLAKE2S_OUTBYTES, NULL, 0); 194 | } 195 | 196 | void digestif_blake2s_finalize( struct blake2s_ctx *ctx, uint8_t *out ) 197 | { 198 | uint8_t buffer[BLAKE2S_OUTBYTES] = { 0 }; 199 | size_t i; 200 | 201 | blake2s_increment_counter( ctx, ctx->buflen ); 202 | blake2s_set_lastblock( ctx ); 203 | memset( ctx->buf + ctx->buflen, 0, BLAKE2S_BLOCKBYTES - ctx->buflen ); 204 | blake2s_compress( ctx, ctx->buf ); 205 | 206 | for( i = 0; i < 8; ++i ) 207 | store32(buffer + sizeof( ctx->h[i] ) * i, ctx->h[i]); 208 | 209 | secure_zero_memory( out, ctx->outlen * sizeof(uint8_t) ); 210 | memcpy( out, buffer, (ctx->outlen < BLAKE2S_OUTBYTES) ? ctx->outlen : BLAKE2S_OUTBYTES ); 211 | secure_zero_memory( buffer, sizeof(buffer) ); 212 | } 213 | 214 | -------------------------------------------------------------------------------- /src-c/native/blake2s.h: -------------------------------------------------------------------------------- 1 | #ifndef CRYPTOHASH_BLAKE2S_H 2 | #define CRYPTOHASH_BLAKE2S_H 3 | 4 | #include 5 | 6 | #if defined(_MSC_VER) 7 | #define PACKED(x) __pragma(pack(push, 1)) x __pragma(pack(pop)) 8 | #else 9 | #define PACKED(x) x __attribute((packed)) 10 | #endif 11 | 12 | enum blake2s_constant 13 | { 14 | BLAKE2S_BLOCKBYTES = 64, 15 | BLAKE2S_OUTBYTES = 32, 16 | BLAKE2S_KEYBYTES = 32, 17 | BLAKE2S_SALTBYTES = 8, 18 | BLAKE2S_PERSONALBYTES = 8 19 | }; 20 | 21 | struct blake2s_ctx 22 | { 23 | uint32_t h[8]; 24 | uint32_t t[2]; 25 | uint32_t f[2]; 26 | uint8_t buf[BLAKE2S_BLOCKBYTES]; 27 | size_t buflen; 28 | size_t outlen; 29 | uint8_t last_node; 30 | }; 31 | 32 | PACKED(struct blake2s_param 33 | { 34 | uint8_t digest_length; /* 1 */ 35 | uint8_t key_length; /* 2 */ 36 | uint8_t fanout; /* 3 */ 37 | uint8_t depth; /* 4 */ 38 | uint32_t leaf_length; /* 8 */ 39 | uint32_t node_offset; /* 12 */ 40 | uint16_t xof_length; /* 14 */ 41 | uint8_t node_depth; /* 15 */ 42 | uint8_t inner_length; /* 16 */ 43 | uint8_t salt[BLAKE2S_SALTBYTES]; /* 24 */ 44 | uint8_t personal[BLAKE2S_PERSONALBYTES]; /* 32 */ 45 | }); 46 | 47 | #define BLAKE2S_DIGEST_SIZE BLAKE2S_BLOCKBYTES 48 | #define BLAKE2S_CTX_SIZE (sizeof(struct blake2s_ctx)) 49 | 50 | void digestif_blake2s_init(struct blake2s_ctx *ctx); 51 | void digestif_blake2s_init_with_outlen_and_key(struct blake2s_ctx *ctx, size_t outlen, const void *key, size_t keylen); 52 | void digestif_blake2s_update(struct blake2s_ctx *ctx, uint8_t *data, uint32_t len); 53 | void digestif_blake2s_finalize(struct blake2s_ctx *ctx, uint8_t *out); 54 | 55 | #endif 56 | -------------------------------------------------------------------------------- /src-c/native/digestif.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2014-2016 David Kaloper Meršinjak 3 | * 4 | * Permission to use, copy, modify, and/or distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | */ 16 | 17 | #if !defined(H__DIGESTIF) 18 | #define H__DIGESTIF 19 | 20 | #include 21 | #include 22 | #include 23 | 24 | #include "bitfn.h" 25 | 26 | #if defined (__x86_64__) && defined (ACCELERATE) 27 | #include 28 | #endif 29 | 30 | #if defined (__x86_64__) && defined (ACCELERATE) && defined (__SSE2__) 31 | #define __digestif_SSE2 32 | #endif 33 | 34 | #ifndef __unused 35 | # if defined(_MSC_VER) && _MSC_VER >= 1500 36 | # define __unused(x) __pragma( warning (push) ) \ 37 | __pragma( warning (disable:4189 ) ) \ 38 | x \ 39 | __pragma( warning (pop)) 40 | # else 41 | # define __unused(x) x __attribute__((unused)) 42 | # endif 43 | #endif 44 | #define __unit() value __unused(unit) 45 | 46 | typedef unsigned long u_long; 47 | 48 | #define _ba_uint8_off(ba, off) ((uint8_t*) Caml_ba_data_val (ba) + Long_val (off)) 49 | #define _ba_uint32_off(ba, off) ((uint32_t*) Caml_ba_data_val (ba) + Long_val (off)) 50 | #define _ba_ulong_off(ba, off) ((u_long*) Caml_ba_data_val (ba) + Long_val (off)) 51 | 52 | #define _st_uint8_off(st, off) ((uint8_t*) String_val (st) + Long_val (off)) 53 | #define _st_uint32_off(st, off) ((uint32_t*) String_val (st) + Long_val (off)) 54 | #define _st_ulong_off(st, off) ((u_long*) String_val (st) + Long_val (off)) 55 | 56 | #define _ba_uint8(ba) _ba_uint8_off (ba, 0) 57 | #define _ba_uint32(ba) _ba_uint32_off (ba, 0) 58 | #define _ba_ulong(ba) _ba_ulong_off (ba, 0) 59 | 60 | #define _st_uint8(st) _st_uint8_off(st, 0) 61 | #define _st_uint32(st) _st_uint32_off(st, 0) 62 | #define _st_ulong(st) _st_ulong_off (st, 0) 63 | 64 | #define _ba_uint8_option_off(ba, off) (Is_block(ba) ? _ba_uint8_off(Field(ba, 0), off) : 0) 65 | #define _ba_uint8_option(ba) _ba_uint8_option_off (ba, 0) 66 | 67 | #define _st_uint8_option_off(st, off) (Is_block(st) ? _st_uint8_off(Field(st, 0), off) : 0) 68 | #define _st_uint8_option(st) _ba_uint8_option_off (st, 0) 69 | 70 | #define __define_bc_6(f) \ 71 | CAMLprim value f ## _bc (value *v, int __unused(c) ) { return f(v[0], v[1], v[2], v[3], v[4], v[5]); } 72 | 73 | #define __define_bc_7(f) \ 74 | CAMLprim value f ## _bc (value *v, int __unused(c) ) { return f(v[0], v[1], v[2], v[3], v[4], v[5], v[6]); } 75 | 76 | #endif /* H__DIGESTIF */ 77 | -------------------------------------------------------------------------------- /src-c/native/md5.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2006-2009 Vincent Hanquez 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 1. Redistributions of source code must retain the above copyright 8 | * notice, this list of conditions and the following disclaimer. 9 | * 2. Redistributions in binary form must reproduce the above copyright 10 | * notice, this list of conditions and the following disclaimer in the 11 | * documentation and/or other materials provided with the distribution. 12 | * 13 | * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 14 | * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 15 | * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 16 | * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 17 | * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 18 | * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 19 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 20 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 22 | * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | */ 24 | 25 | #include 26 | #include 27 | #include "bitfn.h" 28 | #include "md5.h" 29 | 30 | void digestif_md5_init(struct md5_ctx *ctx) 31 | { 32 | memset(ctx, 0, sizeof(*ctx)); 33 | 34 | ctx->sz = 0ULL; 35 | ctx->h[0] = 0x67452301; 36 | ctx->h[1] = 0xefcdab89; 37 | ctx->h[2] = 0x98badcfe; 38 | ctx->h[3] = 0x10325476; 39 | } 40 | 41 | #define f1(x, y, z) (z ^ (x & (y ^ z))) 42 | #define f2(x, y, z) f1(z, x, y) 43 | #define f3(x, y, z) (x ^ y ^ z) 44 | #define f4(x, y, z) (y ^ (x | ~z)) 45 | #define R(f, a, b, c, d, i, k, s) a += f(b, c, d) + w[i] + k; a = rol32(a, s); a += b 46 | 47 | static void md5_do_chunk(struct md5_ctx *ctx, uint32_t *buf) 48 | { 49 | uint32_t a, b, c, d; 50 | #ifdef ARCH_IS_BIG_ENDIAN 51 | uint32_t w[16]; 52 | cpu_to_le32_array(w, buf, 16); 53 | #else 54 | uint32_t *w = buf; 55 | #endif 56 | a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3]; 57 | 58 | R(f1, a, b, c, d, 0, 0xd76aa478, 7); 59 | R(f1, d, a, b, c, 1, 0xe8c7b756, 12); 60 | R(f1, c, d, a, b, 2, 0x242070db, 17); 61 | R(f1, b, c, d, a, 3, 0xc1bdceee, 22); 62 | R(f1, a, b, c, d, 4, 0xf57c0faf, 7); 63 | R(f1, d, a, b, c, 5, 0x4787c62a, 12); 64 | R(f1, c, d, a, b, 6, 0xa8304613, 17); 65 | R(f1, b, c, d, a, 7, 0xfd469501, 22); 66 | R(f1, a, b, c, d, 8, 0x698098d8, 7); 67 | R(f1, d, a, b, c, 9, 0x8b44f7af, 12); 68 | R(f1, c, d, a, b, 10, 0xffff5bb1, 17); 69 | R(f1, b, c, d, a, 11, 0x895cd7be, 22); 70 | R(f1, a, b, c, d, 12, 0x6b901122, 7); 71 | R(f1, d, a, b, c, 13, 0xfd987193, 12); 72 | R(f1, c, d, a, b, 14, 0xa679438e, 17); 73 | R(f1, b, c, d, a, 15, 0x49b40821, 22); 74 | 75 | R(f2, a, b, c, d, 1, 0xf61e2562, 5); 76 | R(f2, d, a, b, c, 6, 0xc040b340, 9); 77 | R(f2, c, d, a, b, 11, 0x265e5a51, 14); 78 | R(f2, b, c, d, a, 0, 0xe9b6c7aa, 20); 79 | R(f2, a, b, c, d, 5, 0xd62f105d, 5); 80 | R(f2, d, a, b, c, 10, 0x02441453, 9); 81 | R(f2, c, d, a, b, 15, 0xd8a1e681, 14); 82 | R(f2, b, c, d, a, 4, 0xe7d3fbc8, 20); 83 | R(f2, a, b, c, d, 9, 0x21e1cde6, 5); 84 | R(f2, d, a, b, c, 14, 0xc33707d6, 9); 85 | R(f2, c, d, a, b, 3, 0xf4d50d87, 14); 86 | R(f2, b, c, d, a, 8, 0x455a14ed, 20); 87 | R(f2, a, b, c, d, 13, 0xa9e3e905, 5); 88 | R(f2, d, a, b, c, 2, 0xfcefa3f8, 9); 89 | R(f2, c, d, a, b, 7, 0x676f02d9, 14); 90 | R(f2, b, c, d, a, 12, 0x8d2a4c8a, 20); 91 | 92 | R(f3, a, b, c, d, 5, 0xfffa3942, 4); 93 | R(f3, d, a, b, c, 8, 0x8771f681, 11); 94 | R(f3, c, d, a, b, 11, 0x6d9d6122, 16); 95 | R(f3, b, c, d, a, 14, 0xfde5380c, 23); 96 | R(f3, a, b, c, d, 1, 0xa4beea44, 4); 97 | R(f3, d, a, b, c, 4, 0x4bdecfa9, 11); 98 | R(f3, c, d, a, b, 7, 0xf6bb4b60, 16); 99 | R(f3, b, c, d, a, 10, 0xbebfbc70, 23); 100 | R(f3, a, b, c, d, 13, 0x289b7ec6, 4); 101 | R(f3, d, a, b, c, 0, 0xeaa127fa, 11); 102 | R(f3, c, d, a, b, 3, 0xd4ef3085, 16); 103 | R(f3, b, c, d, a, 6, 0x04881d05, 23); 104 | R(f3, a, b, c, d, 9, 0xd9d4d039, 4); 105 | R(f3, d, a, b, c, 12, 0xe6db99e5, 11); 106 | R(f3, c, d, a, b, 15, 0x1fa27cf8, 16); 107 | R(f3, b, c, d, a, 2, 0xc4ac5665, 23); 108 | 109 | R(f4, a, b, c, d, 0, 0xf4292244, 6); 110 | R(f4, d, a, b, c, 7, 0x432aff97, 10); 111 | R(f4, c, d, a, b, 14, 0xab9423a7, 15); 112 | R(f4, b, c, d, a, 5, 0xfc93a039, 21); 113 | R(f4, a, b, c, d, 12, 0x655b59c3, 6); 114 | R(f4, d, a, b, c, 3, 0x8f0ccc92, 10); 115 | R(f4, c, d, a, b, 10, 0xffeff47d, 15); 116 | R(f4, b, c, d, a, 1, 0x85845dd1, 21); 117 | R(f4, a, b, c, d, 8, 0x6fa87e4f, 6); 118 | R(f4, d, a, b, c, 15, 0xfe2ce6e0, 10); 119 | R(f4, c, d, a, b, 6, 0xa3014314, 15); 120 | R(f4, b, c, d, a, 13, 0x4e0811a1, 21); 121 | R(f4, a, b, c, d, 4, 0xf7537e82, 6); 122 | R(f4, d, a, b, c, 11, 0xbd3af235, 10); 123 | R(f4, c, d, a, b, 2, 0x2ad7d2bb, 15); 124 | R(f4, b, c, d, a, 9, 0xeb86d391, 21); 125 | 126 | ctx->h[0] += a; ctx->h[1] += b; ctx->h[2] += c; ctx->h[3] += d; 127 | } 128 | 129 | void digestif_md5_update(struct md5_ctx *ctx, uint8_t *data, uint32_t len) 130 | { 131 | uint32_t index, to_fill; 132 | 133 | index = (uint32_t) (ctx->sz & 0x3f); 134 | to_fill = 64 - index; 135 | 136 | ctx->sz += len; 137 | 138 | if (index && len >= to_fill) { 139 | memcpy(ctx->buf + index, data, to_fill); 140 | md5_do_chunk(ctx, (uint32_t *) ctx->buf); 141 | len -= to_fill; 142 | data += to_fill; 143 | index = 0; 144 | } 145 | 146 | /* process as much 64-block as possible */ 147 | for (; len >= 64; len -= 64, data += 64) 148 | md5_do_chunk(ctx, (uint32_t *) data); 149 | 150 | /* append data into buf */ 151 | if (len) 152 | memcpy(ctx->buf + index, data, len); 153 | } 154 | 155 | void digestif_md5_finalize(struct md5_ctx *ctx, uint8_t *out) 156 | { 157 | static uint8_t padding[64] = { 0x80, }; 158 | uint64_t bits; 159 | uint32_t index, padlen; 160 | uint32_t *p = (uint32_t *) out; 161 | 162 | /* add padding and update data with it */ 163 | bits = cpu_to_le64(ctx->sz << 3); 164 | 165 | /* pad out to 56 */ 166 | index = (uint32_t) (ctx->sz & 0x3f); 167 | padlen = (index < 56) ? (56 - index) : ((64 + 56) - index); 168 | digestif_md5_update(ctx, padding, padlen); 169 | 170 | /* append length */ 171 | digestif_md5_update(ctx, (uint8_t *) &bits, sizeof(bits)); 172 | 173 | /* output hash */ 174 | p[0] = cpu_to_le32(ctx->h[0]); 175 | p[1] = cpu_to_le32(ctx->h[1]); 176 | p[2] = cpu_to_le32(ctx->h[2]); 177 | p[3] = cpu_to_le32(ctx->h[3]); 178 | } 179 | -------------------------------------------------------------------------------- /src-c/native/md5.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2006-2009 Vincent Hanquez 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 1. Redistributions of source code must retain the above copyright 8 | * notice, this list of conditions and the following disclaimer. 9 | * 2. Redistributions in binary form must reproduce the above copyright 10 | * notice, this list of conditions and the following disclaimer in the 11 | * documentation and/or other materials provided with the distribution. 12 | * 13 | * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 14 | * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 15 | * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 16 | * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 17 | * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 18 | * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 19 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 20 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 22 | * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | */ 24 | 25 | #ifndef CRYPTOHASH_MD5_H 26 | #define CRYPTOHASH_MD5_H 27 | 28 | #include 29 | 30 | struct md5_ctx 31 | { 32 | uint64_t sz; 33 | uint8_t buf[64]; 34 | uint32_t h[4]; 35 | }; 36 | 37 | #define MD5_DIGEST_SIZE 16 38 | #define MD5_CTX_SIZE sizeof(struct md5_ctx) 39 | 40 | void digestif_md5_init(struct md5_ctx *ctx); 41 | void digestif_md5_update(struct md5_ctx *ctx, uint8_t *data, uint32_t len); 42 | void digestif_md5_finalize(struct md5_ctx *ctx, uint8_t *out); 43 | 44 | #endif 45 | -------------------------------------------------------------------------------- /src-c/native/misc.c: -------------------------------------------------------------------------------- 1 | #include "digestif.h" 2 | 3 | #define u_long_s sizeof (unsigned long) 4 | 5 | static inline void xor_into (uint8_t *src, uint8_t *dst, size_t n) { 6 | #if defined (__digestif_SSE2__) 7 | while (n >= 16) { 8 | _mm_storeu_si128 ( 9 | (__m128i*) dst, 10 | _mm_xor_si128 ( 11 | _mm_loadu_si128 ((__m128i*) src), 12 | _mm_loadu_si128 ((__m128i*) dst))); 13 | src += 16; 14 | dst += 16; 15 | n -= 16; 16 | } 17 | #endif 18 | while (n >= u_long_s) { 19 | *((u_long *) dst) ^= *((u_long *) src); 20 | src += u_long_s; 21 | dst += u_long_s; 22 | n -= u_long_s; 23 | } 24 | while (n-- > 0) { 25 | *dst = *(src ++) ^ *dst; 26 | dst++; 27 | } 28 | } 29 | 30 | CAMLprim value 31 | caml_digestif_ba_xor_into (value b1, value off1, value b2, value off2, value n) { 32 | xor_into (_ba_uint8_off (b1, off1), _ba_uint8_off (b2, off2), Int_val (n)); 33 | return Val_unit; 34 | } 35 | 36 | CAMLprim value 37 | caml_digestif_st_xor_into (value b1, value off1, value b2, value off2, value n) { 38 | xor_into (_st_uint8_off (b1, off1), _st_uint8_off (b2, off2), Int_val (n)); 39 | return Val_unit; 40 | } 41 | -------------------------------------------------------------------------------- /src-c/native/ripemd160.c: -------------------------------------------------------------------------------- 1 | #include "ripemd160.h" 2 | #include "bitfn.h" 3 | 4 | // adapted by Pieter Wuille in 2012; all changes are in the public domain 5 | // modified by Ryan Castellucci in 2015; all changes are in the public domain 6 | // modified by Romain Calascibetta in 2017; all changes are in the public domain 7 | 8 | /* 9 | * 10 | * RIPEMD160.c : RIPEMD-160 implementation 11 | * 12 | * Written in 2008 by Dwayne C. Litzenberger 13 | * 14 | * =================================================================== 15 | * The contents of this file are dedicated to the public domain. To 16 | * the extent that dedication to the public domain is not available, 17 | * everyone is granted a worldwide, perpetual, royalty-free, 18 | * non-exclusive license to exercise all rights associated with the 19 | * contents of this file for any purpose whatsoever. 20 | * No rights are reserved. 21 | * 22 | * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 23 | * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 24 | * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 25 | * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS 26 | * BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN 27 | * ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 28 | * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 29 | * SOFTWARE. 30 | * =================================================================== 31 | * 32 | * Country of origin: Canada 33 | * 34 | * This implementation (written in C) is based on an implementation the author 35 | * wrote in Python. 36 | * 37 | * This implementation was written with reference to the RIPEMD-160 38 | * specification, which is available at: 39 | * http://homes.esat.kuleuven.be/~cosicart/pdf/AB-9601/ 40 | * 41 | * It is also documented in the _Handbook of Applied Cryptography_, as 42 | * Algorithm 9.55. It's on page 30 of the following PDF file: 43 | * http://www.cacr.math.uwaterloo.ca/hac/about/chap9.pdf 44 | * 45 | * The RIPEMD-160 specification doesn't really tell us how to do padding, but 46 | * since RIPEMD-160 is inspired by MD4, you can use the padding algorithm from 47 | * RFC 1320. 48 | * 49 | * According to http://www.users.zetnet.co.uk/hopwood/crypto/scan/md.html: 50 | * "RIPEMD-160 is big-bit-endian, little-byte-endian, and left-justified." 51 | */ 52 | 53 | #include 54 | #include 55 | 56 | /* Initial values for the chaining variables. 57 | * This is just 0123456789ABCDEFFEDCBA9876543210F0E1D2C3 in little-endian. */ 58 | static const uint32_t initial_h[5] = { 0x67452301u, 0xEFCDAB89u, 0x98BADCFEu, 0x10325476u, 0xC3D2E1F0u }; 59 | 60 | /* Ordering of message words. Based on the permutations rho(i) and pi(i), defined as follows: 61 | * 62 | * rho(i) := { 7, 4, 13, 1, 10, 6, 15, 3, 12, 0, 9, 5, 2, 14, 11, 8 }[i] 0 <= i <= 15 63 | * 64 | * pi(i) := 9*i + 5 (mod 16) 65 | * 66 | * Line | Round 1 | Round 2 | Round 3 | Round 4 | Round 5 67 | * -------+-----------+-----------+-----------+-----------+----------- 68 | * left | id | rho | rho^2 | rho^3 | rho^4 69 | * right | pi | rho pi | rho^2 pi | rho^3 pi | rho^4 pi 70 | */ 71 | 72 | /* Left line */ 73 | static const uint8_t RL[5][16] = { 74 | { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 }, /* Round 1: id */ 75 | { 7, 4, 13, 1, 10, 6, 15, 3, 12, 0, 9, 5, 2, 14, 11, 8 }, /* Round 2: rho */ 76 | { 3, 10, 14, 4, 9, 15, 8, 1, 2, 7, 0, 6, 13, 11, 5, 12 }, /* Round 3: rho^2 */ 77 | { 1, 9, 11, 10, 0, 8, 12, 4, 13, 3, 7, 15, 14, 5, 6, 2 }, /* Round 4: rho^3 */ 78 | { 4, 0, 5, 9, 7, 12, 2, 10, 14, 1, 3, 8, 11, 6, 15, 13 } /* Round 5: rho^4 */ 79 | }; 80 | 81 | /* Right line */ 82 | static const uint8_t RR[5][16] = { 83 | { 5, 14, 7, 0, 9, 2, 11, 4, 13, 6, 15, 8, 1, 10, 3, 12 }, /* Round 1: pi */ 84 | { 6, 11, 3, 7, 0, 13, 5, 10, 14, 15, 8, 12, 4, 9, 1, 2 }, /* Round 2: rho pi */ 85 | { 15, 5, 1, 3, 7, 14, 6, 9, 11, 8, 12, 2, 10, 0, 4, 13 }, /* Round 3: rho^2 pi */ 86 | { 8, 6, 4, 1, 3, 11, 15, 0, 5, 12, 2, 13, 9, 7, 10, 14 }, /* Round 4: rho^3 pi */ 87 | { 12, 15, 10, 4, 1, 5, 8, 7, 6, 2, 13, 14, 0, 3, 9, 11 } /* Round 5: rho^4 pi */ 88 | }; 89 | 90 | /* 91 | * Shifts - Since we don't actually re-order the message words according to 92 | * the permutations above (we could, but it would be slower), these tables 93 | * come with the permutations pre-applied. 94 | */ 95 | 96 | /* Shifts, left line */ 97 | static const uint8_t SL[5][16] = { 98 | { 11, 14, 15, 12, 5, 8, 7, 9, 11, 13, 14, 15, 6, 7, 9, 8 }, /* Round 1 */ 99 | { 7, 6, 8, 13, 11, 9, 7, 15, 7, 12, 15, 9, 11, 7, 13, 12 }, /* Round 2 */ 100 | { 11, 13, 6, 7, 14, 9, 13, 15, 14, 8, 13, 6, 5, 12, 7, 5 }, /* Round 3 */ 101 | { 11, 12, 14, 15, 14, 15, 9, 8, 9, 14, 5, 6, 8, 6, 5, 12 }, /* Round 4 */ 102 | { 9, 15, 5, 11, 6, 8, 13, 12, 5, 12, 13, 14, 11, 8, 5, 6 } /* Round 5 */ 103 | }; 104 | 105 | /* Shifts, right line */ 106 | static const uint8_t SR[5][16] = { 107 | { 8, 9, 9, 11, 13, 15, 15, 5, 7, 7, 8, 11, 14, 14, 12, 6 }, /* Round 1 */ 108 | { 9, 13, 15, 7, 12, 8, 9, 11, 7, 7, 12, 7, 6, 15, 13, 11 }, /* Round 2 */ 109 | { 9, 7, 15, 11, 8, 6, 6, 14, 12, 13, 5, 14, 13, 13, 7, 5 }, /* Round 3 */ 110 | { 15, 5, 8, 11, 14, 14, 6, 14, 6, 9, 12, 9, 12, 5, 15, 8 }, /* Round 4 */ 111 | { 8, 5, 12, 9, 12, 5, 14, 6, 8, 13, 6, 5, 15, 13, 11, 11 } /* Round 5 */ 112 | }; 113 | 114 | /* static padding for 256 bit input */ 115 | static const uint8_t pad256[32] = { 116 | 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 117 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 118 | 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 119 | /* length 256 bits, little endian uint64_t */ 120 | 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 121 | }; 122 | 123 | /* Boolean functions */ 124 | 125 | #define F1(x, y, z) ((x) ^ (y) ^ (z)) 126 | #define F2(x, y, z) (((x) & (y)) | (~(x) & (z))) 127 | #define F3(x, y, z) (((x) | ~(y)) ^ (z)) 128 | #define F4(x, y, z) (((x) & (z)) | ((y) & ~(z))) 129 | #define F5(x, y, z) ((x) ^ ((y) | ~(z))) 130 | 131 | /* Round constants, left line */ 132 | static const uint32_t KL[5] = { 133 | 0x00000000u, /* Round 1: 0 */ 134 | 0x5A827999u, /* Round 2: floor(2**30 * sqrt(2)) */ 135 | 0x6ED9EBA1u, /* Round 3: floor(2**30 * sqrt(3)) */ 136 | 0x8F1BBCDCu, /* Round 4: floor(2**30 * sqrt(5)) */ 137 | 0xA953FD4Eu /* Round 5: floor(2**30 * sqrt(7)) */ 138 | }; 139 | 140 | /* Round constants, right line */ 141 | static const uint32_t KR[5] = { 142 | 0x50A28BE6u, /* Round 1: floor(2**30 * cubert(2)) */ 143 | 0x5C4DD124u, /* Round 2: floor(2**30 * cubert(3)) */ 144 | 0x6D703EF3u, /* Round 3: floor(2**30 * cubert(5)) */ 145 | 0x7A6D76E9u, /* Round 4: floor(2**30 * cubert(7)) */ 146 | 0x00000000u /* Round 5: 0 */ 147 | }; 148 | 149 | void digestif_rmd160_init(struct rmd160_ctx *ctx) 150 | { 151 | memset(ctx, 0, sizeof(*ctx)); 152 | 153 | ctx->h[0] = 0x67452301UL; 154 | ctx->h[1] = 0xefcdab89UL; 155 | ctx->h[2] = 0x98badcfeUL; 156 | ctx->h[3] = 0x10325476UL; 157 | ctx->h[4] = 0xc3d2e1f0UL; 158 | 159 | ctx->sz[0] = 0; 160 | ctx->sz[1] = 0; 161 | 162 | ctx->n = 0; 163 | } 164 | 165 | /* The RIPEMD160 compression function. */ 166 | static inline void rmd160_compress(struct rmd160_ctx *ctx, uint32_t *buf) 167 | { 168 | uint8_t w, round; 169 | uint32_t T; 170 | uint32_t AL, BL, CL, DL, EL; /* left line */ 171 | uint32_t AR, BR, CR, DR, ER; /* right line */ 172 | uint32_t X[16]; 173 | 174 | /* Byte-swap the buffer if we're on a big-endian machine */ 175 | cpu_to_le32_array(X, buf, 16); 176 | 177 | /* Load the left and right lines with the initial state */ 178 | AL = AR = ctx->h[0]; 179 | BL = BR = ctx->h[1]; 180 | CL = CR = ctx->h[2]; 181 | DL = DR = ctx->h[3]; 182 | EL = ER = ctx->h[4]; 183 | 184 | /* Round 1 */ 185 | round = 0; 186 | for (w = 0; w < 16; w++) { /* left line */ 187 | T = rol32(AL + F1(BL, CL, DL) + X[RL[round][w]] + KL[round], SL[round][w]) + EL; 188 | AL = EL; EL = DL; DL = rol32(CL, 10); CL = BL; BL = T; 189 | } 190 | for (w = 0; w < 16; w++) { /* right line */ 191 | T = rol32(AR + F5(BR, CR, DR) + X[RR[round][w]] + KR[round], SR[round][w]) + ER; 192 | AR = ER; ER = DR; DR = rol32(CR, 10); CR = BR; BR = T; 193 | } 194 | 195 | /* Round 2 */ 196 | round++; 197 | for (w = 0; w < 16; w++) { /* left line */ 198 | T = rol32(AL + F2(BL, CL, DL) + X[RL[round][w]] + KL[round], SL[round][w]) + EL; 199 | AL = EL; EL = DL; DL = rol32(CL, 10); CL = BL; BL = T; 200 | } 201 | for (w = 0; w < 16; w++) { /* right line */ 202 | T = rol32(AR + F4(BR, CR, DR) + X[RR[round][w]] + KR[round], SR[round][w]) + ER; 203 | AR = ER; ER = DR; DR = rol32(CR, 10); CR = BR; BR = T; 204 | } 205 | 206 | /* Round 3 */ 207 | round++; 208 | for (w = 0; w < 16; w++) { /* left line */ 209 | T = rol32(AL + F3(BL, CL, DL) + X[RL[round][w]] + KL[round], SL[round][w]) + EL; 210 | AL = EL; EL = DL; DL = rol32(CL, 10); CL = BL; BL = T; 211 | } 212 | for (w = 0; w < 16; w++) { /* right line */ 213 | T = rol32(AR + F3(BR, CR, DR) + X[RR[round][w]] + KR[round], SR[round][w]) + ER; 214 | AR = ER; ER = DR; DR = rol32(CR, 10); CR = BR; BR = T; 215 | } 216 | 217 | /* Round 4 */ 218 | round++; 219 | for (w = 0; w < 16; w++) { /* left line */ 220 | T = rol32(AL + F4(BL, CL, DL) + X[RL[round][w]] + KL[round], SL[round][w]) + EL; 221 | AL = EL; EL = DL; DL = rol32(CL, 10); CL = BL; BL = T; 222 | } 223 | for (w = 0; w < 16; w++) { /* right line */ 224 | T = rol32(AR + F2(BR, CR, DR) + X[RR[round][w]] + KR[round], SR[round][w]) + ER; 225 | AR = ER; ER = DR; DR = rol32(CR, 10); CR = BR; BR = T; 226 | } 227 | 228 | /* Round 5 */ 229 | round++; 230 | for (w = 0; w < 16; w++) { /* left line */ 231 | T = rol32(AL + F5(BL, CL, DL) + X[RL[round][w]] + KL[round], SL[round][w]) + EL; 232 | AL = EL; EL = DL; DL = rol32(CL, 10); CL = BL; BL = T; 233 | } 234 | for (w = 0; w < 16; w++) { /* right line */ 235 | T = rol32(AR + F1(BR, CR, DR) + X[RR[round][w]] + KR[round], SR[round][w]) + ER; 236 | AR = ER; ER = DR; DR = rol32(CR, 10); CR = BR; BR = T; 237 | } 238 | 239 | /* Final mixing stage */ 240 | T = ctx->h[1] + CL + DR; 241 | ctx->h[1] = ctx->h[2] + DL + ER; 242 | ctx->h[2] = ctx->h[3] + EL + AR; 243 | ctx->h[3] = ctx->h[4] + AL + BR; 244 | ctx->h[4] = ctx->h[0] + BL + CR; 245 | ctx->h[0] = T; 246 | } 247 | 248 | void digestif_rmd160_update(struct rmd160_ctx *ctx, uint8_t *data, uint32_t len) 249 | { 250 | uint32_t t; 251 | 252 | /* update length */ 253 | t = ctx->sz[0]; 254 | 255 | if ((ctx->sz[0] = t + (len << 3)) < t) 256 | ctx->sz[1]++; /* carry from low 32 bits to high 32 bits. */ 257 | 258 | ctx->sz[1] += (len >> 29); 259 | 260 | /* if data was left in buffer, pad it with fresh data and munge/eat block. */ 261 | if (ctx->n != 0) 262 | { 263 | t = 64 - ctx->n; 264 | 265 | if (len < t) /* not enough to munge. */ 266 | { 267 | memcpy(ctx->buf + ctx->n, data, len); 268 | ctx->n += len; 269 | return; 270 | } 271 | 272 | memcpy(ctx->buf + ctx->n, data, t); 273 | rmd160_compress(ctx, (uint32_t *) ctx->buf); 274 | data += t; 275 | len -= t; 276 | } 277 | 278 | /* munge/eat data in 64 bytes chunks. */ 279 | while (len >= 64) 280 | { 281 | /* memcpy(ctx->buf, data, 64); XXX(dinosaure): from X.L. but 282 | avoid to be fast. */ 283 | rmd160_compress(ctx, (uint32_t *) data); 284 | data += 64; 285 | len -= 64; 286 | } 287 | 288 | /* save remaining data. */ 289 | memcpy(ctx->buf, data, len); 290 | ctx->n = len; 291 | } 292 | 293 | void digestif_rmd160_finalize(struct rmd160_ctx *ctx, uint8_t *out) 294 | { 295 | int i = ctx->n; 296 | 297 | ctx->buf[i++] = 0x80; 298 | 299 | if (i > 56) 300 | { 301 | memset(ctx->buf + i, 0, 64 - i); 302 | rmd160_compress(ctx, (uint32_t *) ctx->buf); 303 | i = 0; 304 | } 305 | 306 | memset(ctx->buf + i, 0, 56 - i); 307 | cpu_to_le32_array((uint32_t *) (ctx->buf + 56), ctx->sz, 2); 308 | rmd160_compress(ctx, (uint32_t *) ctx->buf); 309 | cpu_to_le32_array((uint32_t *) out, ctx->h, 5); 310 | } 311 | -------------------------------------------------------------------------------- /src-c/native/ripemd160.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2017 Romain Calascibetta 3 | * 4 | * 5 | * Redistribution and use in source and binary forms, with or without 6 | * modification, are permitted provided that the following conditions 7 | * are met: 8 | * 1. Redistributions of source code must retain the above copyright 9 | * notice, this list of conditions and the following disclaimer. 10 | * 2. Redistributions in binary form must reproduce the above copyright 11 | * notice, this list of conditions and the following disclaimer in the 12 | * documentation and/or other materials provided with the distribution. 13 | * 14 | * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 15 | * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 16 | * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 17 | * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 18 | * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 19 | * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 20 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 21 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 22 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 23 | * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 | */ 25 | 26 | #ifndef CRYPTOHASH_RMD160_H 27 | #define CRYPTOHASH_RMD160_H 28 | 29 | #include 30 | 31 | struct rmd160_ctx 32 | { 33 | uint32_t h[5]; 34 | uint32_t sz[2]; 35 | int n; 36 | uint8_t buf[64]; 37 | }; 38 | 39 | #define RMD160_DIGEST_SIZE 20 40 | #define RMD160_CTX_SIZE (sizeof(struct rmd160_ctx)) 41 | 42 | void digestif_rmd160_init(struct rmd160_ctx *ctx); 43 | void digestif_rmd160_update(struct rmd160_ctx *ctx, uint8_t *data, uint32_t len); 44 | void digestif_rmd160_finalize(struct rmd160_ctx *ctx, uint8_t *out); 45 | 46 | #endif 47 | -------------------------------------------------------------------------------- /src-c/native/sha1.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2006-2009 Vincent Hanquez 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 1. Redistributions of source code must retain the above copyright 8 | * notice, this list of conditions and the following disclaimer. 9 | * 2. Redistributions in binary form must reproduce the above copyright 10 | * notice, this list of conditions and the following disclaimer in the 11 | * documentation and/or other materials provided with the distribution. 12 | * 13 | * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 14 | * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 15 | * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 16 | * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 17 | * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 18 | * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 19 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 20 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 22 | * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | */ 24 | 25 | #include 26 | #include "sha1.h" 27 | #include "bitfn.h" 28 | 29 | void digestif_sha1_init(struct sha1_ctx *ctx) 30 | { 31 | memset(ctx, 0, sizeof(*ctx)); 32 | 33 | ctx->h[0] = 0x67452301; 34 | ctx->h[1] = 0xefcdab89; 35 | ctx->h[2] = 0x98badcfe; 36 | ctx->h[3] = 0x10325476; 37 | ctx->h[4] = 0xc3d2e1f0; 38 | } 39 | 40 | #define f1(x, y, z) (z ^ (x & (y ^ z))) 41 | #define f2(x, y, z) (x ^ y ^ z) 42 | #define f3(x, y, z) ((x & y) + (z & (x ^ y))) 43 | #define f4(x, y, z) f2(x, y, z) 44 | 45 | #define K1 0x5a827999 46 | #define K2 0x6ed9eba1 47 | #define K3 0x8f1bbcdc 48 | #define K4 0xca62c1d6 49 | 50 | #define R(a, b, c, d, e, f, k, w) \ 51 | e += rol32(a, 5) + f(b, c, d) + k + w; b = rol32(b, 30) 52 | 53 | #define M(i) (w[i & 0x0f] = rol32(w[i & 0x0f] ^ w[(i - 14) & 0x0f] \ 54 | ^ w[(i - 8) & 0x0f] ^ w[(i - 3) & 0x0f], 1)) 55 | 56 | static inline void sha1_do_chunk(struct sha1_ctx *ctx, uint32_t *buf) 57 | { 58 | uint32_t a, b, c, d, e; 59 | uint32_t w[16]; 60 | #define CPY(i) w[i] = be32_to_cpu(buf[i]) 61 | CPY(0); CPY(1); CPY(2); CPY(3); CPY(4); CPY(5); CPY(6); CPY(7); 62 | CPY(8); CPY(9); CPY(10); CPY(11); CPY(12); CPY(13); CPY(14); CPY(15); 63 | #undef CPY 64 | 65 | a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3]; e = ctx->h[4]; 66 | 67 | R(a, b, c, d, e, f1, K1, w[0]); 68 | R(e, a, b, c, d, f1, K1, w[1]); 69 | R(d, e, a, b, c, f1, K1, w[2]); 70 | R(c, d, e, a, b, f1, K1, w[3]); 71 | R(b, c, d, e, a, f1, K1, w[4]); 72 | R(a, b, c, d, e, f1, K1, w[5]); 73 | R(e, a, b, c, d, f1, K1, w[6]); 74 | R(d, e, a, b, c, f1, K1, w[7]); 75 | R(c, d, e, a, b, f1, K1, w[8]); 76 | R(b, c, d, e, a, f1, K1, w[9]); 77 | R(a, b, c, d, e, f1, K1, w[10]); 78 | R(e, a, b, c, d, f1, K1, w[11]); 79 | R(d, e, a, b, c, f1, K1, w[12]); 80 | R(c, d, e, a, b, f1, K1, w[13]); 81 | R(b, c, d, e, a, f1, K1, w[14]); 82 | R(a, b, c, d, e, f1, K1, w[15]); 83 | R(e, a, b, c, d, f1, K1, M(16)); 84 | R(d, e, a, b, c, f1, K1, M(17)); 85 | R(c, d, e, a, b, f1, K1, M(18)); 86 | R(b, c, d, e, a, f1, K1, M(19)); 87 | 88 | R(a, b, c, d, e, f2, K2, M(20)); 89 | R(e, a, b, c, d, f2, K2, M(21)); 90 | R(d, e, a, b, c, f2, K2, M(22)); 91 | R(c, d, e, a, b, f2, K2, M(23)); 92 | R(b, c, d, e, a, f2, K2, M(24)); 93 | R(a, b, c, d, e, f2, K2, M(25)); 94 | R(e, a, b, c, d, f2, K2, M(26)); 95 | R(d, e, a, b, c, f2, K2, M(27)); 96 | R(c, d, e, a, b, f2, K2, M(28)); 97 | R(b, c, d, e, a, f2, K2, M(29)); 98 | R(a, b, c, d, e, f2, K2, M(30)); 99 | R(e, a, b, c, d, f2, K2, M(31)); 100 | R(d, e, a, b, c, f2, K2, M(32)); 101 | R(c, d, e, a, b, f2, K2, M(33)); 102 | R(b, c, d, e, a, f2, K2, M(34)); 103 | R(a, b, c, d, e, f2, K2, M(35)); 104 | R(e, a, b, c, d, f2, K2, M(36)); 105 | R(d, e, a, b, c, f2, K2, M(37)); 106 | R(c, d, e, a, b, f2, K2, M(38)); 107 | R(b, c, d, e, a, f2, K2, M(39)); 108 | 109 | R(a, b, c, d, e, f3, K3, M(40)); 110 | R(e, a, b, c, d, f3, K3, M(41)); 111 | R(d, e, a, b, c, f3, K3, M(42)); 112 | R(c, d, e, a, b, f3, K3, M(43)); 113 | R(b, c, d, e, a, f3, K3, M(44)); 114 | R(a, b, c, d, e, f3, K3, M(45)); 115 | R(e, a, b, c, d, f3, K3, M(46)); 116 | R(d, e, a, b, c, f3, K3, M(47)); 117 | R(c, d, e, a, b, f3, K3, M(48)); 118 | R(b, c, d, e, a, f3, K3, M(49)); 119 | R(a, b, c, d, e, f3, K3, M(50)); 120 | R(e, a, b, c, d, f3, K3, M(51)); 121 | R(d, e, a, b, c, f3, K3, M(52)); 122 | R(c, d, e, a, b, f3, K3, M(53)); 123 | R(b, c, d, e, a, f3, K3, M(54)); 124 | R(a, b, c, d, e, f3, K3, M(55)); 125 | R(e, a, b, c, d, f3, K3, M(56)); 126 | R(d, e, a, b, c, f3, K3, M(57)); 127 | R(c, d, e, a, b, f3, K3, M(58)); 128 | R(b, c, d, e, a, f3, K3, M(59)); 129 | 130 | R(a, b, c, d, e, f4, K4, M(60)); 131 | R(e, a, b, c, d, f4, K4, M(61)); 132 | R(d, e, a, b, c, f4, K4, M(62)); 133 | R(c, d, e, a, b, f4, K4, M(63)); 134 | R(b, c, d, e, a, f4, K4, M(64)); 135 | R(a, b, c, d, e, f4, K4, M(65)); 136 | R(e, a, b, c, d, f4, K4, M(66)); 137 | R(d, e, a, b, c, f4, K4, M(67)); 138 | R(c, d, e, a, b, f4, K4, M(68)); 139 | R(b, c, d, e, a, f4, K4, M(69)); 140 | R(a, b, c, d, e, f4, K4, M(70)); 141 | R(e, a, b, c, d, f4, K4, M(71)); 142 | R(d, e, a, b, c, f4, K4, M(72)); 143 | R(c, d, e, a, b, f4, K4, M(73)); 144 | R(b, c, d, e, a, f4, K4, M(74)); 145 | R(a, b, c, d, e, f4, K4, M(75)); 146 | R(e, a, b, c, d, f4, K4, M(76)); 147 | R(d, e, a, b, c, f4, K4, M(77)); 148 | R(c, d, e, a, b, f4, K4, M(78)); 149 | R(b, c, d, e, a, f4, K4, M(79)); 150 | 151 | ctx->h[0] += a; 152 | ctx->h[1] += b; 153 | ctx->h[2] += c; 154 | ctx->h[3] += d; 155 | ctx->h[4] += e; 156 | } 157 | 158 | void digestif_sha1_update(struct sha1_ctx *ctx, uint8_t *data, uint32_t len) 159 | { 160 | uint32_t index, to_fill; 161 | 162 | index = (uint32_t) (ctx->sz & 0x3f); 163 | to_fill = 64 - index; 164 | 165 | ctx->sz += len; 166 | 167 | /* process partial buffer if there's enough data to make a block */ 168 | if (index && len >= to_fill) { 169 | memcpy(ctx->buf + index, data, to_fill); 170 | sha1_do_chunk(ctx, (uint32_t *) ctx->buf); 171 | len -= to_fill; 172 | data += to_fill; 173 | index = 0; 174 | } 175 | 176 | /* process as much 64-block as possible */ 177 | for (; len >= 64; len -= 64, data += 64) 178 | sha1_do_chunk(ctx, (uint32_t *) data); 179 | 180 | /* append data into buf */ 181 | if (len) 182 | memcpy(ctx->buf + index, data, len); 183 | } 184 | 185 | void digestif_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out) 186 | { 187 | static uint8_t padding[64] = { 0x80, }; 188 | uint64_t bits; 189 | uint32_t index, padlen; 190 | uint32_t *p = (uint32_t *) out; 191 | 192 | /* add padding and update data with it */ 193 | bits = cpu_to_be64(ctx->sz << 3); 194 | 195 | /* pad out to 56 */ 196 | index = (uint32_t) (ctx->sz & 0x3f); 197 | padlen = (index < 56) ? (56 - index) : ((64 + 56) - index); 198 | digestif_sha1_update(ctx, padding, padlen); 199 | 200 | /* append length */ 201 | digestif_sha1_update(ctx, (uint8_t *) &bits, sizeof(bits)); 202 | 203 | /* output hash */ 204 | p[0] = cpu_to_be32(ctx->h[0]); 205 | p[1] = cpu_to_be32(ctx->h[1]); 206 | p[2] = cpu_to_be32(ctx->h[2]); 207 | p[3] = cpu_to_be32(ctx->h[3]); 208 | p[4] = cpu_to_be32(ctx->h[4]); 209 | } 210 | -------------------------------------------------------------------------------- /src-c/native/sha1.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2006-2009 Vincent Hanquez 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 1. Redistributions of source code must retain the above copyright 8 | * notice, this list of conditions and the following disclaimer. 9 | * 2. Redistributions in binary form must reproduce the above copyright 10 | * notice, this list of conditions and the following disclaimer in the 11 | * documentation and/or other materials provided with the distribution. 12 | * 13 | * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 14 | * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 15 | * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 16 | * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 17 | * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 18 | * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 19 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 20 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 22 | * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | */ 24 | 25 | #ifndef CRYPTOHASH_SHA1_H 26 | #define CRYPTOHASH_SHA1_H 27 | 28 | #include 29 | 30 | struct sha1_ctx 31 | { 32 | uint64_t sz; 33 | uint8_t buf[64]; 34 | uint32_t h[5]; 35 | }; 36 | 37 | #define SHA1_DIGEST_SIZE 20 38 | #define SHA1_CTX_SIZE (sizeof(struct sha1_ctx)) 39 | 40 | void digestif_sha1_init(struct sha1_ctx *ctx); 41 | void digestif_sha1_update(struct sha1_ctx *ctx, uint8_t *data, uint32_t len); 42 | void digestif_sha1_finalize(struct sha1_ctx *ctx, uint8_t *out); 43 | 44 | #endif 45 | -------------------------------------------------------------------------------- /src-c/native/sha256.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2006-2009 Vincent Hanquez 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 1. Redistributions of source code must retain the above copyright 8 | * notice, this list of conditions and the following disclaimer. 9 | * 2. Redistributions in binary form must reproduce the above copyright 10 | * notice, this list of conditions and the following disclaimer in the 11 | * documentation and/or other materials provided with the distribution. 12 | * 13 | * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 14 | * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 15 | * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 16 | * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 17 | * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 18 | * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 19 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 20 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 22 | * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | */ 24 | 25 | #include 26 | #include "sha256.h" 27 | #include "bitfn.h" 28 | 29 | void digestif_sha224_init(struct sha224_ctx *ctx) 30 | { 31 | memset(ctx, 0, sizeof(*ctx)); 32 | 33 | ctx->h[0] = 0xc1059ed8; 34 | ctx->h[1] = 0x367cd507; 35 | ctx->h[2] = 0x3070dd17; 36 | ctx->h[3] = 0xf70e5939; 37 | ctx->h[4] = 0xffc00b31; 38 | ctx->h[5] = 0x68581511; 39 | ctx->h[6] = 0x64f98fa7; 40 | ctx->h[7] = 0xbefa4fa4; 41 | } 42 | 43 | void digestif_sha256_init(struct sha256_ctx *ctx) 44 | { 45 | memset(ctx, 0, sizeof(*ctx)); 46 | 47 | ctx->h[0] = 0x6a09e667; 48 | ctx->h[1] = 0xbb67ae85; 49 | ctx->h[2] = 0x3c6ef372; 50 | ctx->h[3] = 0xa54ff53a; 51 | ctx->h[4] = 0x510e527f; 52 | ctx->h[5] = 0x9b05688c; 53 | ctx->h[6] = 0x1f83d9ab; 54 | ctx->h[7] = 0x5be0cd19; 55 | } 56 | 57 | /* 232 times the cube root of the first 64 primes 2..311 */ 58 | static const uint32_t k[] = { 59 | 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5, 0x3956c25b, 0x59f111f1, 60 | 0x923f82a4, 0xab1c5ed5, 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3, 61 | 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174, 0xe49b69c1, 0xefbe4786, 62 | 0x0fc19dc6, 0x240ca1cc, 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da, 63 | 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7, 0xc6e00bf3, 0xd5a79147, 64 | 0x06ca6351, 0x14292967, 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13, 65 | 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85, 0xa2bfe8a1, 0xa81a664b, 66 | 0xc24b8b70, 0xc76c51a3, 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070, 67 | 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5, 0x391c0cb3, 0x4ed8aa4a, 68 | 0x5b9cca4f, 0x682e6ff3, 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208, 69 | 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2 70 | }; 71 | 72 | #define e0(x) (ror32(x, 2) ^ ror32(x,13) ^ ror32(x,22)) 73 | #define e1(x) (ror32(x, 6) ^ ror32(x,11) ^ ror32(x,25)) 74 | #define s0(x) (ror32(x, 7) ^ ror32(x,18) ^ (x >> 3)) 75 | #define s1(x) (ror32(x,17) ^ ror32(x,19) ^ (x >> 10)) 76 | 77 | static void sha256_do_chunk(struct sha256_ctx *ctx, uint32_t buf[]) 78 | { 79 | uint32_t a, b, c, d, e, f, g, h, t1, t2; 80 | int i; 81 | uint32_t w[64]; 82 | 83 | cpu_to_be32_array(w, buf, 16); 84 | for (i = 16; i < 64; i++) 85 | w[i] = s1(w[i - 2]) + w[i - 7] + s0(w[i - 15]) + w[i - 16]; 86 | 87 | a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3]; 88 | e = ctx->h[4]; f = ctx->h[5]; g = ctx->h[6]; h = ctx->h[7]; 89 | 90 | #define R(a, b, c, d, e, f, g, h, k, w) \ 91 | t1 = h + e1(e) + (g ^ (e & (f ^ g))) + k + w; \ 92 | t2 = e0(a) + ((a & b) | (c & (a | b))); \ 93 | d += t1; \ 94 | h = t1 + t2; 95 | 96 | for (i = 0; i < 64; i += 8) { 97 | R(a, b, c, d, e, f, g, h, k[i + 0], w[i + 0]); 98 | R(h, a, b, c, d, e, f, g, k[i + 1], w[i + 1]); 99 | R(g, h, a, b, c, d, e, f, k[i + 2], w[i + 2]); 100 | R(f, g, h, a, b, c, d, e, k[i + 3], w[i + 3]); 101 | R(e, f, g, h, a, b, c, d, k[i + 4], w[i + 4]); 102 | R(d, e, f, g, h, a, b, c, k[i + 5], w[i + 5]); 103 | R(c, d, e, f, g, h, a, b, k[i + 6], w[i + 6]); 104 | R(b, c, d, e, f, g, h, a, k[i + 7], w[i + 7]); 105 | } 106 | 107 | #undef R 108 | 109 | ctx->h[0] += a; ctx->h[1] += b; ctx->h[2] += c; ctx->h[3] += d; 110 | ctx->h[4] += e; ctx->h[5] += f; ctx->h[6] += g; ctx->h[7] += h; 111 | } 112 | 113 | void digestif_sha224_update(struct sha224_ctx *ctx, uint8_t *data, uint32_t len) 114 | { 115 | digestif_sha256_update(ctx, data, len); 116 | } 117 | 118 | void digestif_sha256_update(struct sha256_ctx *ctx, uint8_t *data, uint32_t len) 119 | { 120 | uint32_t index, to_fill; 121 | 122 | /* check for partial buffer */ 123 | index = (uint32_t) (ctx->sz & 0x3f); 124 | to_fill = 64 - index; 125 | 126 | ctx->sz += len; 127 | 128 | /* process partial buffer if there's enough data to make a block */ 129 | if (index && len >= to_fill) { 130 | memcpy(ctx->buf + index, data, to_fill); 131 | sha256_do_chunk(ctx, (uint32_t *) ctx->buf); 132 | len -= to_fill; 133 | data += to_fill; 134 | index = 0; 135 | } 136 | 137 | /* process as much 64-block as possible */ 138 | for (; len >= 64; len -= 64, data += 64) 139 | sha256_do_chunk(ctx, (uint32_t *) data); 140 | 141 | /* append data into buf */ 142 | if (len) 143 | memcpy(ctx->buf + index, data, len); 144 | } 145 | 146 | void digestif_sha224_finalize(struct sha224_ctx *ctx, uint8_t *out) 147 | { 148 | uint8_t intermediate[SHA256_DIGEST_SIZE]; 149 | 150 | digestif_sha256_finalize(ctx, intermediate); 151 | memcpy(out, intermediate, SHA224_DIGEST_SIZE); 152 | } 153 | 154 | void digestif_sha256_finalize(struct sha256_ctx *ctx, uint8_t *out) 155 | { 156 | static uint8_t padding[64] = { 0x80, }; 157 | uint64_t bits; 158 | uint32_t i, index, padlen; 159 | uint32_t *p = (uint32_t *) out; 160 | 161 | /* cpu -> big endian */ 162 | bits = cpu_to_be64(ctx->sz << 3); 163 | 164 | /* pad out to 56 */ 165 | index = (uint32_t) (ctx->sz & 0x3f); 166 | padlen = (index < 56) ? (56 - index) : ((64 + 56) - index); 167 | digestif_sha256_update(ctx, padding, padlen); 168 | 169 | /* append length */ 170 | digestif_sha256_update(ctx, (uint8_t *) &bits, sizeof(bits)); 171 | 172 | /* store to digest */ 173 | for (i = 0; i < 8; i++) 174 | p[i] = cpu_to_be32(ctx->h[i]); 175 | } 176 | -------------------------------------------------------------------------------- /src-c/native/sha256.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2006-2009 Vincent Hanquez 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 1. Redistributions of source code must retain the above copyright 8 | * notice, this list of conditions and the following disclaimer. 9 | * 2. Redistributions in binary form must reproduce the above copyright 10 | * notice, this list of conditions and the following disclaimer in the 11 | * documentation and/or other materials provided with the distribution. 12 | * 13 | * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 14 | * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 15 | * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 16 | * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 17 | * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 18 | * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 19 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 20 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 22 | * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | */ 24 | 25 | #ifndef CRYPTOHASH_SHA256_H 26 | #define CRYPTOHASH_SHA256_H 27 | 28 | #include 29 | 30 | struct sha256_ctx 31 | { 32 | uint64_t sz; 33 | uint8_t buf[128]; 34 | uint32_t h[8]; 35 | }; 36 | 37 | #define sha224_ctx sha256_ctx 38 | 39 | #define SHA224_DIGEST_SIZE 28 40 | #define SHA224_CTX_SIZE sizeof(struct sha224_ctx) 41 | 42 | #define SHA256_DIGEST_SIZE 32 43 | #define SHA256_CTX_SIZE sizeof(struct sha256_ctx) 44 | 45 | void digestif_sha224_init(struct sha224_ctx *ctx); 46 | void digestif_sha224_update(struct sha224_ctx *ctx, uint8_t *data, uint32_t len); 47 | void digestif_sha224_finalize(struct sha224_ctx *ctx, uint8_t *out); 48 | 49 | void digestif_sha256_init(struct sha256_ctx *ctx); 50 | void digestif_sha256_update(struct sha256_ctx *ctx, uint8_t *data, uint32_t len); 51 | void digestif_sha256_finalize(struct sha256_ctx *ctx, uint8_t *out); 52 | 53 | #endif 54 | -------------------------------------------------------------------------------- /src-c/native/sha3.c: -------------------------------------------------------------------------------- 1 | /* Copyright (c) 2015 Markku-Juhani O. Saarinen */ 2 | 3 | #include "sha3.h" 4 | 5 | #ifndef KECCAKF_ROUNDS 6 | #define KECCAKF_ROUNDS 24 7 | #endif 8 | 9 | #ifndef ROTL64 10 | #define ROTL64(x, y) (((x) << (y)) | ((x) >> (64 - (y)))) 11 | #endif 12 | 13 | // update the state with given number of rounds 14 | 15 | static void sha3_keccakf(uint64_t st[25]) 16 | { 17 | // constants 18 | const uint64_t keccakf_rndc[24] = { 19 | 0x0000000000000001, 0x0000000000008082, 0x800000000000808a, 20 | 0x8000000080008000, 0x000000000000808b, 0x0000000080000001, 21 | 0x8000000080008081, 0x8000000000008009, 0x000000000000008a, 22 | 0x0000000000000088, 0x0000000080008009, 0x000000008000000a, 23 | 0x000000008000808b, 0x800000000000008b, 0x8000000000008089, 24 | 0x8000000000008003, 0x8000000000008002, 0x8000000000000080, 25 | 0x000000000000800a, 0x800000008000000a, 0x8000000080008081, 26 | 0x8000000000008080, 0x0000000080000001, 0x8000000080008008 27 | }; 28 | const int keccakf_rotc[24] = { 29 | 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, 2, 14, 30 | 27, 41, 56, 8, 25, 43, 62, 18, 39, 61, 20, 44 31 | }; 32 | const int keccakf_piln[24] = { 33 | 10, 7, 11, 17, 18, 3, 5, 16, 8, 21, 24, 4, 34 | 15, 23, 19, 13, 12, 2, 20, 14, 22, 9, 6, 1 35 | }; 36 | 37 | // variables 38 | int i, j, r; 39 | uint64_t t, bc[5]; 40 | 41 | #if __BYTE_ORDER__ != __ORDER_LITTLE_ENDIAN__ 42 | uint8_t *v; 43 | 44 | // endianess conversion. this is redundant on little-endian targets 45 | for (i = 0; i < 25; i++) { 46 | v = (uint8_t *) &st[i]; 47 | st[i] = ((uint64_t) v[0]) | (((uint64_t) v[1]) << 8) | 48 | (((uint64_t) v[2]) << 16) | (((uint64_t) v[3]) << 24) | 49 | (((uint64_t) v[4]) << 32) | (((uint64_t) v[5]) << 40) | 50 | (((uint64_t) v[6]) << 48) | (((uint64_t) v[7]) << 56); 51 | } 52 | #endif 53 | 54 | // actual iteration 55 | for (r = 0; r < KECCAKF_ROUNDS; r++) { 56 | 57 | // Theta 58 | for (i = 0; i < 5; i++) 59 | bc[i] = st[i] ^ st[i + 5] ^ st[i + 10] ^ st[i + 15] ^ st[i + 20]; 60 | 61 | for (i = 0; i < 5; i++) { 62 | t = bc[(i + 4) % 5] ^ ROTL64(bc[(i + 1) % 5], 1); 63 | for (j = 0; j < 25; j += 5) 64 | st[j + i] ^= t; 65 | } 66 | 67 | // Rho Pi 68 | t = st[1]; 69 | for (i = 0; i < 24; i++) { 70 | j = keccakf_piln[i]; 71 | bc[0] = st[j]; 72 | st[j] = ROTL64(t, keccakf_rotc[i]); 73 | t = bc[0]; 74 | } 75 | 76 | // Chi 77 | for (j = 0; j < 25; j += 5) { 78 | for (i = 0; i < 5; i++) 79 | bc[i] = st[j + i]; 80 | for (i = 0; i < 5; i++) 81 | st[j + i] ^= (~bc[(i + 1) % 5]) & bc[(i + 2) % 5]; 82 | } 83 | 84 | // Iota 85 | st[0] ^= keccakf_rndc[r]; 86 | } 87 | 88 | #if __BYTE_ORDER__ != __ORDER_LITTLE_ENDIAN__ 89 | // endianess conversion. this is redundant on little-endian targets 90 | for (i = 0; i < 25; i++) { 91 | v = (uint8_t *) &st[i]; 92 | t = st[i]; 93 | v[0] = t & 0xFF; 94 | v[1] = (t >> 8) & 0xFF; 95 | v[2] = (t >> 16) & 0xFF; 96 | v[3] = (t >> 24) & 0xFF; 97 | v[4] = (t >> 32) & 0xFF; 98 | v[5] = (t >> 40) & 0xFF; 99 | v[6] = (t >> 48) & 0xFF; 100 | v[7] = (t >> 56) & 0xFF; 101 | } 102 | #endif 103 | } 104 | 105 | // Initialize the context for SHA3 106 | 107 | void digestif_sha3_init(struct sha3_ctx *ctx, int mdlen) 108 | { 109 | int i; 110 | for (i = 0; i < 25; i++) 111 | ctx->st.q[i] = 0; 112 | ctx->mdlen = mdlen/8; 113 | ctx->rsiz = 200 - 2 * ctx->mdlen; 114 | ctx->pt = 0; 115 | 116 | return; 117 | } 118 | 119 | // update state with more data 120 | 121 | void digestif_sha3_update(struct sha3_ctx *ctx, uint8_t *data, uint32_t len) 122 | { 123 | uint32_t i; 124 | int j; 125 | 126 | j = ctx->pt; 127 | for (i = 0; i < len; i++) { 128 | ctx->st.b[j++] ^= data[i]; 129 | if (j >= ctx->rsiz) { 130 | sha3_keccakf(ctx->st.q); 131 | j = 0; 132 | } 133 | } 134 | ctx->pt = j; 135 | 136 | return; 137 | } 138 | 139 | // finalize and output a hash 140 | 141 | void digestif_sha3_finalize(struct sha3_ctx *ctx, uint8_t *md, uint8_t padding) 142 | { 143 | int i; 144 | 145 | //padding 146 | ctx->st.b[ctx->pt] ^= padding; 147 | ctx->st.b[ctx->rsiz - 1] ^= 0x80; 148 | 149 | //call f on the last block 150 | sha3_keccakf(ctx->st.q); 151 | for (i = 0; i < ctx->mdlen; i++) { 152 | md[i] = ctx->st.b[i]; 153 | } 154 | 155 | return; 156 | } 157 | -------------------------------------------------------------------------------- /src-c/native/sha3.h: -------------------------------------------------------------------------------- 1 | /* Copyright (c) 2015 Markku-Juhani O. Saarinen */ 2 | 3 | #ifndef CRYPTOHASH_SHA3_H 4 | #define CRYPTOHASH_SHA3_H 5 | 6 | #include 7 | 8 | 9 | struct sha3_ctx 10 | { 11 | union { // state: 12 | uint8_t b[200]; // 8-bit bytes 13 | uint64_t q[25]; // 64-bit words 14 | } st; 15 | int pt, rsiz, mdlen; // these don't overflow 16 | }; 17 | 18 | #define SHA3_CTX_SIZE sizeof(struct sha3_ctx) 19 | 20 | void digestif_sha3_init(struct sha3_ctx *ctx, int mdlen); 21 | void digestif_sha3_update(struct sha3_ctx *ctx, uint8_t *data, uint32_t len); 22 | void digestif_sha3_finalize(struct sha3_ctx *ctx, uint8_t *out, uint8_t padding); 23 | 24 | #endif 25 | -------------------------------------------------------------------------------- /src-c/native/sha512.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2006-2009 Vincent Hanquez 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 1. Redistributions of source code must retain the above copyright 8 | * notice, this list of conditions and the following disclaimer. 9 | * 2. Redistributions in binary form must reproduce the above copyright 10 | * notice, this list of conditions and the following disclaimer in the 11 | * documentation and/or other materials provided with the distribution. 12 | * 13 | * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 14 | * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 15 | * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 16 | * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 17 | * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 18 | * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 19 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 20 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 22 | * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | */ 24 | 25 | #include 26 | #include "bitfn.h" 27 | #include "sha512.h" 28 | 29 | void digestif_sha384_init(struct sha512_ctx *ctx) 30 | { 31 | memset(ctx, 0, sizeof(*ctx)); 32 | 33 | ctx->h[0] = 0xcbbb9d5dc1059ed8ULL; 34 | ctx->h[1] = 0x629a292a367cd507ULL; 35 | ctx->h[2] = 0x9159015a3070dd17ULL; 36 | ctx->h[3] = 0x152fecd8f70e5939ULL; 37 | ctx->h[4] = 0x67332667ffc00b31ULL; 38 | ctx->h[5] = 0x8eb44a8768581511ULL; 39 | ctx->h[6] = 0xdb0c2e0d64f98fa7ULL; 40 | ctx->h[7] = 0x47b5481dbefa4fa4ULL; 41 | } 42 | 43 | void digestif_sha512_init(struct sha512_ctx *ctx) 44 | { 45 | memset(ctx, 0, sizeof(*ctx)); 46 | 47 | ctx->h[0] = 0x6a09e667f3bcc908ULL; 48 | ctx->h[1] = 0xbb67ae8584caa73bULL; 49 | ctx->h[2] = 0x3c6ef372fe94f82bULL; 50 | ctx->h[3] = 0xa54ff53a5f1d36f1ULL; 51 | ctx->h[4] = 0x510e527fade682d1ULL; 52 | ctx->h[5] = 0x9b05688c2b3e6c1fULL; 53 | ctx->h[6] = 0x1f83d9abfb41bd6bULL; 54 | ctx->h[7] = 0x5be0cd19137e2179ULL; 55 | } 56 | 57 | /* 232 times the cube root of the first 64 primes 2..311 */ 58 | static const uint64_t k[] = { 59 | 0x428a2f98d728ae22ULL, 0x7137449123ef65cdULL, 0xb5c0fbcfec4d3b2fULL, 60 | 0xe9b5dba58189dbbcULL, 0x3956c25bf348b538ULL, 0x59f111f1b605d019ULL, 61 | 0x923f82a4af194f9bULL, 0xab1c5ed5da6d8118ULL, 0xd807aa98a3030242ULL, 62 | 0x12835b0145706fbeULL, 0x243185be4ee4b28cULL, 0x550c7dc3d5ffb4e2ULL, 63 | 0x72be5d74f27b896fULL, 0x80deb1fe3b1696b1ULL, 0x9bdc06a725c71235ULL, 64 | 0xc19bf174cf692694ULL, 0xe49b69c19ef14ad2ULL, 0xefbe4786384f25e3ULL, 65 | 0x0fc19dc68b8cd5b5ULL, 0x240ca1cc77ac9c65ULL, 0x2de92c6f592b0275ULL, 66 | 0x4a7484aa6ea6e483ULL, 0x5cb0a9dcbd41fbd4ULL, 0x76f988da831153b5ULL, 67 | 0x983e5152ee66dfabULL, 0xa831c66d2db43210ULL, 0xb00327c898fb213fULL, 68 | 0xbf597fc7beef0ee4ULL, 0xc6e00bf33da88fc2ULL, 0xd5a79147930aa725ULL, 69 | 0x06ca6351e003826fULL, 0x142929670a0e6e70ULL, 0x27b70a8546d22ffcULL, 70 | 0x2e1b21385c26c926ULL, 0x4d2c6dfc5ac42aedULL, 0x53380d139d95b3dfULL, 71 | 0x650a73548baf63deULL, 0x766a0abb3c77b2a8ULL, 0x81c2c92e47edaee6ULL, 72 | 0x92722c851482353bULL, 0xa2bfe8a14cf10364ULL, 0xa81a664bbc423001ULL, 73 | 0xc24b8b70d0f89791ULL, 0xc76c51a30654be30ULL, 0xd192e819d6ef5218ULL, 74 | 0xd69906245565a910ULL, 0xf40e35855771202aULL, 0x106aa07032bbd1b8ULL, 75 | 0x19a4c116b8d2d0c8ULL, 0x1e376c085141ab53ULL, 0x2748774cdf8eeb99ULL, 76 | 0x34b0bcb5e19b48a8ULL, 0x391c0cb3c5c95a63ULL, 0x4ed8aa4ae3418acbULL, 77 | 0x5b9cca4f7763e373ULL, 0x682e6ff3d6b2b8a3ULL, 0x748f82ee5defb2fcULL, 78 | 0x78a5636f43172f60ULL, 0x84c87814a1f0ab72ULL, 0x8cc702081a6439ecULL, 79 | 0x90befffa23631e28ULL, 0xa4506cebde82bde9ULL, 0xbef9a3f7b2c67915ULL, 80 | 0xc67178f2e372532bULL, 0xca273eceea26619cULL, 0xd186b8c721c0c207ULL, 81 | 0xeada7dd6cde0eb1eULL, 0xf57d4f7fee6ed178ULL, 0x06f067aa72176fbaULL, 82 | 0x0a637dc5a2c898a6ULL, 0x113f9804bef90daeULL, 0x1b710b35131c471bULL, 83 | 0x28db77f523047d84ULL, 0x32caab7b40c72493ULL, 0x3c9ebe0a15c9bebcULL, 84 | 0x431d67c49c100d4cULL, 0x4cc5d4becb3e42b6ULL, 0x597f299cfc657e2aULL, 85 | 0x5fcb6fab3ad6faecULL, 0x6c44198c4a475817ULL, 86 | }; 87 | 88 | #define e0(x) (ror64(x, 28) ^ ror64(x, 34) ^ ror64(x, 39)) 89 | #define e1(x) (ror64(x, 14) ^ ror64(x, 18) ^ ror64(x, 41)) 90 | #define s0(x) (ror64(x, 1) ^ ror64(x, 8) ^ (x >> 7)) 91 | #define s1(x) (ror64(x, 19) ^ ror64(x, 61) ^ (x >> 6)) 92 | 93 | static void sha512_do_chunk(struct sha512_ctx *ctx, uint64_t *buf) 94 | { 95 | uint64_t a, b, c, d, e, f, g, h, t1, t2; 96 | int i; 97 | uint64_t w[80]; 98 | 99 | cpu_to_be64_array(w, buf, 16); 100 | 101 | for (i = 16; i < 80; i++) 102 | w[i] = s1(w[i - 2]) + w[i - 7] + s0(w[i - 15]) + w[i - 16]; 103 | 104 | a = ctx->h[0]; b = ctx->h[1]; c = ctx->h[2]; d = ctx->h[3]; 105 | e = ctx->h[4]; f = ctx->h[5]; g = ctx->h[6]; h = ctx->h[7]; 106 | 107 | #define R(a, b, c, d, e, f, g, h, k, w) \ 108 | t1 = h + e1(e) + (g ^ (e & (f ^ g))) + k + w; \ 109 | t2 = e0(a) + ((a & b) | (c & (a | b))); \ 110 | d += t1; \ 111 | h = t1 + t2 112 | 113 | for (i = 0; i < 80; i += 8) { 114 | R(a, b, c, d, e, f, g, h, k[i + 0], w[i + 0]); 115 | R(h, a, b, c, d, e, f, g, k[i + 1], w[i + 1]); 116 | R(g, h, a, b, c, d, e, f, k[i + 2], w[i + 2]); 117 | R(f, g, h, a, b, c, d, e, k[i + 3], w[i + 3]); 118 | R(e, f, g, h, a, b, c, d, k[i + 4], w[i + 4]); 119 | R(d, e, f, g, h, a, b, c, k[i + 5], w[i + 5]); 120 | R(c, d, e, f, g, h, a, b, k[i + 6], w[i + 6]); 121 | R(b, c, d, e, f, g, h, a, k[i + 7], w[i + 7]); 122 | } 123 | 124 | #undef R 125 | 126 | ctx->h[0] += a; ctx->h[1] += b; ctx->h[2] += c; ctx->h[3] += d; 127 | ctx->h[4] += e; ctx->h[5] += f; ctx->h[6] += g; ctx->h[7] += h; 128 | } 129 | 130 | void digestif_sha384_update(struct sha384_ctx *ctx, uint8_t *data, uint32_t len) 131 | { 132 | digestif_sha512_update(ctx, data, len); 133 | } 134 | 135 | void digestif_sha512_update(struct sha512_ctx *ctx, uint8_t *data, uint32_t len) 136 | { 137 | unsigned int index, to_fill; 138 | 139 | /* check for partial buffer */ 140 | index = (unsigned int) (ctx->sz[0] & 0x7f); 141 | to_fill = 128 - index; 142 | 143 | ctx->sz[0] += len; 144 | if (ctx->sz[0] < len) 145 | ctx->sz[1]++; 146 | 147 | /* process partial buffer if there's enough data to make a block */ 148 | if (index && len >= to_fill) { 149 | memcpy(ctx->buf + index, data, to_fill); 150 | sha512_do_chunk(ctx, (uint64_t *) ctx->buf); 151 | len -= to_fill; 152 | data += to_fill; 153 | index = 0; 154 | } 155 | 156 | /* process as much 128-block as possible */ 157 | for (; len >= 128; len -= 128, data += 128) 158 | sha512_do_chunk(ctx, (uint64_t *) data); 159 | 160 | /* append data into buf */ 161 | if (len) 162 | memcpy(ctx->buf + index, data, len); 163 | } 164 | 165 | void digestif_sha384_finalize(struct sha384_ctx *ctx, uint8_t *out) 166 | { 167 | uint8_t intermediate[SHA512_DIGEST_SIZE]; 168 | 169 | digestif_sha512_finalize(ctx, intermediate); 170 | memcpy(out, intermediate, SHA384_DIGEST_SIZE); 171 | } 172 | 173 | void digestif_sha512_finalize(struct sha512_ctx *ctx, uint8_t *out) 174 | { 175 | static uint8_t padding[128] = { 0x80, }; 176 | uint32_t i, index, padlen; 177 | uint64_t bits[2]; 178 | uint64_t *p = (uint64_t *) out; 179 | 180 | /* cpu -> big endian */ 181 | bits[0] = cpu_to_be64((ctx->sz[1] << 3 | ctx->sz[0] >> 61)); 182 | bits[1] = cpu_to_be64((ctx->sz[0] << 3)); 183 | 184 | /* pad out to 56 */ 185 | index = (unsigned int) (ctx->sz[0] & 0x7f); 186 | padlen = (index < 112) ? (112 - index) : ((128 + 112) - index); 187 | digestif_sha512_update(ctx, padding, padlen); 188 | 189 | /* append length */ 190 | digestif_sha512_update(ctx, (uint8_t *) bits, sizeof(bits)); 191 | 192 | /* store to digest */ 193 | for (i = 0; i < 8; i++) 194 | p[i] = cpu_to_be64(ctx->h[i]); 195 | } 196 | -------------------------------------------------------------------------------- /src-c/native/sha512.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (C) 2006-2009 Vincent Hanquez 3 | * 4 | * Redistribution and use in source and binary forms, with or without 5 | * modification, are permitted provided that the following conditions 6 | * are met: 7 | * 1. Redistributions of source code must retain the above copyright 8 | * notice, this list of conditions and the following disclaimer. 9 | * 2. Redistributions in binary form must reproduce the above copyright 10 | * notice, this list of conditions and the following disclaimer in the 11 | * documentation and/or other materials provided with the distribution. 12 | * 13 | * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 14 | * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 15 | * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 16 | * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 17 | * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 18 | * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 19 | * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 20 | * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 21 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 22 | * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | */ 24 | #ifndef CRYPTOHASH_SHA512_H 25 | #define CRYPTOHASH_SHA512_H 26 | 27 | #include 28 | 29 | struct sha512_ctx 30 | { 31 | uint64_t sz[2]; 32 | uint8_t buf[128]; 33 | uint64_t h[8]; 34 | }; 35 | 36 | #define sha384_ctx sha512_ctx 37 | 38 | #define SHA384_DIGEST_SIZE 48 39 | #define SHA384_CTX_SIZE sizeof(struct sha384_ctx) 40 | 41 | #define SHA512_DIGEST_SIZE 64 42 | #define SHA512_CTX_SIZE sizeof(struct sha512_ctx) 43 | 44 | void digestif_sha384_init(struct sha384_ctx *ctx); 45 | void digestif_sha384_update(struct sha384_ctx *ctx, uint8_t *data, uint32_t len); 46 | void digestif_sha384_finalize(struct sha384_ctx *ctx, uint8_t *out); 47 | 48 | void digestif_sha512_init(struct sha512_ctx *ctx); 49 | void digestif_sha512_update(struct sha512_ctx *ctx, uint8_t *data, uint32_t len); 50 | void digestif_sha512_finalize(struct sha512_ctx *ctx, uint8_t *out); 51 | 52 | #endif 53 | -------------------------------------------------------------------------------- /src-c/native/whirlpool.h: -------------------------------------------------------------------------------- 1 | /* whirlpool.c - an implementation of the Whirlpool Hash Function. 2 | * 3 | * Copyright: 2009-2012 Aleksey Kravchenko 4 | * 5 | * Permission is hereby granted, free of charge, to any person obtaining a 6 | * copy of this software and associated documentation files (the "Software"), 7 | * to deal in the Software without restriction, including without limitation 8 | * the rights to use, copy, modify, merge, publish, distribute, sublicense, 9 | * and/or sell copies of the Software, and to permit persons to whom the 10 | * Software is furnished to do so. 11 | * 12 | * This program is distributed in the hope that it will be useful, but 13 | * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 14 | * or FITNESS FOR A PARTICULAR PURPOSE. Use this program at your own risk! 15 | * 16 | * Documentation: 17 | * P. S. L. M. Barreto, V. Rijmen, ``The Whirlpool hashing function,'' 18 | * NESSIE submission, 2000 (tweaked version, 2001) 19 | * 20 | * The algorithm is named after the Whirlpool Galaxy in Canes Venatici. 21 | */ 22 | #ifndef CRYPTOHASH_WHIRLPOOL_H 23 | #define CRYPTOHASH_WHIRLPOOL_H 24 | 25 | #include 26 | 27 | struct whirlpool_ctx 28 | { 29 | uint64_t sz; 30 | uint8_t buf[64]; 31 | uint64_t h[8]; 32 | }; 33 | 34 | #define WHIRLPOOL_DIGEST_SIZE 64 35 | #define WHIRLPOOL_CTX_SIZE sizeof(struct whirlpool_ctx) 36 | 37 | void digestif_whirlpool_init(struct whirlpool_ctx* ctx); 38 | void digestif_whirlpool_update(struct whirlpool_ctx* ctx, uint8_t *data, uint32_t len); 39 | void digestif_whirlpool_finalize(struct whirlpool_ctx* ctx, uint8_t *out); 40 | 41 | #endif 42 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_blake2b.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | let failwith fmt = Format.kasprintf failwith fmt 5 | 6 | module Int32 = struct 7 | include Int32 8 | 9 | let ( lsl ) = Int32.shift_left 10 | let ( lsr ) = Int32.shift_right_logical 11 | let ( asr ) = Int32.shift_right 12 | let ( lor ) = Int32.logor 13 | let ( lxor ) = Int32.logxor 14 | let ( land ) = Int32.logand 15 | let lnot = Int32.lognot 16 | let ( + ) = Int32.add 17 | let rol32 a n = (a lsl n) lor (a lsr (32 - n)) 18 | let ror32 a n = (a lsr n) lor (a lsl (32 - n)) 19 | end 20 | 21 | module Int64 = struct 22 | include Int64 23 | 24 | let ( land ) = Int64.logand 25 | let ( lsl ) = Int64.shift_left 26 | let ( lsr ) = Int64.shift_right_logical 27 | let ( lor ) = Int64.logor 28 | let ( asr ) = Int64.shift_right 29 | let ( lxor ) = Int64.logxor 30 | let ( + ) = Int64.add 31 | let rol64 a n = (a lsl n) lor (a lsr (64 - n)) 32 | let ror64 a n = (a lsr n) lor (a lsl (64 - n)) 33 | end 34 | 35 | module type S = sig 36 | type ctx 37 | type kind = [ `BLAKE2B ] 38 | 39 | val init : unit -> ctx 40 | val with_outlen_and_bytes_key : int -> By.t -> int -> int -> ctx 41 | val with_outlen_and_bigstring_key : int -> Bi.t -> int -> int -> ctx 42 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 43 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 44 | val unsafe_get : ctx -> By.t 45 | val dup : ctx -> ctx 46 | val max_outlen : int 47 | end 48 | 49 | module Unsafe : S = struct 50 | type kind = [ `BLAKE2B ] 51 | 52 | type param = { 53 | digest_length : int; 54 | key_length : int; 55 | fanout : int; 56 | depth : int; 57 | leaf_length : int32; 58 | node_offset : int32; 59 | xof_length : int32; 60 | node_depth : int; 61 | inner_length : int; 62 | reserved : int array; 63 | salt : int array; 64 | personal : int array; 65 | } 66 | 67 | type ctx = { 68 | mutable buflen : int; 69 | outlen : int; 70 | mutable last_node : int; 71 | buf : Bytes.t; 72 | h : int64 array; 73 | t : int64 array; 74 | f : int64 array; 75 | } 76 | 77 | let dup ctx = 78 | { 79 | buflen = ctx.buflen; 80 | outlen = ctx.outlen; 81 | last_node = ctx.last_node; 82 | buf = By.copy ctx.buf; 83 | h = Array.copy ctx.h; 84 | t = Array.copy ctx.t; 85 | f = Array.copy ctx.f; 86 | } 87 | 88 | let param_to_bytes param = 89 | let arr = 90 | [| 91 | param.digest_length land 0xFF; param.key_length land 0xFF; 92 | param.fanout land 0xFF; 93 | param.depth land 0xFF (* store to little-endian *); 94 | Int32.(to_int ((param.leaf_length lsr 0) land 0xFFl)); 95 | Int32.(to_int ((param.leaf_length lsr 8) land 0xFFl)); 96 | Int32.(to_int ((param.leaf_length lsr 16) land 0xFFl)); 97 | Int32.(to_int ((param.leaf_length lsr 24) land 0xFFl)) 98 | (* store to little-endian *); 99 | Int32.(to_int ((param.node_offset lsr 0) land 0xFFl)); 100 | Int32.(to_int ((param.node_offset lsr 8) land 0xFFl)); 101 | Int32.(to_int ((param.node_offset lsr 16) land 0xFFl)); 102 | Int32.(to_int ((param.node_offset lsr 24) land 0xFFl)) 103 | (* store to little-endian *); 104 | Int32.(to_int ((param.xof_length lsr 0) land 0xFFl)); 105 | Int32.(to_int ((param.xof_length lsr 8) land 0xFFl)); 106 | Int32.(to_int ((param.xof_length lsr 16) land 0xFFl)); 107 | Int32.(to_int ((param.xof_length lsr 24) land 0xFFl)); 108 | param.node_depth land 0xFF; param.inner_length land 0xFF; 109 | param.reserved.(0) land 0xFF; param.reserved.(1) land 0xFF; 110 | param.reserved.(2) land 0xFF; param.reserved.(3) land 0xFF; 111 | param.reserved.(4) land 0xFF; param.reserved.(5) land 0xFF; 112 | param.reserved.(6) land 0xFF; param.reserved.(7) land 0xFF; 113 | param.reserved.(8) land 0xFF; param.reserved.(9) land 0xFF; 114 | param.reserved.(10) land 0xFF; param.reserved.(11) land 0xFF; 115 | param.reserved.(12) land 0xFF; param.reserved.(13) land 0xFF; 116 | param.salt.(0) land 0xFF; param.salt.(1) land 0xFF; 117 | param.salt.(2) land 0xFF; param.salt.(3) land 0xFF; 118 | param.salt.(4) land 0xFF; param.salt.(5) land 0xFF; 119 | param.salt.(6) land 0xFF; param.salt.(7) land 0xFF; 120 | param.salt.(8) land 0xFF; param.salt.(9) land 0xFF; 121 | param.salt.(10) land 0xFF; param.salt.(11) land 0xFF; 122 | param.salt.(12) land 0xFF; param.salt.(13) land 0xFF; 123 | param.salt.(14) land 0xFF; param.salt.(15) land 0xFF; 124 | param.personal.(0) land 0xFF; param.personal.(1) land 0xFF; 125 | param.personal.(2) land 0xFF; param.personal.(3) land 0xFF; 126 | param.personal.(4) land 0xFF; param.personal.(5) land 0xFF; 127 | param.personal.(6) land 0xFF; param.personal.(7) land 0xFF; 128 | param.personal.(8) land 0xFF; param.personal.(9) land 0xFF; 129 | param.personal.(10) land 0xFF; param.personal.(11) land 0xFF; 130 | param.personal.(12) land 0xFF; param.personal.(13) land 0xFF; 131 | param.personal.(14) land 0xFF; param.personal.(15) land 0xFF; 132 | |] in 133 | By.init 64 (fun i -> Char.unsafe_chr arr.(i)) 134 | 135 | let max_outlen = 64 136 | 137 | let default_param = 138 | { 139 | digest_length = max_outlen; 140 | key_length = 0; 141 | fanout = 1; 142 | depth = 1; 143 | leaf_length = 0l; 144 | node_offset = 0l; 145 | xof_length = 0l; 146 | node_depth = 0; 147 | inner_length = 0; 148 | reserved = [| 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 |]; 149 | salt = [| 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 |]; 150 | personal = [| 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 |]; 151 | } 152 | 153 | let iv = 154 | [| 155 | 0x6a09e667f3bcc908L; 0xbb67ae8584caa73bL; 0x3c6ef372fe94f82bL; 156 | 0xa54ff53a5f1d36f1L; 0x510e527fade682d1L; 0x9b05688c2b3e6c1fL; 157 | 0x1f83d9abfb41bd6bL; 0x5be0cd19137e2179L; 158 | |] 159 | 160 | let increment_counter ctx inc = 161 | let open Int64 in 162 | ctx.t.(0) <- ctx.t.(0) + inc ; 163 | ctx.t.(1) <- (ctx.t.(1) + if ctx.t.(0) < inc then 1L else 0L) 164 | 165 | let set_lastnode ctx = ctx.f.(1) <- Int64.minus_one 166 | 167 | let set_lastblock ctx = 168 | if ctx.last_node <> 0 then set_lastnode ctx ; 169 | ctx.f.(0) <- Int64.minus_one 170 | 171 | let init () = 172 | let buf = By.make 128 '\x00' in 173 | By.fill buf 0 128 '\x00' ; 174 | let ctx = 175 | { 176 | buflen = 0; 177 | outlen = default_param.digest_length; 178 | last_node = 0; 179 | buf; 180 | h = Array.make 8 0L; 181 | t = Array.make 2 0L; 182 | f = Array.make 2 0L; 183 | } in 184 | let param_bytes = param_to_bytes default_param in 185 | for i = 0 to 7 do 186 | ctx.h.(i) <- Int64.(iv.(i) lxor By.le64_to_cpu param_bytes (i * 8)) 187 | done ; 188 | ctx 189 | 190 | let sigma = 191 | [| 192 | [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 |]; 193 | [| 14; 10; 4; 8; 9; 15; 13; 6; 1; 12; 0; 2; 11; 7; 5; 3 |]; 194 | [| 11; 8; 12; 0; 5; 2; 15; 13; 10; 14; 3; 6; 7; 1; 9; 4 |]; 195 | [| 7; 9; 3; 1; 13; 12; 11; 14; 2; 6; 5; 10; 4; 0; 15; 8 |]; 196 | [| 9; 0; 5; 7; 2; 4; 10; 15; 14; 1; 11; 12; 6; 8; 3; 13 |]; 197 | [| 2; 12; 6; 10; 0; 11; 8; 3; 4; 13; 7; 5; 15; 14; 1; 9 |]; 198 | [| 12; 5; 1; 15; 14; 13; 4; 10; 0; 7; 6; 3; 9; 2; 8; 11 |]; 199 | [| 13; 11; 7; 14; 12; 1; 3; 9; 5; 0; 15; 4; 8; 6; 2; 10 |]; 200 | [| 6; 15; 14; 9; 11; 3; 0; 8; 12; 2; 13; 7; 1; 4; 10; 5 |]; 201 | [| 10; 2; 8; 4; 7; 6; 1; 5; 15; 11; 9; 14; 3; 12; 13; 0 |]; 202 | [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 |]; 203 | [| 14; 10; 4; 8; 9; 15; 13; 6; 1; 12; 0; 2; 11; 7; 5; 3 |]; 204 | |] 205 | 206 | let compress : 207 | type a. le64_to_cpu:(a -> int -> int64) -> ctx -> a -> int -> unit = 208 | fun ~le64_to_cpu ctx block off -> 209 | let v = Array.make 16 0L in 210 | let m = Array.make 16 0L in 211 | let g r i a_idx b_idx c_idx d_idx = 212 | let ( ++ ) = ( + ) in 213 | let open Int64 in 214 | v.(a_idx) <- v.(a_idx) + v.(b_idx) + m.(sigma.(r).((2 * i) ++ 0)) ; 215 | v.(d_idx) <- ror64 (v.(d_idx) lxor v.(a_idx)) 32 ; 216 | v.(c_idx) <- v.(c_idx) + v.(d_idx) ; 217 | v.(b_idx) <- ror64 (v.(b_idx) lxor v.(c_idx)) 24 ; 218 | v.(a_idx) <- v.(a_idx) + v.(b_idx) + m.(sigma.(r).((2 * i) ++ 1)) ; 219 | v.(d_idx) <- ror64 (v.(d_idx) lxor v.(a_idx)) 16 ; 220 | v.(c_idx) <- v.(c_idx) + v.(d_idx) ; 221 | v.(b_idx) <- ror64 (v.(b_idx) lxor v.(c_idx)) 63 in 222 | let r r = 223 | g r 0 0 4 8 12 ; 224 | g r 1 1 5 9 13 ; 225 | g r 2 2 6 10 14 ; 226 | g r 3 3 7 11 15 ; 227 | g r 4 0 5 10 15 ; 228 | g r 5 1 6 11 12 ; 229 | g r 6 2 7 8 13 ; 230 | g r 7 3 4 9 14 in 231 | for i = 0 to 15 do 232 | m.(i) <- le64_to_cpu block (off + (i * 8)) 233 | done ; 234 | for i = 0 to 7 do 235 | v.(i) <- ctx.h.(i) 236 | done ; 237 | v.(8) <- iv.(0) ; 238 | v.(9) <- iv.(1) ; 239 | v.(10) <- iv.(2) ; 240 | v.(11) <- iv.(3) ; 241 | v.(12) <- Int64.(iv.(4) lxor ctx.t.(0)) ; 242 | v.(13) <- Int64.(iv.(5) lxor ctx.t.(1)) ; 243 | v.(14) <- Int64.(iv.(6) lxor ctx.f.(0)) ; 244 | v.(15) <- Int64.(iv.(7) lxor ctx.f.(1)) ; 245 | r 0 ; 246 | r 1 ; 247 | r 2 ; 248 | r 3 ; 249 | r 4 ; 250 | r 5 ; 251 | r 6 ; 252 | r 7 ; 253 | r 8 ; 254 | r 9 ; 255 | r 10 ; 256 | r 11 ; 257 | let ( ++ ) = ( + ) in 258 | for i = 0 to 7 do 259 | ctx.h.(i) <- Int64.(ctx.h.(i) lxor v.(i) lxor v.(i ++ 8)) 260 | done ; 261 | () 262 | 263 | let feed : 264 | type a. 265 | blit:(a -> int -> By.t -> int -> int -> unit) -> 266 | le64_to_cpu:(a -> int -> int64) -> 267 | ctx -> 268 | a -> 269 | int -> 270 | int -> 271 | unit = 272 | fun ~blit ~le64_to_cpu ctx buf off len -> 273 | let in_off = ref off in 274 | let in_len = ref len in 275 | if !in_len > 0 276 | then ( 277 | let left = ctx.buflen in 278 | let fill = 128 - left in 279 | if !in_len > fill 280 | then ( 281 | ctx.buflen <- 0 ; 282 | blit buf !in_off ctx.buf left fill ; 283 | increment_counter ctx 128L ; 284 | compress ~le64_to_cpu:By.le64_to_cpu ctx ctx.buf 0 ; 285 | in_off := !in_off + fill ; 286 | in_len := !in_len - fill ; 287 | while !in_len > 128 do 288 | increment_counter ctx 128L ; 289 | compress ~le64_to_cpu ctx buf !in_off ; 290 | in_off := !in_off + 128 ; 291 | in_len := !in_len - 128 292 | done) ; 293 | blit buf !in_off ctx.buf ctx.buflen !in_len ; 294 | ctx.buflen <- ctx.buflen + !in_len) ; 295 | () 296 | 297 | let unsafe_feed_bytes = feed ~blit:By.blit ~le64_to_cpu:By.le64_to_cpu 298 | 299 | let unsafe_feed_bigstring = 300 | feed ~blit:By.blit_from_bigstring ~le64_to_cpu:Bi.le64_to_cpu 301 | 302 | let with_outlen_and_key ~blit outlen key off len = 303 | if outlen > max_outlen 304 | then 305 | failwith "out length can not be upper than %d (out length: %d)" max_outlen 306 | outlen ; 307 | let buf = By.make 128 '\x00' in 308 | let ctx = 309 | { 310 | buflen = 0; 311 | outlen; 312 | last_node = 0; 313 | buf; 314 | h = Array.make 8 0L; 315 | t = Array.make 2 0L; 316 | f = Array.make 2 0L; 317 | } in 318 | let param_bytes = 319 | param_to_bytes 320 | { default_param with digest_length = outlen; key_length = len } in 321 | for i = 0 to 7 do 322 | ctx.h.(i) <- Int64.(iv.(i) lxor By.le64_to_cpu param_bytes (i * 8)) 323 | done ; 324 | if len > 0 325 | then ( 326 | let block = By.make 128 '\x00' in 327 | blit key off block 0 len ; 328 | unsafe_feed_bytes ctx block 0 128) ; 329 | ctx 330 | 331 | let with_outlen_and_bytes_key outlen key off len = 332 | with_outlen_and_key ~blit:By.blit outlen key off len 333 | 334 | let with_outlen_and_bigstring_key outlen key off len = 335 | with_outlen_and_key ~blit:By.blit_from_bigstring outlen key off len 336 | 337 | let unsafe_get ctx = 338 | let res = By.make default_param.digest_length '\x00' in 339 | increment_counter ctx (Int64.of_int ctx.buflen) ; 340 | set_lastblock ctx ; 341 | By.fill ctx.buf ctx.buflen (128 - ctx.buflen) '\x00' ; 342 | compress ~le64_to_cpu:By.le64_to_cpu ctx ctx.buf 0 ; 343 | for i = 0 to 7 do 344 | By.cpu_to_le64 res (i * 8) ctx.h.(i) 345 | done ; 346 | if ctx.outlen < default_param.digest_length 347 | then By.sub res 0 ctx.outlen 348 | else if ctx.outlen > default_param.digest_length 349 | then 350 | assert false 351 | (* XXX(dinosaure): [ctx] can not be initialized with [outlen > digest_length = max_outlen]. *) 352 | else res 353 | end 354 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_blake2s.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | let failwith fmt = Format.kasprintf failwith fmt 5 | 6 | module Int32 = struct 7 | include Int32 8 | 9 | let ( lsl ) = Int32.shift_left 10 | let ( lsr ) = Int32.shift_right_logical 11 | let ( asr ) = Int32.shift_right 12 | let ( lor ) = Int32.logor 13 | let ( lxor ) = Int32.logxor 14 | let ( land ) = Int32.logand 15 | let lnot = Int32.lognot 16 | let ( + ) = Int32.add 17 | let rol32 a n = (a lsl n) lor (a lsr (32 - n)) 18 | let ror32 a n = (a lsr n) lor (a lsl (32 - n)) 19 | end 20 | 21 | module Int64 = struct 22 | include Int64 23 | 24 | let ( land ) = Int64.logand 25 | let ( lsl ) = Int64.shift_left 26 | let ( lsr ) = Int64.shift_right_logical 27 | let ( lor ) = Int64.logor 28 | let ( asr ) = Int64.shift_right 29 | let ( lxor ) = Int64.logxor 30 | let ( + ) = Int64.add 31 | let rol64 a n = (a lsl n) lor (a lsr (64 - n)) 32 | let ror64 a n = (a lsr n) lor (a lsl (64 - n)) 33 | end 34 | 35 | module type S = sig 36 | type ctx 37 | type kind = [ `BLAKE2S ] 38 | 39 | val init : unit -> ctx 40 | val with_outlen_and_bytes_key : int -> By.t -> int -> int -> ctx 41 | val with_outlen_and_bigstring_key : int -> Bi.t -> int -> int -> ctx 42 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 43 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 44 | val unsafe_get : ctx -> By.t 45 | val dup : ctx -> ctx 46 | val max_outlen : int 47 | end 48 | 49 | module Unsafe : S = struct 50 | type kind = [ `BLAKE2S ] 51 | 52 | type param = { 53 | digest_length : int; 54 | key_length : int; 55 | fanout : int; 56 | depth : int; 57 | leaf_length : int32; 58 | node_offset : int32; 59 | xof_length : int; 60 | node_depth : int; 61 | inner_length : int; 62 | salt : int array; 63 | personal : int array; 64 | } 65 | 66 | type ctx = { 67 | mutable buflen : int; 68 | outlen : int; 69 | mutable last_node : int; 70 | buf : Bytes.t; 71 | h : int32 array; 72 | t : int32 array; 73 | f : int32 array; 74 | } 75 | 76 | let dup ctx = 77 | { 78 | buflen = ctx.buflen; 79 | outlen = ctx.outlen; 80 | last_node = ctx.last_node; 81 | buf = By.copy ctx.buf; 82 | h = Array.copy ctx.h; 83 | t = Array.copy ctx.t; 84 | f = Array.copy ctx.f; 85 | } 86 | 87 | let param_to_bytes param = 88 | let arr = 89 | [| 90 | param.digest_length land 0xFF; param.key_length land 0xFF; 91 | param.fanout land 0xFF; 92 | param.depth land 0xFF (* store to little-endian *); 93 | Int32.(to_int ((param.leaf_length lsr 0) land 0xFFl)); 94 | Int32.(to_int ((param.leaf_length lsr 8) land 0xFFl)); 95 | Int32.(to_int ((param.leaf_length lsr 16) land 0xFFl)); 96 | Int32.(to_int ((param.leaf_length lsr 24) land 0xFFl)) 97 | (* store to little-endian *); 98 | Int32.(to_int ((param.node_offset lsr 0) land 0xFFl)); 99 | Int32.(to_int ((param.node_offset lsr 8) land 0xFFl)); 100 | Int32.(to_int ((param.node_offset lsr 16) land 0xFFl)); 101 | Int32.(to_int ((param.node_offset lsr 24) land 0xFFl)) 102 | (* store to little-endian *); (param.xof_length lsr 0) land 0xFF; 103 | (param.xof_length lsr 8) land 0xFF; param.node_depth land 0xFF; 104 | param.inner_length land 0xFF; param.salt.(0) land 0xFF; 105 | param.salt.(1) land 0xFF; param.salt.(2) land 0xFF; 106 | param.salt.(3) land 0xFF; param.salt.(4) land 0xFF; 107 | param.salt.(5) land 0xFF; param.salt.(6) land 0xFF; 108 | param.salt.(7) land 0xFF; param.personal.(0) land 0xFF; 109 | param.personal.(1) land 0xFF; param.personal.(2) land 0xFF; 110 | param.personal.(3) land 0xFF; param.personal.(4) land 0xFF; 111 | param.personal.(5) land 0xFF; param.personal.(6) land 0xFF; 112 | param.personal.(7) land 0xFF; 113 | |] in 114 | By.init 32 (fun i -> Char.unsafe_chr arr.(i)) 115 | 116 | let max_outlen = 32 117 | 118 | let default_param = 119 | { 120 | digest_length = max_outlen; 121 | key_length = 0; 122 | fanout = 1; 123 | depth = 1; 124 | leaf_length = 0l; 125 | node_offset = 0l; 126 | xof_length = 0; 127 | node_depth = 0; 128 | inner_length = 0; 129 | salt = [| 0; 0; 0; 0; 0; 0; 0; 0 |]; 130 | personal = [| 0; 0; 0; 0; 0; 0; 0; 0 |]; 131 | } 132 | 133 | let iv = 134 | [| 135 | 0x6A09E667l; 0xBB67AE85l; 0x3C6EF372l; 0xA54FF53Al; 0x510E527Fl; 136 | 0x9B05688Cl; 0x1F83D9ABl; 0x5BE0CD19l; 137 | |] 138 | 139 | let increment_counter ctx inc = 140 | let open Int32 in 141 | ctx.t.(0) <- ctx.t.(0) + inc ; 142 | ctx.t.(1) <- (ctx.t.(1) + if ctx.t.(0) < inc then 1l else 0l) 143 | 144 | let set_lastnode ctx = ctx.f.(1) <- Int32.minus_one 145 | 146 | let set_lastblock ctx = 147 | if ctx.last_node <> 0 then set_lastnode ctx ; 148 | ctx.f.(0) <- Int32.minus_one 149 | 150 | let init () = 151 | let buf = By.make 64 '\x00' in 152 | let ctx = 153 | { 154 | buflen = 0; 155 | outlen = default_param.digest_length; 156 | last_node = 0; 157 | buf; 158 | h = Array.make 8 0l; 159 | t = Array.make 2 0l; 160 | f = Array.make 2 0l; 161 | } in 162 | let param_bytes = param_to_bytes default_param in 163 | for i = 0 to 7 do 164 | ctx.h.(i) <- Int32.(iv.(i) lxor By.le32_to_cpu param_bytes (i * 4)) 165 | done ; 166 | ctx 167 | 168 | let sigma = 169 | [| 170 | [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15 |]; 171 | [| 14; 10; 4; 8; 9; 15; 13; 6; 1; 12; 0; 2; 11; 7; 5; 3 |]; 172 | [| 11; 8; 12; 0; 5; 2; 15; 13; 10; 14; 3; 6; 7; 1; 9; 4 |]; 173 | [| 7; 9; 3; 1; 13; 12; 11; 14; 2; 6; 5; 10; 4; 0; 15; 8 |]; 174 | [| 9; 0; 5; 7; 2; 4; 10; 15; 14; 1; 11; 12; 6; 8; 3; 13 |]; 175 | [| 2; 12; 6; 10; 0; 11; 8; 3; 4; 13; 7; 5; 15; 14; 1; 9 |]; 176 | [| 12; 5; 1; 15; 14; 13; 4; 10; 0; 7; 6; 3; 9; 2; 8; 11 |]; 177 | [| 13; 11; 7; 14; 12; 1; 3; 9; 5; 0; 15; 4; 8; 6; 2; 10 |]; 178 | [| 6; 15; 14; 9; 11; 3; 0; 8; 12; 2; 13; 7; 1; 4; 10; 5 |]; 179 | [| 10; 2; 8; 4; 7; 6; 1; 5; 15; 11; 9; 14; 3; 12; 13; 0 |]; 180 | |] 181 | 182 | let compress : 183 | type a. le32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit = 184 | fun ~le32_to_cpu ctx block off -> 185 | let v = Array.make 16 0l in 186 | let m = Array.make 16 0l in 187 | let g r i a_idx b_idx c_idx d_idx = 188 | let ( ++ ) = ( + ) in 189 | let open Int32 in 190 | v.(a_idx) <- v.(a_idx) + v.(b_idx) + m.(sigma.(r).((2 * i) ++ 0)) ; 191 | v.(d_idx) <- ror32 (v.(d_idx) lxor v.(a_idx)) 16 ; 192 | v.(c_idx) <- v.(c_idx) + v.(d_idx) ; 193 | v.(b_idx) <- ror32 (v.(b_idx) lxor v.(c_idx)) 12 ; 194 | v.(a_idx) <- v.(a_idx) + v.(b_idx) + m.(sigma.(r).((2 * i) ++ 1)) ; 195 | v.(d_idx) <- ror32 (v.(d_idx) lxor v.(a_idx)) 8 ; 196 | v.(c_idx) <- v.(c_idx) + v.(d_idx) ; 197 | v.(b_idx) <- ror32 (v.(b_idx) lxor v.(c_idx)) 7 in 198 | let r r = 199 | g r 0 0 4 8 12 ; 200 | g r 1 1 5 9 13 ; 201 | g r 2 2 6 10 14 ; 202 | g r 3 3 7 11 15 ; 203 | g r 4 0 5 10 15 ; 204 | g r 5 1 6 11 12 ; 205 | g r 6 2 7 8 13 ; 206 | g r 7 3 4 9 14 in 207 | for i = 0 to 15 do 208 | m.(i) <- le32_to_cpu block (off + (i * 4)) 209 | done ; 210 | for i = 0 to 7 do 211 | v.(i) <- ctx.h.(i) 212 | done ; 213 | v.(8) <- iv.(0) ; 214 | v.(9) <- iv.(1) ; 215 | v.(10) <- iv.(2) ; 216 | v.(11) <- iv.(3) ; 217 | v.(12) <- Int32.(iv.(4) lxor ctx.t.(0)) ; 218 | v.(13) <- Int32.(iv.(5) lxor ctx.t.(1)) ; 219 | v.(14) <- Int32.(iv.(6) lxor ctx.f.(0)) ; 220 | v.(15) <- Int32.(iv.(7) lxor ctx.f.(1)) ; 221 | r 0 ; 222 | r 1 ; 223 | r 2 ; 224 | r 3 ; 225 | r 4 ; 226 | r 5 ; 227 | r 6 ; 228 | r 7 ; 229 | r 8 ; 230 | r 9 ; 231 | let ( ++ ) = ( + ) in 232 | for i = 0 to 7 do 233 | ctx.h.(i) <- Int32.(ctx.h.(i) lxor v.(i) lxor v.(i ++ 8)) 234 | done ; 235 | () 236 | 237 | let feed : 238 | type a. 239 | blit:(a -> int -> By.t -> int -> int -> unit) -> 240 | le32_to_cpu:(a -> int -> int32) -> 241 | ctx -> 242 | a -> 243 | int -> 244 | int -> 245 | unit = 246 | fun ~blit ~le32_to_cpu ctx buf off len -> 247 | let in_off = ref off in 248 | let in_len = ref len in 249 | if !in_len > 0 250 | then ( 251 | let left = ctx.buflen in 252 | let fill = 64 - left in 253 | if !in_len > fill 254 | then ( 255 | ctx.buflen <- 0 ; 256 | blit buf !in_off ctx.buf left fill ; 257 | increment_counter ctx 64l ; 258 | compress ~le32_to_cpu:By.le32_to_cpu ctx ctx.buf 0 ; 259 | in_off := !in_off + fill ; 260 | in_len := !in_len - fill ; 261 | while !in_len > 64 do 262 | increment_counter ctx 64l ; 263 | compress ~le32_to_cpu ctx buf !in_off ; 264 | in_off := !in_off + 64 ; 265 | in_len := !in_len - 64 266 | done) ; 267 | blit buf !in_off ctx.buf ctx.buflen !in_len ; 268 | ctx.buflen <- ctx.buflen + !in_len) ; 269 | () 270 | 271 | let unsafe_feed_bytes = feed ~blit:By.blit ~le32_to_cpu:By.le32_to_cpu 272 | 273 | let unsafe_feed_bigstring = 274 | feed ~blit:By.blit_from_bigstring ~le32_to_cpu:Bi.le32_to_cpu 275 | 276 | let with_outlen_and_key ~blit outlen key off len = 277 | if outlen > max_outlen 278 | then 279 | failwith "out length can not be upper than %d (out length: %d)" max_outlen 280 | outlen ; 281 | let buf = By.make 64 '\x00' in 282 | let ctx = 283 | { 284 | buflen = 0; 285 | outlen; 286 | last_node = 0; 287 | buf; 288 | h = Array.make 8 0l; 289 | t = Array.make 2 0l; 290 | f = Array.make 2 0l; 291 | } in 292 | let param_bytes = 293 | param_to_bytes 294 | { default_param with key_length = len; digest_length = outlen } in 295 | for i = 0 to 7 do 296 | ctx.h.(i) <- Int32.(iv.(i) lxor By.le32_to_cpu param_bytes (i * 4)) 297 | done ; 298 | if len > 0 299 | then ( 300 | let block = By.make 64 '\x00' in 301 | blit key off block 0 len ; 302 | unsafe_feed_bytes ctx block 0 64) ; 303 | ctx 304 | 305 | let with_outlen_and_bytes_key outlen key off len = 306 | with_outlen_and_key ~blit:By.blit outlen key off len 307 | 308 | let with_outlen_and_bigstring_key outlen key off len = 309 | with_outlen_and_key ~blit:By.blit_from_bigstring outlen key off len 310 | 311 | let unsafe_get ctx = 312 | let res = By.make default_param.digest_length '\x00' in 313 | increment_counter ctx (Int32.of_int ctx.buflen) ; 314 | set_lastblock ctx ; 315 | By.fill ctx.buf ctx.buflen (64 - ctx.buflen) '\x00' ; 316 | compress ~le32_to_cpu:By.le32_to_cpu ctx ctx.buf 0 ; 317 | for i = 0 to 7 do 318 | By.cpu_to_le32 res (i * 4) ctx.h.(i) 319 | done ; 320 | if ctx.outlen < default_param.digest_length 321 | then By.sub res 0 ctx.outlen 322 | else if ctx.outlen > default_param.digest_length 323 | then 324 | assert false 325 | (* XXX(dinosaure): [ctx] can not be initialized with [outlen > digest_length = max_outlen]. *) 326 | else res 327 | end 328 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_keccak_256.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module type S = sig 5 | type ctx 6 | type kind = [ `SHA3_256 ] 7 | 8 | val init : unit -> ctx 9 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 10 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 11 | val unsafe_get : ctx -> By.t 12 | val dup : ctx -> ctx 13 | end 14 | 15 | module Unsafe : S = struct 16 | type kind = [ `SHA3_256 ] 17 | 18 | module U = Baijiu_sha3.Unsafe (struct 19 | let padding = Baijiu_sha3.keccak_padding 20 | end) 21 | 22 | open U 23 | 24 | type nonrec ctx = ctx 25 | 26 | let init () = U.init 32 27 | let unsafe_get = unsafe_get 28 | let dup = dup 29 | let unsafe_feed_bytes = unsafe_feed_bytes 30 | let unsafe_feed_bigstring = unsafe_feed_bigstring 31 | end 32 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_md5.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module Int32 = struct 5 | include Int32 6 | 7 | let ( lsl ) = Int32.shift_left 8 | let ( lsr ) = Int32.shift_right_logical 9 | let ( asr ) = Int32.shift_right 10 | let ( lor ) = Int32.logor 11 | let ( lxor ) = Int32.logxor 12 | let ( land ) = Int32.logand 13 | let lnot = Int32.lognot 14 | let ( + ) = Int32.add 15 | let rol32 a n = (a lsl n) lor (a lsr (32 - n)) 16 | let ror32 a n = (a lsr n) lor (a lsl (32 - n)) 17 | end 18 | 19 | module Int64 = struct 20 | include Int64 21 | 22 | let ( land ) = Int64.logand 23 | let ( lsl ) = Int64.shift_left 24 | end 25 | 26 | module type S = sig 27 | type kind = [ `MD5 ] 28 | type ctx = { mutable size : int64; b : Bytes.t; h : int32 array } 29 | 30 | val init : unit -> ctx 31 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 32 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 33 | val unsafe_get : ctx -> By.t 34 | val dup : ctx -> ctx 35 | end 36 | 37 | module Unsafe : S = struct 38 | type kind = [ `MD5 ] 39 | type ctx = { mutable size : int64; b : Bytes.t; h : int32 array } 40 | 41 | let dup ctx = { size = ctx.size; b = By.copy ctx.b; h = Array.copy ctx.h } 42 | 43 | let init () = 44 | let b = By.make 64 '\x00' in 45 | { 46 | size = 0L; 47 | b; 48 | h = [| 0x67452301l; 0xefcdab89l; 0x98badcfel; 0x10325476l |]; 49 | } 50 | 51 | let f1 x y z = Int32.(z lxor (x land (y lxor z))) 52 | let f2 x y z = f1 z x y 53 | let f3 x y z = Int32.(x lxor y lxor z) 54 | let f4 x y z = Int32.(y lxor (x lor lnot z)) 55 | 56 | let md5_do_chunk : 57 | type a. le32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit = 58 | fun ~le32_to_cpu ctx buf off -> 59 | let a, b, c, d = 60 | (ref ctx.h.(0), ref ctx.h.(1), ref ctx.h.(2), ref ctx.h.(3)) in 61 | let w = Array.make 16 0l in 62 | for i = 0 to 15 do 63 | w.(i) <- le32_to_cpu buf (off + (i * 4)) 64 | done ; 65 | let round f a b c d i k s = 66 | let open Int32 in 67 | a := !a + f !b !c !d + w.(i) + k ; 68 | a := rol32 !a s ; 69 | a := !a + !b in 70 | round f1 a b c d 0 0xd76aa478l 7 ; 71 | round f1 d a b c 1 0xe8c7b756l 12 ; 72 | round f1 c d a b 2 0x242070dbl 17 ; 73 | round f1 b c d a 3 0xc1bdceeel 22 ; 74 | round f1 a b c d 4 0xf57c0fafl 7 ; 75 | round f1 d a b c 5 0x4787c62al 12 ; 76 | round f1 c d a b 6 0xa8304613l 17 ; 77 | round f1 b c d a 7 0xfd469501l 22 ; 78 | round f1 a b c d 8 0x698098d8l 7 ; 79 | round f1 d a b c 9 0x8b44f7afl 12 ; 80 | round f1 c d a b 10 0xffff5bb1l 17 ; 81 | round f1 b c d a 11 0x895cd7bel 22 ; 82 | round f1 a b c d 12 0x6b901122l 7 ; 83 | round f1 d a b c 13 0xfd987193l 12 ; 84 | round f1 c d a b 14 0xa679438el 17 ; 85 | round f1 b c d a 15 0x49b40821l 22 ; 86 | round f2 a b c d 1 0xf61e2562l 5 ; 87 | round f2 d a b c 6 0xc040b340l 9 ; 88 | round f2 c d a b 11 0x265e5a51l 14 ; 89 | round f2 b c d a 0 0xe9b6c7aal 20 ; 90 | round f2 a b c d 5 0xd62f105dl 5 ; 91 | round f2 d a b c 10 0x02441453l 9 ; 92 | round f2 c d a b 15 0xd8a1e681l 14 ; 93 | round f2 b c d a 4 0xe7d3fbc8l 20 ; 94 | round f2 a b c d 9 0x21e1cde6l 5 ; 95 | round f2 d a b c 14 0xc33707d6l 9 ; 96 | round f2 c d a b 3 0xf4d50d87l 14 ; 97 | round f2 b c d a 8 0x455a14edl 20 ; 98 | round f2 a b c d 13 0xa9e3e905l 5 ; 99 | round f2 d a b c 2 0xfcefa3f8l 9 ; 100 | round f2 c d a b 7 0x676f02d9l 14 ; 101 | round f2 b c d a 12 0x8d2a4c8al 20 ; 102 | round f3 a b c d 5 0xfffa3942l 4 ; 103 | round f3 d a b c 8 0x8771f681l 11 ; 104 | round f3 c d a b 11 0x6d9d6122l 16 ; 105 | round f3 b c d a 14 0xfde5380cl 23 ; 106 | round f3 a b c d 1 0xa4beea44l 4 ; 107 | round f3 d a b c 4 0x4bdecfa9l 11 ; 108 | round f3 c d a b 7 0xf6bb4b60l 16 ; 109 | round f3 b c d a 10 0xbebfbc70l 23 ; 110 | round f3 a b c d 13 0x289b7ec6l 4 ; 111 | round f3 d a b c 0 0xeaa127fal 11 ; 112 | round f3 c d a b 3 0xd4ef3085l 16 ; 113 | round f3 b c d a 6 0x04881d05l 23 ; 114 | round f3 a b c d 9 0xd9d4d039l 4 ; 115 | round f3 d a b c 12 0xe6db99e5l 11 ; 116 | round f3 c d a b 15 0x1fa27cf8l 16 ; 117 | round f3 b c d a 2 0xc4ac5665l 23 ; 118 | round f4 a b c d 0 0xf4292244l 6 ; 119 | round f4 d a b c 7 0x432aff97l 10 ; 120 | round f4 c d a b 14 0xab9423a7l 15 ; 121 | round f4 b c d a 5 0xfc93a039l 21 ; 122 | round f4 a b c d 12 0x655b59c3l 6 ; 123 | round f4 d a b c 3 0x8f0ccc92l 10 ; 124 | round f4 c d a b 10 0xffeff47dl 15 ; 125 | round f4 b c d a 1 0x85845dd1l 21 ; 126 | round f4 a b c d 8 0x6fa87e4fl 6 ; 127 | round f4 d a b c 15 0xfe2ce6e0l 10 ; 128 | round f4 c d a b 6 0xa3014314l 15 ; 129 | round f4 b c d a 13 0x4e0811a1l 21 ; 130 | round f4 a b c d 4 0xf7537e82l 6 ; 131 | round f4 d a b c 11 0xbd3af235l 10 ; 132 | round f4 c d a b 2 0x2ad7d2bbl 15 ; 133 | round f4 b c d a 9 0xeb86d391l 21 ; 134 | let open Int32 in 135 | ctx.h.(0) <- ctx.h.(0) + !a ; 136 | ctx.h.(1) <- ctx.h.(1) + !b ; 137 | ctx.h.(2) <- ctx.h.(2) + !c ; 138 | ctx.h.(3) <- ctx.h.(3) + !d ; 139 | () 140 | 141 | let feed : 142 | type a. 143 | blit:(a -> int -> By.t -> int -> int -> unit) -> 144 | le32_to_cpu:(a -> int -> int32) -> 145 | ctx -> 146 | a -> 147 | int -> 148 | int -> 149 | unit = 150 | fun ~blit ~le32_to_cpu ctx buf off len -> 151 | let idx = ref Int64.(to_int (ctx.size land 0x3FL)) in 152 | let len = ref len in 153 | let off = ref off in 154 | let to_fill = 64 - !idx in 155 | ctx.size <- Int64.add ctx.size (Int64.of_int !len) ; 156 | if !idx <> 0 && !len >= to_fill 157 | then ( 158 | blit buf !off ctx.b !idx to_fill ; 159 | md5_do_chunk ~le32_to_cpu:By.le32_to_cpu ctx ctx.b 0 ; 160 | len := !len - to_fill ; 161 | off := !off + to_fill ; 162 | idx := 0) ; 163 | while !len >= 64 do 164 | md5_do_chunk ~le32_to_cpu ctx buf !off ; 165 | len := !len - 64 ; 166 | off := !off + 64 167 | done ; 168 | if !len <> 0 then blit buf !off ctx.b !idx !len ; 169 | () 170 | 171 | let unsafe_feed_bytes = feed ~blit:By.blit ~le32_to_cpu:By.le32_to_cpu 172 | 173 | let unsafe_feed_bigstring = 174 | feed ~blit:By.blit_from_bigstring ~le32_to_cpu:Bi.le32_to_cpu 175 | 176 | let unsafe_get ctx = 177 | let index = Int64.(to_int (ctx.size land 0x3FL)) in 178 | let padlen = if index < 56 then 56 - index else 64 + 56 - index in 179 | let padding = By.init padlen (function 0 -> '\x80' | _ -> '\x00') in 180 | let bits = By.create 8 in 181 | By.cpu_to_le64 bits 0 Int64.(ctx.size lsl 3) ; 182 | unsafe_feed_bytes ctx padding 0 padlen ; 183 | unsafe_feed_bytes ctx bits 0 8 ; 184 | let res = By.create (4 * 4) in 185 | for i = 0 to 3 do 186 | By.cpu_to_le32 res (i * 4) ctx.h.(i) 187 | done ; 188 | res 189 | end 190 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_rmd160.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module type S = sig 5 | type ctx 6 | type kind = [ `RMD160 ] 7 | 8 | val init : unit -> ctx 9 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 10 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 11 | val unsafe_get : ctx -> By.t 12 | val dup : ctx -> ctx 13 | end 14 | 15 | module Int32 = struct 16 | include Int32 17 | 18 | let ( lsl ) = Int32.shift_left 19 | let ( lsr ) = Int32.shift_right_logical 20 | let ( asr ) = Int32.shift_right 21 | let ( lor ) = Int32.logor 22 | let ( lxor ) = Int32.logxor 23 | let ( land ) = Int32.logand 24 | let lnot = Int32.lognot 25 | let ( + ) = Int32.add 26 | let rol32 a n = (a lsl n) lor (a lsr (32 - n)) 27 | let ror32 a n = (a lsr n) lor (a lsl (32 - n)) 28 | end 29 | 30 | module Int64 = struct 31 | include Int64 32 | 33 | let ( land ) = Int64.logand 34 | let ( lsl ) = Int64.shift_left 35 | end 36 | 37 | module Unsafe : S = struct 38 | type kind = [ `RMD160 ] 39 | type ctx = { s : int32 array; mutable n : int; h : int32 array; b : Bytes.t } 40 | 41 | let dup ctx = 42 | { s = Array.copy ctx.s; n = ctx.n; h = Array.copy ctx.h; b = By.copy ctx.b } 43 | 44 | let init () = 45 | let b = By.make 64 '\x00' in 46 | { 47 | s = [| 0l; 0l |]; 48 | n = 0; 49 | b; 50 | h = [| 0x67452301l; 0xefcdab89l; 0x98badcfel; 0x10325476l; 0xc3d2e1f0l |]; 51 | } 52 | 53 | let f x y z = Int32.(x lxor y lxor z) 54 | let g x y z = Int32.(x land y lor (lnot x land z)) 55 | let h x y z = Int32.(x lor lnot y lxor z) 56 | let i x y z = Int32.(x land z lor (y land lnot z)) 57 | let j x y z = Int32.(x lxor (y lor lnot z)) 58 | 59 | let ff a b c d e x s = 60 | let open Int32 in 61 | a := !a + f !b !c !d + x ; 62 | a := rol32 !a s + !e ; 63 | c := rol32 !c 10 64 | 65 | let gg a b c d e x s = 66 | let open Int32 in 67 | a := !a + g !b !c !d + x + 0x5a827999l ; 68 | a := rol32 !a s + !e ; 69 | c := rol32 !c 10 70 | 71 | let hh a b c d e x s = 72 | let open Int32 in 73 | a := !a + h !b !c !d + x + 0x6ed9eba1l ; 74 | a := rol32 !a s + !e ; 75 | c := rol32 !c 10 76 | 77 | let ii a b c d e x s = 78 | let open Int32 in 79 | a := !a + i !b !c !d + x + 0x8f1bbcdcl ; 80 | a := rol32 !a s + !e ; 81 | c := rol32 !c 10 82 | 83 | let jj a b c d e x s = 84 | let open Int32 in 85 | a := !a + j !b !c !d + x + 0xa953fd4el ; 86 | a := rol32 !a s + !e ; 87 | c := rol32 !c 10 88 | 89 | let fff a b c d e x s = 90 | let open Int32 in 91 | a := !a + f !b !c !d + x ; 92 | a := rol32 !a s + !e ; 93 | c := rol32 !c 10 94 | 95 | let ggg a b c d e x s = 96 | let open Int32 in 97 | a := !a + g !b !c !d + x + 0x7a6d76e9l ; 98 | a := rol32 !a s + !e ; 99 | c := rol32 !c 10 100 | 101 | let hhh a b c d e x s = 102 | let open Int32 in 103 | a := !a + h !b !c !d + x + 0x6d703ef3l ; 104 | a := rol32 !a s + !e ; 105 | c := rol32 !c 10 106 | 107 | let iii a b c d e x s = 108 | let open Int32 in 109 | a := !a + i !b !c !d + x + 0x5c4dd124l ; 110 | a := rol32 !a s + !e ; 111 | c := rol32 !c 10 112 | 113 | let jjj a b c d e x s = 114 | let open Int32 in 115 | a := !a + j !b !c !d + x + 0x50a28be6l ; 116 | a := rol32 !a s + !e ; 117 | c := rol32 !c 10 118 | 119 | let rmd160_do_chunk : 120 | type a. le32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit = 121 | fun ~le32_to_cpu ctx buff off -> 122 | let aa, bb, cc, dd, ee, aaa, bbb, ccc, ddd, eee = 123 | ( ref ctx.h.(0), 124 | ref ctx.h.(1), 125 | ref ctx.h.(2), 126 | ref ctx.h.(3), 127 | ref ctx.h.(4), 128 | ref ctx.h.(0), 129 | ref ctx.h.(1), 130 | ref ctx.h.(2), 131 | ref ctx.h.(3), 132 | ref ctx.h.(4) ) in 133 | let w = Array.make 16 0l in 134 | for i = 0 to 15 do 135 | w.(i) <- le32_to_cpu buff (off + (i * 4)) 136 | done ; 137 | ff aa bb cc dd ee w.(0) 11 ; 138 | ff ee aa bb cc dd w.(1) 14 ; 139 | ff dd ee aa bb cc w.(2) 15 ; 140 | ff cc dd ee aa bb w.(3) 12 ; 141 | ff bb cc dd ee aa w.(4) 5 ; 142 | ff aa bb cc dd ee w.(5) 8 ; 143 | ff ee aa bb cc dd w.(6) 7 ; 144 | ff dd ee aa bb cc w.(7) 9 ; 145 | ff cc dd ee aa bb w.(8) 11 ; 146 | ff bb cc dd ee aa w.(9) 13 ; 147 | ff aa bb cc dd ee w.(10) 14 ; 148 | ff ee aa bb cc dd w.(11) 15 ; 149 | ff dd ee aa bb cc w.(12) 6 ; 150 | ff cc dd ee aa bb w.(13) 7 ; 151 | ff bb cc dd ee aa w.(14) 9 ; 152 | ff aa bb cc dd ee w.(15) 8 ; 153 | gg ee aa bb cc dd w.(7) 7 ; 154 | gg dd ee aa bb cc w.(4) 6 ; 155 | gg cc dd ee aa bb w.(13) 8 ; 156 | gg bb cc dd ee aa w.(1) 13 ; 157 | gg aa bb cc dd ee w.(10) 11 ; 158 | gg ee aa bb cc dd w.(6) 9 ; 159 | gg dd ee aa bb cc w.(15) 7 ; 160 | gg cc dd ee aa bb w.(3) 15 ; 161 | gg bb cc dd ee aa w.(12) 7 ; 162 | gg aa bb cc dd ee w.(0) 12 ; 163 | gg ee aa bb cc dd w.(9) 15 ; 164 | gg dd ee aa bb cc w.(5) 9 ; 165 | gg cc dd ee aa bb w.(2) 11 ; 166 | gg bb cc dd ee aa w.(14) 7 ; 167 | gg aa bb cc dd ee w.(11) 13 ; 168 | gg ee aa bb cc dd w.(8) 12 ; 169 | hh dd ee aa bb cc w.(3) 11 ; 170 | hh cc dd ee aa bb w.(10) 13 ; 171 | hh bb cc dd ee aa w.(14) 6 ; 172 | hh aa bb cc dd ee w.(4) 7 ; 173 | hh ee aa bb cc dd w.(9) 14 ; 174 | hh dd ee aa bb cc w.(15) 9 ; 175 | hh cc dd ee aa bb w.(8) 13 ; 176 | hh bb cc dd ee aa w.(1) 15 ; 177 | hh aa bb cc dd ee w.(2) 14 ; 178 | hh ee aa bb cc dd w.(7) 8 ; 179 | hh dd ee aa bb cc w.(0) 13 ; 180 | hh cc dd ee aa bb w.(6) 6 ; 181 | hh bb cc dd ee aa w.(13) 5 ; 182 | hh aa bb cc dd ee w.(11) 12 ; 183 | hh ee aa bb cc dd w.(5) 7 ; 184 | hh dd ee aa bb cc w.(12) 5 ; 185 | ii cc dd ee aa bb w.(1) 11 ; 186 | ii bb cc dd ee aa w.(9) 12 ; 187 | ii aa bb cc dd ee w.(11) 14 ; 188 | ii ee aa bb cc dd w.(10) 15 ; 189 | ii dd ee aa bb cc w.(0) 14 ; 190 | ii cc dd ee aa bb w.(8) 15 ; 191 | ii bb cc dd ee aa w.(12) 9 ; 192 | ii aa bb cc dd ee w.(4) 8 ; 193 | ii ee aa bb cc dd w.(13) 9 ; 194 | ii dd ee aa bb cc w.(3) 14 ; 195 | ii cc dd ee aa bb w.(7) 5 ; 196 | ii bb cc dd ee aa w.(15) 6 ; 197 | ii aa bb cc dd ee w.(14) 8 ; 198 | ii ee aa bb cc dd w.(5) 6 ; 199 | ii dd ee aa bb cc w.(6) 5 ; 200 | ii cc dd ee aa bb w.(2) 12 ; 201 | jj bb cc dd ee aa w.(4) 9 ; 202 | jj aa bb cc dd ee w.(0) 15 ; 203 | jj ee aa bb cc dd w.(5) 5 ; 204 | jj dd ee aa bb cc w.(9) 11 ; 205 | jj cc dd ee aa bb w.(7) 6 ; 206 | jj bb cc dd ee aa w.(12) 8 ; 207 | jj aa bb cc dd ee w.(2) 13 ; 208 | jj ee aa bb cc dd w.(10) 12 ; 209 | jj dd ee aa bb cc w.(14) 5 ; 210 | jj cc dd ee aa bb w.(1) 12 ; 211 | jj bb cc dd ee aa w.(3) 13 ; 212 | jj aa bb cc dd ee w.(8) 14 ; 213 | jj ee aa bb cc dd w.(11) 11 ; 214 | jj dd ee aa bb cc w.(6) 8 ; 215 | jj cc dd ee aa bb w.(15) 5 ; 216 | jj bb cc dd ee aa w.(13) 6 ; 217 | jjj aaa bbb ccc ddd eee w.(5) 8 ; 218 | jjj eee aaa bbb ccc ddd w.(14) 9 ; 219 | jjj ddd eee aaa bbb ccc w.(7) 9 ; 220 | jjj ccc ddd eee aaa bbb w.(0) 11 ; 221 | jjj bbb ccc ddd eee aaa w.(9) 13 ; 222 | jjj aaa bbb ccc ddd eee w.(2) 15 ; 223 | jjj eee aaa bbb ccc ddd w.(11) 15 ; 224 | jjj ddd eee aaa bbb ccc w.(4) 5 ; 225 | jjj ccc ddd eee aaa bbb w.(13) 7 ; 226 | jjj bbb ccc ddd eee aaa w.(6) 7 ; 227 | jjj aaa bbb ccc ddd eee w.(15) 8 ; 228 | jjj eee aaa bbb ccc ddd w.(8) 11 ; 229 | jjj ddd eee aaa bbb ccc w.(1) 14 ; 230 | jjj ccc ddd eee aaa bbb w.(10) 14 ; 231 | jjj bbb ccc ddd eee aaa w.(3) 12 ; 232 | jjj aaa bbb ccc ddd eee w.(12) 6 ; 233 | iii eee aaa bbb ccc ddd w.(6) 9 ; 234 | iii ddd eee aaa bbb ccc w.(11) 13 ; 235 | iii ccc ddd eee aaa bbb w.(3) 15 ; 236 | iii bbb ccc ddd eee aaa w.(7) 7 ; 237 | iii aaa bbb ccc ddd eee w.(0) 12 ; 238 | iii eee aaa bbb ccc ddd w.(13) 8 ; 239 | iii ddd eee aaa bbb ccc w.(5) 9 ; 240 | iii ccc ddd eee aaa bbb w.(10) 11 ; 241 | iii bbb ccc ddd eee aaa w.(14) 7 ; 242 | iii aaa bbb ccc ddd eee w.(15) 7 ; 243 | iii eee aaa bbb ccc ddd w.(8) 12 ; 244 | iii ddd eee aaa bbb ccc w.(12) 7 ; 245 | iii ccc ddd eee aaa bbb w.(4) 6 ; 246 | iii bbb ccc ddd eee aaa w.(9) 15 ; 247 | iii aaa bbb ccc ddd eee w.(1) 13 ; 248 | iii eee aaa bbb ccc ddd w.(2) 11 ; 249 | hhh ddd eee aaa bbb ccc w.(15) 9 ; 250 | hhh ccc ddd eee aaa bbb w.(5) 7 ; 251 | hhh bbb ccc ddd eee aaa w.(1) 15 ; 252 | hhh aaa bbb ccc ddd eee w.(3) 11 ; 253 | hhh eee aaa bbb ccc ddd w.(7) 8 ; 254 | hhh ddd eee aaa bbb ccc w.(14) 6 ; 255 | hhh ccc ddd eee aaa bbb w.(6) 6 ; 256 | hhh bbb ccc ddd eee aaa w.(9) 14 ; 257 | hhh aaa bbb ccc ddd eee w.(11) 12 ; 258 | hhh eee aaa bbb ccc ddd w.(8) 13 ; 259 | hhh ddd eee aaa bbb ccc w.(12) 5 ; 260 | hhh ccc ddd eee aaa bbb w.(2) 14 ; 261 | hhh bbb ccc ddd eee aaa w.(10) 13 ; 262 | hhh aaa bbb ccc ddd eee w.(0) 13 ; 263 | hhh eee aaa bbb ccc ddd w.(4) 7 ; 264 | hhh ddd eee aaa bbb ccc w.(13) 5 ; 265 | ggg ccc ddd eee aaa bbb w.(8) 15 ; 266 | ggg bbb ccc ddd eee aaa w.(6) 5 ; 267 | ggg aaa bbb ccc ddd eee w.(4) 8 ; 268 | ggg eee aaa bbb ccc ddd w.(1) 11 ; 269 | ggg ddd eee aaa bbb ccc w.(3) 14 ; 270 | ggg ccc ddd eee aaa bbb w.(11) 14 ; 271 | ggg bbb ccc ddd eee aaa w.(15) 6 ; 272 | ggg aaa bbb ccc ddd eee w.(0) 14 ; 273 | ggg eee aaa bbb ccc ddd w.(5) 6 ; 274 | ggg ddd eee aaa bbb ccc w.(12) 9 ; 275 | ggg ccc ddd eee aaa bbb w.(2) 12 ; 276 | ggg bbb ccc ddd eee aaa w.(13) 9 ; 277 | ggg aaa bbb ccc ddd eee w.(9) 12 ; 278 | ggg eee aaa bbb ccc ddd w.(7) 5 ; 279 | ggg ddd eee aaa bbb ccc w.(10) 15 ; 280 | ggg ccc ddd eee aaa bbb w.(14) 8 ; 281 | fff bbb ccc ddd eee aaa w.(12) 8 ; 282 | fff aaa bbb ccc ddd eee w.(15) 5 ; 283 | fff eee aaa bbb ccc ddd w.(10) 12 ; 284 | fff ddd eee aaa bbb ccc w.(4) 9 ; 285 | fff ccc ddd eee aaa bbb w.(1) 12 ; 286 | fff bbb ccc ddd eee aaa w.(5) 5 ; 287 | fff aaa bbb ccc ddd eee w.(8) 14 ; 288 | fff eee aaa bbb ccc ddd w.(7) 6 ; 289 | fff ddd eee aaa bbb ccc w.(6) 8 ; 290 | fff ccc ddd eee aaa bbb w.(2) 13 ; 291 | fff bbb ccc ddd eee aaa w.(13) 6 ; 292 | fff aaa bbb ccc ddd eee w.(14) 5 ; 293 | fff eee aaa bbb ccc ddd w.(0) 15 ; 294 | fff ddd eee aaa bbb ccc w.(3) 13 ; 295 | fff ccc ddd eee aaa bbb w.(9) 11 ; 296 | fff bbb ccc ddd eee aaa w.(11) 11 ; 297 | let open Int32 in 298 | ddd := !ddd + !cc + ctx.h.(1) ; 299 | (* final result for h[0]. *) 300 | ctx.h.(1) <- ctx.h.(2) + !dd + !eee ; 301 | ctx.h.(2) <- ctx.h.(3) + !ee + !aaa ; 302 | ctx.h.(3) <- ctx.h.(4) + !aa + !bbb ; 303 | ctx.h.(4) <- ctx.h.(0) + !bb + !ccc ; 304 | ctx.h.(0) <- !ddd ; 305 | () 306 | 307 | exception Leave 308 | 309 | let feed : 310 | type a. 311 | le32_to_cpu:(a -> int -> int32) -> 312 | blit:(a -> int -> By.t -> int -> int -> unit) -> 313 | ctx -> 314 | a -> 315 | int -> 316 | int -> 317 | unit = 318 | fun ~le32_to_cpu ~blit ctx buf off len -> 319 | let t = ref ctx.s.(0) in 320 | let off = ref off in 321 | let len = ref len in 322 | ctx.s.(0) <- Int32.add !t (Int32.of_int (!len lsl 3)) ; 323 | if ctx.s.(0) < !t then ctx.s.(1) <- Int32.(ctx.s.(1) + 1l) ; 324 | ctx.s.(1) <- Int32.add ctx.s.(1) (Int32.of_int (!len lsr 29)) ; 325 | try 326 | if ctx.n <> 0 327 | then ( 328 | let t = 64 - ctx.n in 329 | if !len < t 330 | then ( 331 | blit buf !off ctx.b ctx.n !len ; 332 | ctx.n <- ctx.n + !len ; 333 | raise Leave) ; 334 | blit buf !off ctx.b ctx.n t ; 335 | rmd160_do_chunk ~le32_to_cpu:By.le32_to_cpu ctx ctx.b 0 ; 336 | off := !off + t ; 337 | len := !len - t) ; 338 | while !len >= 64 do 339 | rmd160_do_chunk ~le32_to_cpu ctx buf !off ; 340 | off := !off + 64 ; 341 | len := !len - 64 342 | done ; 343 | blit buf !off ctx.b 0 !len ; 344 | ctx.n <- !len 345 | with Leave -> () 346 | 347 | let unsafe_feed_bytes ctx buf off len = 348 | feed ~blit:By.blit ~le32_to_cpu:By.le32_to_cpu ctx buf off len 349 | 350 | let unsafe_feed_bigstring ctx buf off len = 351 | feed ~blit:By.blit_from_bigstring ~le32_to_cpu:Bi.le32_to_cpu ctx buf off 352 | len 353 | 354 | let unsafe_get ctx = 355 | let i = ref (ctx.n + 1) in 356 | let res = By.create (5 * 4) in 357 | By.set ctx.b ctx.n '\x80' ; 358 | if !i > 56 359 | then ( 360 | By.fill ctx.b !i (64 - !i) '\x00' ; 361 | rmd160_do_chunk ~le32_to_cpu:By.le32_to_cpu ctx ctx.b 0 ; 362 | i := 0) ; 363 | By.fill ctx.b !i (56 - !i) '\x00' ; 364 | By.cpu_to_le32 ctx.b 56 ctx.s.(0) ; 365 | By.cpu_to_le32 ctx.b 60 ctx.s.(1) ; 366 | rmd160_do_chunk ~le32_to_cpu:By.le32_to_cpu ctx ctx.b 0 ; 367 | for i = 0 to 4 do 368 | By.cpu_to_le32 res (i * 4) ctx.h.(i) 369 | done ; 370 | res 371 | end 372 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_sha1.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module Int32 = struct 5 | include Int32 6 | 7 | let ( lsl ) = Int32.shift_left 8 | let ( lsr ) = Int32.shift_right_logical 9 | let ( asr ) = Int32.shift_right 10 | let ( lor ) = Int32.logor 11 | let ( lxor ) = Int32.logxor 12 | let ( land ) = Int32.logand 13 | let ( + ) = Int32.add 14 | let rol32 a n = (a lsl n) lor (a lsr (32 - n)) 15 | end 16 | 17 | module Int64 = struct 18 | include Int64 19 | 20 | let ( land ) = Int64.logand 21 | let ( lsl ) = Int64.shift_left 22 | end 23 | 24 | module type S = sig 25 | type ctx 26 | type kind = [ `SHA1 ] 27 | 28 | val init : unit -> ctx 29 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 30 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 31 | val unsafe_get : ctx -> By.t 32 | val dup : ctx -> ctx 33 | end 34 | 35 | module Unsafe : S = struct 36 | type kind = [ `SHA1 ] 37 | type ctx = { mutable size : int64; b : Bytes.t; h : int32 array } 38 | 39 | let dup ctx = { size = ctx.size; b = By.copy ctx.b; h = Array.copy ctx.h } 40 | 41 | let init () = 42 | let b = By.make 64 '\x00' in 43 | { 44 | size = 0L; 45 | b; 46 | h = [| 0x67452301l; 0xefcdab89l; 0x98badcfel; 0x10325476l; 0xc3d2e1f0l |]; 47 | } 48 | 49 | let f1 x y z = Int32.(z lxor (x land (y lxor z))) 50 | let f2 x y z = Int32.(x lxor y lxor z) 51 | let f3 x y z = Int32.((x land y) + (z land (x lxor y))) 52 | let f4 = f2 53 | let k1 = 0x5a827999l 54 | let k2 = 0x6ed9eba1l 55 | let k3 = 0x8f1bbcdcl 56 | let k4 = 0xca62c1d6l 57 | 58 | let sha1_do_chunk : 59 | type a. be32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit = 60 | fun ~be32_to_cpu ctx buf off -> 61 | let a = ref ctx.h.(0) in 62 | let b = ref ctx.h.(1) in 63 | let c = ref ctx.h.(2) in 64 | let d = ref ctx.h.(3) in 65 | let e = ref ctx.h.(4) in 66 | let w = Array.make 16 0l in 67 | let m i = 68 | let ( && ) a b = a land b in 69 | let ( -- ) a b = a - b in 70 | let v = 71 | Int32.( 72 | rol32 73 | (w.(i && 0x0F) 74 | lxor w.((i -- 14) && 0x0F) 75 | lxor w.((i -- 8) && 0x0F) 76 | lxor w.((i -- 3) && 0x0F)) 77 | 1) in 78 | w.(i land 0x0F) <- v ; 79 | w.(i land 0x0F) in 80 | let round a b c d e f k w = 81 | (e := Int32.(!e + rol32 !a 5 + f !b !c !d + k + w)) ; 82 | b := Int32.(rol32 !b 30) in 83 | for i = 0 to 15 do 84 | w.(i) <- be32_to_cpu buf (off + (i * 4)) 85 | done ; 86 | round a b c d e f1 k1 w.(0) ; 87 | round e a b c d f1 k1 w.(1) ; 88 | round d e a b c f1 k1 w.(2) ; 89 | round c d e a b f1 k1 w.(3) ; 90 | round b c d e a f1 k1 w.(4) ; 91 | round a b c d e f1 k1 w.(5) ; 92 | round e a b c d f1 k1 w.(6) ; 93 | round d e a b c f1 k1 w.(7) ; 94 | round c d e a b f1 k1 w.(8) ; 95 | round b c d e a f1 k1 w.(9) ; 96 | round a b c d e f1 k1 w.(10) ; 97 | round e a b c d f1 k1 w.(11) ; 98 | round d e a b c f1 k1 w.(12) ; 99 | round c d e a b f1 k1 w.(13) ; 100 | round b c d e a f1 k1 w.(14) ; 101 | round a b c d e f1 k1 w.(15) ; 102 | round e a b c d f1 k1 (m 16) ; 103 | round d e a b c f1 k1 (m 17) ; 104 | round c d e a b f1 k1 (m 18) ; 105 | round b c d e a f1 k1 (m 19) ; 106 | round a b c d e f2 k2 (m 20) ; 107 | round e a b c d f2 k2 (m 21) ; 108 | round d e a b c f2 k2 (m 22) ; 109 | round c d e a b f2 k2 (m 23) ; 110 | round b c d e a f2 k2 (m 24) ; 111 | round a b c d e f2 k2 (m 25) ; 112 | round e a b c d f2 k2 (m 26) ; 113 | round d e a b c f2 k2 (m 27) ; 114 | round c d e a b f2 k2 (m 28) ; 115 | round b c d e a f2 k2 (m 29) ; 116 | round a b c d e f2 k2 (m 30) ; 117 | round e a b c d f2 k2 (m 31) ; 118 | round d e a b c f2 k2 (m 32) ; 119 | round c d e a b f2 k2 (m 33) ; 120 | round b c d e a f2 k2 (m 34) ; 121 | round a b c d e f2 k2 (m 35) ; 122 | round e a b c d f2 k2 (m 36) ; 123 | round d e a b c f2 k2 (m 37) ; 124 | round c d e a b f2 k2 (m 38) ; 125 | round b c d e a f2 k2 (m 39) ; 126 | round a b c d e f3 k3 (m 40) ; 127 | round e a b c d f3 k3 (m 41) ; 128 | round d e a b c f3 k3 (m 42) ; 129 | round c d e a b f3 k3 (m 43) ; 130 | round b c d e a f3 k3 (m 44) ; 131 | round a b c d e f3 k3 (m 45) ; 132 | round e a b c d f3 k3 (m 46) ; 133 | round d e a b c f3 k3 (m 47) ; 134 | round c d e a b f3 k3 (m 48) ; 135 | round b c d e a f3 k3 (m 49) ; 136 | round a b c d e f3 k3 (m 50) ; 137 | round e a b c d f3 k3 (m 51) ; 138 | round d e a b c f3 k3 (m 52) ; 139 | round c d e a b f3 k3 (m 53) ; 140 | round b c d e a f3 k3 (m 54) ; 141 | round a b c d e f3 k3 (m 55) ; 142 | round e a b c d f3 k3 (m 56) ; 143 | round d e a b c f3 k3 (m 57) ; 144 | round c d e a b f3 k3 (m 58) ; 145 | round b c d e a f3 k3 (m 59) ; 146 | round a b c d e f4 k4 (m 60) ; 147 | round e a b c d f4 k4 (m 61) ; 148 | round d e a b c f4 k4 (m 62) ; 149 | round c d e a b f4 k4 (m 63) ; 150 | round b c d e a f4 k4 (m 64) ; 151 | round a b c d e f4 k4 (m 65) ; 152 | round e a b c d f4 k4 (m 66) ; 153 | round d e a b c f4 k4 (m 67) ; 154 | round c d e a b f4 k4 (m 68) ; 155 | round b c d e a f4 k4 (m 69) ; 156 | round a b c d e f4 k4 (m 70) ; 157 | round e a b c d f4 k4 (m 71) ; 158 | round d e a b c f4 k4 (m 72) ; 159 | round c d e a b f4 k4 (m 73) ; 160 | round b c d e a f4 k4 (m 74) ; 161 | round a b c d e f4 k4 (m 75) ; 162 | round e a b c d f4 k4 (m 76) ; 163 | round d e a b c f4 k4 (m 77) ; 164 | round c d e a b f4 k4 (m 78) ; 165 | round b c d e a f4 k4 (m 79) ; 166 | ctx.h.(0) <- Int32.add ctx.h.(0) !a ; 167 | ctx.h.(1) <- Int32.add ctx.h.(1) !b ; 168 | ctx.h.(2) <- Int32.add ctx.h.(2) !c ; 169 | ctx.h.(3) <- Int32.add ctx.h.(3) !d ; 170 | ctx.h.(4) <- Int32.add ctx.h.(4) !e ; 171 | () 172 | 173 | let feed : 174 | type a. 175 | blit:(a -> int -> By.t -> int -> int -> unit) -> 176 | be32_to_cpu:(a -> int -> int32) -> 177 | ctx -> 178 | a -> 179 | int -> 180 | int -> 181 | unit = 182 | fun ~blit ~be32_to_cpu ctx buf off len -> 183 | let idx = ref Int64.(to_int (ctx.size land 0x3FL)) in 184 | let len = ref len in 185 | let off = ref off in 186 | let to_fill = 64 - !idx in 187 | ctx.size <- Int64.add ctx.size (Int64.of_int !len) ; 188 | if !idx <> 0 && !len >= to_fill 189 | then ( 190 | blit buf !off ctx.b !idx to_fill ; 191 | sha1_do_chunk ~be32_to_cpu:By.be32_to_cpu ctx ctx.b 0 ; 192 | len := !len - to_fill ; 193 | off := !off + to_fill ; 194 | idx := 0) ; 195 | while !len >= 64 do 196 | sha1_do_chunk ~be32_to_cpu ctx buf !off ; 197 | len := !len - 64 ; 198 | off := !off + 64 199 | done ; 200 | if !len <> 0 then blit buf !off ctx.b !idx !len ; 201 | () 202 | 203 | let unsafe_feed_bytes = feed ~blit:By.blit ~be32_to_cpu:By.be32_to_cpu 204 | 205 | let unsafe_feed_bigstring = 206 | feed ~blit:By.blit_from_bigstring ~be32_to_cpu:Bi.be32_to_cpu 207 | 208 | let unsafe_get ctx = 209 | let index = Int64.(to_int (ctx.size land 0x3FL)) in 210 | let padlen = if index < 56 then 56 - index else 64 + 56 - index in 211 | let padding = By.init padlen (function 0 -> '\x80' | _ -> '\x00') in 212 | let bits = By.create 8 in 213 | By.cpu_to_be64 bits 0 Int64.(ctx.size lsl 3) ; 214 | unsafe_feed_bytes ctx padding 0 padlen ; 215 | unsafe_feed_bytes ctx bits 0 8 ; 216 | let res = By.create (5 * 4) in 217 | for i = 0 to 4 do 218 | By.cpu_to_be32 res (i * 4) ctx.h.(i) 219 | done ; 220 | res 221 | end 222 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_sha224.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module type S = sig 5 | type ctx 6 | type kind = [ `SHA224 ] 7 | 8 | val init : unit -> ctx 9 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 10 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 11 | val unsafe_get : ctx -> By.t 12 | val dup : ctx -> ctx 13 | end 14 | 15 | module Unsafe : S = struct 16 | type kind = [ `SHA224 ] 17 | 18 | open Baijiu_sha256.Unsafe 19 | 20 | type nonrec ctx = ctx 21 | 22 | let init () = 23 | let b = By.make 128 '\x00' in 24 | { 25 | size = 0L; 26 | b; 27 | h = 28 | [| 29 | 0xc1059ed8l; 0x367cd507l; 0x3070dd17l; 0xf70e5939l; 0xffc00b31l; 30 | 0x68581511l; 0x64f98fa7l; 0xbefa4fa4l; 31 | |]; 32 | } 33 | 34 | let unsafe_get ctx = 35 | let res = unsafe_get ctx in 36 | By.sub res 0 28 37 | 38 | let dup = dup 39 | let unsafe_feed_bytes = unsafe_feed_bytes 40 | let unsafe_feed_bigstring = unsafe_feed_bigstring 41 | end 42 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_sha256.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module Int32 = struct 5 | include Int32 6 | 7 | let ( lsl ) = Int32.shift_left 8 | let ( lsr ) = Int32.shift_right_logical 9 | let ( asr ) = Int32.shift_right 10 | let ( lor ) = Int32.logor 11 | let ( lxor ) = Int32.logxor 12 | let ( land ) = Int32.logand 13 | let ( + ) = Int32.add 14 | let rol32 a n = (a lsl n) lor (a lsr (32 - n)) 15 | let ror32 a n = (a lsr n) lor (a lsl (32 - n)) 16 | end 17 | 18 | module Int64 = struct 19 | include Int64 20 | 21 | let ( land ) = Int64.logand 22 | let ( lsl ) = Int64.shift_left 23 | end 24 | 25 | module type S = sig 26 | type kind = [ `SHA256 ] 27 | type ctx = { mutable size : int64; b : Bytes.t; h : int32 array } 28 | 29 | val init : unit -> ctx 30 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 31 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 32 | val unsafe_get : ctx -> By.t 33 | val dup : ctx -> ctx 34 | end 35 | 36 | module Unsafe : S = struct 37 | type kind = [ `SHA256 ] 38 | type ctx = { mutable size : int64; b : Bytes.t; h : int32 array } 39 | 40 | let dup ctx = { size = ctx.size; b = By.copy ctx.b; h = Array.copy ctx.h } 41 | 42 | let init () = 43 | let b = By.make 128 '\x00' in 44 | { 45 | size = 0L; 46 | b; 47 | h = 48 | [| 49 | 0x6a09e667l; 0xbb67ae85l; 0x3c6ef372l; 0xa54ff53al; 0x510e527fl; 50 | 0x9b05688cl; 0x1f83d9abl; 0x5be0cd19l; 51 | |]; 52 | } 53 | 54 | let k = 55 | [| 56 | 0x428a2f98l; 0x71374491l; 0xb5c0fbcfl; 0xe9b5dba5l; 0x3956c25bl; 57 | 0x59f111f1l; 0x923f82a4l; 0xab1c5ed5l; 0xd807aa98l; 0x12835b01l; 58 | 0x243185bel; 0x550c7dc3l; 0x72be5d74l; 0x80deb1fel; 0x9bdc06a7l; 59 | 0xc19bf174l; 0xe49b69c1l; 0xefbe4786l; 0x0fc19dc6l; 0x240ca1ccl; 60 | 0x2de92c6fl; 0x4a7484aal; 0x5cb0a9dcl; 0x76f988dal; 0x983e5152l; 61 | 0xa831c66dl; 0xb00327c8l; 0xbf597fc7l; 0xc6e00bf3l; 0xd5a79147l; 62 | 0x06ca6351l; 0x14292967l; 0x27b70a85l; 0x2e1b2138l; 0x4d2c6dfcl; 63 | 0x53380d13l; 0x650a7354l; 0x766a0abbl; 0x81c2c92el; 0x92722c85l; 64 | 0xa2bfe8a1l; 0xa81a664bl; 0xc24b8b70l; 0xc76c51a3l; 0xd192e819l; 65 | 0xd6990624l; 0xf40e3585l; 0x106aa070l; 0x19a4c116l; 0x1e376c08l; 66 | 0x2748774cl; 0x34b0bcb5l; 0x391c0cb3l; 0x4ed8aa4al; 0x5b9cca4fl; 67 | 0x682e6ff3l; 0x748f82eel; 0x78a5636fl; 0x84c87814l; 0x8cc70208l; 68 | 0x90befffal; 0xa4506cebl; 0xbef9a3f7l; 0xc67178f2l; 69 | |] 70 | 71 | let e0 x = Int32.(ror32 x 2 lxor ror32 x 13 lxor ror32 x 22) 72 | let e1 x = Int32.(ror32 x 6 lxor ror32 x 11 lxor ror32 x 25) 73 | let s0 x = Int32.(ror32 x 7 lxor ror32 x 18 lxor (x lsr 3)) 74 | let s1 x = Int32.(ror32 x 17 lxor ror32 x 19 lxor (x lsr 10)) 75 | 76 | let sha256_do_chunk : 77 | type a. be32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit = 78 | fun ~be32_to_cpu ctx buf off -> 79 | let a, b, c, d, e, f, g, h, t1, t2 = 80 | ( ref ctx.h.(0), 81 | ref ctx.h.(1), 82 | ref ctx.h.(2), 83 | ref ctx.h.(3), 84 | ref ctx.h.(4), 85 | ref ctx.h.(5), 86 | ref ctx.h.(6), 87 | ref ctx.h.(7), 88 | ref 0l, 89 | ref 0l ) in 90 | let w = Array.make 64 0l in 91 | for i = 0 to 15 do 92 | w.(i) <- be32_to_cpu buf (off + (i * 4)) 93 | done ; 94 | let ( -- ) a b = a - b in 95 | for i = 16 to 63 do 96 | w.(i) <- Int32.(s1 w.(i -- 2) + w.(i -- 7) + s0 w.(i -- 15) + w.(i -- 16)) 97 | done ; 98 | let round a b c d e f g h k w = 99 | let open Int32 in 100 | t1 := !h + e1 !e + (!g lxor (!e land (!f lxor !g))) + k + w ; 101 | t2 := e0 !a + (!a land !b lor (!c land (!a lor !b))) ; 102 | d := !d + !t1 ; 103 | h := !t1 + !t2 in 104 | for i = 0 to 7 do 105 | round a b c d e f g h k.((i * 8) + 0) w.((i * 8) + 0) ; 106 | round h a b c d e f g k.((i * 8) + 1) w.((i * 8) + 1) ; 107 | round g h a b c d e f k.((i * 8) + 2) w.((i * 8) + 2) ; 108 | round f g h a b c d e k.((i * 8) + 3) w.((i * 8) + 3) ; 109 | round e f g h a b c d k.((i * 8) + 4) w.((i * 8) + 4) ; 110 | round d e f g h a b c k.((i * 8) + 5) w.((i * 8) + 5) ; 111 | round c d e f g h a b k.((i * 8) + 6) w.((i * 8) + 6) ; 112 | round b c d e f g h a k.((i * 8) + 7) w.((i * 8) + 7) 113 | done ; 114 | let open Int32 in 115 | ctx.h.(0) <- ctx.h.(0) + !a ; 116 | ctx.h.(1) <- ctx.h.(1) + !b ; 117 | ctx.h.(2) <- ctx.h.(2) + !c ; 118 | ctx.h.(3) <- ctx.h.(3) + !d ; 119 | ctx.h.(4) <- ctx.h.(4) + !e ; 120 | ctx.h.(5) <- ctx.h.(5) + !f ; 121 | ctx.h.(6) <- ctx.h.(6) + !g ; 122 | ctx.h.(7) <- ctx.h.(7) + !h ; 123 | () 124 | 125 | let feed : 126 | type a. 127 | blit:(a -> int -> By.t -> int -> int -> unit) -> 128 | be32_to_cpu:(a -> int -> int32) -> 129 | ctx -> 130 | a -> 131 | int -> 132 | int -> 133 | unit = 134 | fun ~blit ~be32_to_cpu ctx buf off len -> 135 | let idx = ref Int64.(to_int (ctx.size land 0x3FL)) in 136 | let len = ref len in 137 | let off = ref off in 138 | let to_fill = 64 - !idx in 139 | ctx.size <- Int64.add ctx.size (Int64.of_int !len) ; 140 | if !idx <> 0 && !len >= to_fill 141 | then ( 142 | blit buf !off ctx.b !idx to_fill ; 143 | sha256_do_chunk ~be32_to_cpu:By.be32_to_cpu ctx ctx.b 0 ; 144 | len := !len - to_fill ; 145 | off := !off + to_fill ; 146 | idx := 0) ; 147 | while !len >= 64 do 148 | sha256_do_chunk ~be32_to_cpu ctx buf !off ; 149 | len := !len - 64 ; 150 | off := !off + 64 151 | done ; 152 | if !len <> 0 then blit buf !off ctx.b !idx !len ; 153 | () 154 | 155 | let unsafe_feed_bytes = feed ~blit:By.blit ~be32_to_cpu:By.be32_to_cpu 156 | 157 | let unsafe_feed_bigstring = 158 | feed ~blit:By.blit_from_bigstring ~be32_to_cpu:Bi.be32_to_cpu 159 | 160 | let unsafe_get ctx = 161 | let index = Int64.(to_int (ctx.size land 0x3FL)) in 162 | let padlen = if index < 56 then 56 - index else 64 + 56 - index in 163 | let padding = By.init padlen (function 0 -> '\x80' | _ -> '\x00') in 164 | let bits = By.create 8 in 165 | By.cpu_to_be64 bits 0 Int64.(ctx.size lsl 3) ; 166 | unsafe_feed_bytes ctx padding 0 padlen ; 167 | unsafe_feed_bytes ctx bits 0 8 ; 168 | let res = By.create (8 * 4) in 169 | for i = 0 to 7 do 170 | By.cpu_to_be32 res (i * 4) ctx.h.(i) 171 | done ; 172 | res 173 | end 174 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_sha3.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | let nist_padding = 0x06L 5 | let keccak_padding = 0x01L 6 | 7 | module Int64 = struct 8 | include Int64 9 | 10 | let ( lsl ) = Int64.shift_left 11 | let ( lsr ) = Int64.shift_right_logical 12 | let ( asr ) = Int64.shift_right 13 | let ( lor ) = Int64.logor 14 | let ( land ) = Int64.logand 15 | let ( lxor ) = Int64.logxor 16 | let ( + ) = Int64.add 17 | let ror64 a n = (a lsr n) lor (a lsl (64 - n)) 18 | let rol64 a n = (a lsl n) lor (a lsr (64 - n)) 19 | end 20 | 21 | module Unsafe (P : sig 22 | val padding : int64 23 | end) = 24 | struct 25 | type ctx = { 26 | q : int64 array; 27 | rsize : int; 28 | (* block size *) 29 | mdlen : int; 30 | (* output size *) 31 | mutable pt : int; 32 | } 33 | 34 | let dup ctx = 35 | { q = Array.copy ctx.q; rsize = ctx.rsize; mdlen = ctx.mdlen; pt = ctx.pt } 36 | 37 | let init mdlen = 38 | let rsize = 200 - (2 * mdlen) in 39 | { q = Array.make 25 0L; rsize; mdlen; pt = 0 } 40 | 41 | let keccakf_rounds = 24 42 | 43 | let keccaft_rndc : int64 array = 44 | [| 45 | 0x0000000000000001L; 0x0000000000008082L; 0x800000000000808aL; 46 | 0x8000000080008000L; 0x000000000000808bL; 0x0000000080000001L; 47 | 0x8000000080008081L; 0x8000000000008009L; 0x000000000000008aL; 48 | 0x0000000000000088L; 0x0000000080008009L; 0x000000008000000aL; 49 | 0x000000008000808bL; 0x800000000000008bL; 0x8000000000008089L; 50 | 0x8000000000008003L; 0x8000000000008002L; 0x8000000000000080L; 51 | 0x000000000000800aL; 0x800000008000000aL; 0x8000000080008081L; 52 | 0x8000000000008080L; 0x0000000080000001L; 0x8000000080008008L; 53 | |] 54 | 55 | let keccaft_rotc : int array = 56 | [| 57 | 1; 3; 6; 10; 15; 21; 28; 36; 45; 55; 2; 14; 27; 41; 56; 8; 25; 43; 62; 18; 58 | 39; 61; 20; 44; 59 | |] 60 | 61 | let keccakf_piln : int array = 62 | [| 63 | 10; 7; 11; 17; 18; 3; 5; 16; 8; 21; 24; 4; 15; 23; 19; 13; 12; 2; 20; 14; 64 | 22; 9; 6; 1; 65 | |] 66 | 67 | let sha3_keccakf (q : int64 array) = 68 | for r = 0 to keccakf_rounds - 1 do 69 | let ( lxor ) = Int64.( lxor ) in 70 | let lnot = Int64.lognot in 71 | let ( land ) = Int64.( land ) in 72 | (* Theta *) 73 | let bc = 74 | Array.init 5 (fun i -> 75 | q.(i) lxor q.(i + 5) lxor q.(i + 10) lxor q.(i + 15) lxor q.(i + 20)) 76 | in 77 | for i = 0 to 4 do 78 | let t = bc.((i + 4) mod 5) lxor Int64.rol64 bc.((i + 1) mod 5) 1 in 79 | for k = 0 to 4 do 80 | let j = k * 5 in 81 | q.(j + i) <- q.(j + i) lxor t 82 | done 83 | done ; 84 | 85 | (* Rho Pi *) 86 | let t = ref q.(1) in 87 | let _ = 88 | Array.iteri 89 | (fun i rotc -> 90 | let j = keccakf_piln.(i) in 91 | bc.(0) <- q.(j) ; 92 | q.(j) <- Int64.rol64 !t rotc ; 93 | t := bc.(0)) 94 | keccaft_rotc in 95 | 96 | (* Chi *) 97 | for k = 0 to 4 do 98 | let j = k * 5 in 99 | let bc = Array.init 5 (fun i -> q.(j + i)) in 100 | for i = 0 to 4 do 101 | q.(j + i) <- 102 | q.(j + i) lxor (lnot bc.((i + 1) mod 5) land bc.((i + 2) mod 5)) 103 | done 104 | done ; 105 | 106 | (* Iota *) 107 | q.(0) <- q.(0) lxor keccaft_rndc.(r) 108 | done 109 | 110 | let masks = 111 | [| 112 | 0xffffffffffffff00L; 0xffffffffffff00ffL; 0xffffffffff00ffffL; 113 | 0xffffffff00ffffffL; 0xffffff00ffffffffL; 0xffff00ffffffffffL; 114 | 0xff00ffffffffffffL; 0x00ffffffffffffffL; 115 | |] 116 | 117 | let feed : 118 | type a. get_uint8:(a -> int -> int) -> ctx -> a -> int -> int -> unit = 119 | fun ~get_uint8 ctx buf off len -> 120 | let ( && ) = ( land ) in 121 | 122 | let ( lxor ) = Int64.( lxor ) in 123 | let ( land ) = Int64.( land ) in 124 | let ( lor ) = Int64.( lor ) in 125 | let ( lsr ) = Int64.( lsr ) in 126 | let ( lsl ) = Int64.( lsl ) in 127 | 128 | let j = ref ctx.pt in 129 | 130 | for i = 0 to len - 1 do 131 | let v = 132 | (ctx.q.(!j / 8) land (0xffL lsl ((!j && 0x7) * 8))) lsr ((!j && 0x7) * 8) 133 | in 134 | let v = v lxor Int64.of_int (get_uint8 buf (off + i)) in 135 | ctx.q.(!j / 8) <- 136 | ctx.q.(!j / 8) land masks.(!j && 0x7) lor (v lsl ((!j && 0x7) * 8)) ; 137 | incr j ; 138 | if !j >= ctx.rsize 139 | then ( 140 | sha3_keccakf ctx.q ; 141 | j := 0) 142 | done ; 143 | 144 | ctx.pt <- !j 145 | 146 | let unsafe_feed_bytes ctx buf off len = 147 | let get_uint8 buf off = Char.code (By.get buf off) in 148 | feed ~get_uint8 ctx buf off len 149 | 150 | let unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit = 151 | fun ctx buf off len -> 152 | let get_uint8 buf off = Char.code (Bi.get buf off) in 153 | feed ~get_uint8 ctx buf off len 154 | 155 | let unsafe_get ctx = 156 | let ( && ) = ( land ) in 157 | 158 | let ( lxor ) = Int64.( lxor ) in 159 | let ( lsl ) = Int64.( lsl ) in 160 | 161 | let v = ctx.q.(ctx.pt / 8) in 162 | let v = v lxor (P.padding lsl ((ctx.pt && 0x7) * 8)) in 163 | ctx.q.(ctx.pt / 8) <- v ; 164 | 165 | let v = ctx.q.((ctx.rsize - 1) / 8) in 166 | let v = v lxor (0x80L lsl (((ctx.rsize - 1) && 0x7) * 8)) in 167 | ctx.q.((ctx.rsize - 1) / 8) <- v ; 168 | 169 | sha3_keccakf ctx.q ; 170 | 171 | (* Get hash *) 172 | (* if the hash size in bytes is not a multiple of 8 (meaning it is 173 | not composed of whole int64 words, like for sha3_224), we 174 | extract the whole last int64 word from the state [ctx.st] and 175 | cut the hash at the right size after conversion to bytes. *) 176 | let n = 177 | let r = ctx.mdlen mod 8 in 178 | ctx.mdlen + if r = 0 then 0 else 8 - r in 179 | 180 | let hash = By.create n in 181 | for i = 0 to (n / 8) - 1 do 182 | By.unsafe_set_64 hash (i * 8) 183 | (if Sys.big_endian then By.swap64 ctx.q.(i) else ctx.q.(i)) 184 | done ; 185 | 186 | By.sub hash 0 ctx.mdlen 187 | end 188 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_sha384.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module type S = sig 5 | type ctx 6 | type kind = [ `SHA384 ] 7 | 8 | val init : unit -> ctx 9 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 10 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 11 | val unsafe_get : ctx -> By.t 12 | val dup : ctx -> ctx 13 | end 14 | 15 | module Unsafe : S = struct 16 | type kind = [ `SHA384 ] 17 | 18 | open Baijiu_sha512.Unsafe 19 | 20 | type nonrec ctx = ctx 21 | 22 | let init () = 23 | let b = By.make 128 '\x00' in 24 | { 25 | size = [| 0L; 0L |]; 26 | b; 27 | h = 28 | [| 29 | 0xcbbb9d5dc1059ed8L; 0x629a292a367cd507L; 0x9159015a3070dd17L; 30 | 0x152fecd8f70e5939L; 0x67332667ffc00b31L; 0x8eb44a8768581511L; 31 | 0xdb0c2e0d64f98fa7L; 0x47b5481dbefa4fa4L; 32 | |]; 33 | } 34 | 35 | let unsafe_get ctx = 36 | let res = unsafe_get ctx in 37 | By.sub res 0 48 38 | 39 | let dup = dup 40 | let unsafe_feed_bytes = unsafe_feed_bytes 41 | let unsafe_feed_bigstring = unsafe_feed_bigstring 42 | end 43 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_sha3_224.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module type S = sig 5 | type ctx 6 | type kind = [ `SHA3_224 ] 7 | 8 | val init : unit -> ctx 9 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 10 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 11 | val unsafe_get : ctx -> By.t 12 | val dup : ctx -> ctx 13 | end 14 | 15 | module Unsafe : S = struct 16 | type kind = [ `SHA3_224 ] 17 | 18 | module U = Baijiu_sha3.Unsafe (struct 19 | let padding = Baijiu_sha3.nist_padding 20 | end) 21 | 22 | open U 23 | 24 | type nonrec ctx = ctx 25 | 26 | let init () = U.init 28 27 | let unsafe_get = unsafe_get 28 | let dup = dup 29 | let unsafe_feed_bytes = unsafe_feed_bytes 30 | let unsafe_feed_bigstring = unsafe_feed_bigstring 31 | end 32 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_sha3_256.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module type S = sig 5 | type ctx 6 | type kind = [ `SHA3_256 ] 7 | 8 | val init : unit -> ctx 9 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 10 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 11 | val unsafe_get : ctx -> By.t 12 | val dup : ctx -> ctx 13 | end 14 | 15 | module Unsafe : S = struct 16 | type kind = [ `SHA3_256 ] 17 | 18 | module U = Baijiu_sha3.Unsafe (struct 19 | let padding = Baijiu_sha3.nist_padding 20 | end) 21 | 22 | open U 23 | 24 | type nonrec ctx = ctx 25 | 26 | let init () = U.init 32 27 | let unsafe_get = unsafe_get 28 | let dup = dup 29 | let unsafe_feed_bytes = unsafe_feed_bytes 30 | let unsafe_feed_bigstring = unsafe_feed_bigstring 31 | end 32 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_sha3_384.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module type S = sig 5 | type ctx 6 | type kind = [ `SHA3_384 ] 7 | 8 | val init : unit -> ctx 9 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 10 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 11 | val unsafe_get : ctx -> By.t 12 | val dup : ctx -> ctx 13 | end 14 | 15 | module Unsafe : S = struct 16 | type kind = [ `SHA3_384 ] 17 | 18 | module U = Baijiu_sha3.Unsafe (struct 19 | let padding = Baijiu_sha3.nist_padding 20 | end) 21 | 22 | open U 23 | 24 | type nonrec ctx = ctx 25 | 26 | let init () = U.init 48 27 | let unsafe_get = unsafe_get 28 | let dup = dup 29 | let unsafe_feed_bytes = unsafe_feed_bytes 30 | let unsafe_feed_bigstring = unsafe_feed_bigstring 31 | end 32 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_sha3_512.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module type S = sig 5 | type ctx 6 | type kind = [ `SHA3_512 ] 7 | 8 | val init : unit -> ctx 9 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 10 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 11 | val unsafe_get : ctx -> By.t 12 | val dup : ctx -> ctx 13 | end 14 | 15 | module Unsafe : S = struct 16 | type kind = [ `SHA3_512 ] 17 | 18 | module U = Baijiu_sha3.Unsafe (struct 19 | let padding = Baijiu_sha3.nist_padding 20 | end) 21 | 22 | open U 23 | 24 | type nonrec ctx = ctx 25 | 26 | let init () = U.init 64 27 | let unsafe_get = unsafe_get 28 | let dup = dup 29 | let unsafe_feed_bytes = unsafe_feed_bytes 30 | let unsafe_feed_bigstring = unsafe_feed_bigstring 31 | end 32 | -------------------------------------------------------------------------------- /src-ocaml/baijiu_sha512.ml: -------------------------------------------------------------------------------- 1 | module By = Digestif_by 2 | module Bi = Digestif_bi 3 | 4 | module Int64 = struct 5 | include Int64 6 | 7 | let ( lsl ) = Int64.shift_left 8 | let ( lsr ) = Int64.shift_right_logical 9 | let ( asr ) = Int64.shift_right 10 | let ( lor ) = Int64.logor 11 | let ( land ) = Int64.logand 12 | let ( lxor ) = Int64.logxor 13 | let ( + ) = Int64.add 14 | let ror64 a n = (a lsr n) lor (a lsl (64 - n)) 15 | let rol64 a n = (a lsl n) lor (a lsr (64 - n)) 16 | end 17 | 18 | module type S = sig 19 | type kind = [ `SHA512 ] 20 | type ctx = { mutable size : int64 array; b : Bytes.t; h : int64 array } 21 | 22 | val init : unit -> ctx 23 | val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit 24 | val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit 25 | val unsafe_get : ctx -> By.t 26 | val dup : ctx -> ctx 27 | end 28 | 29 | module Unsafe : S = struct 30 | type kind = [ `SHA512 ] 31 | type ctx = { mutable size : int64 array; b : Bytes.t; h : int64 array } 32 | 33 | let dup ctx = 34 | { size = Array.copy ctx.size; b = By.copy ctx.b; h = Array.copy ctx.h } 35 | 36 | let init () = 37 | let b = By.make 128 '\x00' in 38 | { 39 | size = [| 0L; 0L |]; 40 | b; 41 | h = 42 | [| 43 | 0x6a09e667f3bcc908L; 0xbb67ae8584caa73bL; 0x3c6ef372fe94f82bL; 44 | 0xa54ff53a5f1d36f1L; 0x510e527fade682d1L; 0x9b05688c2b3e6c1fL; 45 | 0x1f83d9abfb41bd6bL; 0x5be0cd19137e2179L; 46 | |]; 47 | } 48 | 49 | let k = 50 | [| 51 | 0x428a2f98d728ae22L; 0x7137449123ef65cdL; 0xb5c0fbcfec4d3b2fL; 52 | 0xe9b5dba58189dbbcL; 0x3956c25bf348b538L; 0x59f111f1b605d019L; 53 | 0x923f82a4af194f9bL; 0xab1c5ed5da6d8118L; 0xd807aa98a3030242L; 54 | 0x12835b0145706fbeL; 0x243185be4ee4b28cL; 0x550c7dc3d5ffb4e2L; 55 | 0x72be5d74f27b896fL; 0x80deb1fe3b1696b1L; 0x9bdc06a725c71235L; 56 | 0xc19bf174cf692694L; 0xe49b69c19ef14ad2L; 0xefbe4786384f25e3L; 57 | 0x0fc19dc68b8cd5b5L; 0x240ca1cc77ac9c65L; 0x2de92c6f592b0275L; 58 | 0x4a7484aa6ea6e483L; 0x5cb0a9dcbd41fbd4L; 0x76f988da831153b5L; 59 | 0x983e5152ee66dfabL; 0xa831c66d2db43210L; 0xb00327c898fb213fL; 60 | 0xbf597fc7beef0ee4L; 0xc6e00bf33da88fc2L; 0xd5a79147930aa725L; 61 | 0x06ca6351e003826fL; 0x142929670a0e6e70L; 0x27b70a8546d22ffcL; 62 | 0x2e1b21385c26c926L; 0x4d2c6dfc5ac42aedL; 0x53380d139d95b3dfL; 63 | 0x650a73548baf63deL; 0x766a0abb3c77b2a8L; 0x81c2c92e47edaee6L; 64 | 0x92722c851482353bL; 0xa2bfe8a14cf10364L; 0xa81a664bbc423001L; 65 | 0xc24b8b70d0f89791L; 0xc76c51a30654be30L; 0xd192e819d6ef5218L; 66 | 0xd69906245565a910L; 0xf40e35855771202aL; 0x106aa07032bbd1b8L; 67 | 0x19a4c116b8d2d0c8L; 0x1e376c085141ab53L; 0x2748774cdf8eeb99L; 68 | 0x34b0bcb5e19b48a8L; 0x391c0cb3c5c95a63L; 0x4ed8aa4ae3418acbL; 69 | 0x5b9cca4f7763e373L; 0x682e6ff3d6b2b8a3L; 0x748f82ee5defb2fcL; 70 | 0x78a5636f43172f60L; 0x84c87814a1f0ab72L; 0x8cc702081a6439ecL; 71 | 0x90befffa23631e28L; 0xa4506cebde82bde9L; 0xbef9a3f7b2c67915L; 72 | 0xc67178f2e372532bL; 0xca273eceea26619cL; 0xd186b8c721c0c207L; 73 | 0xeada7dd6cde0eb1eL; 0xf57d4f7fee6ed178L; 0x06f067aa72176fbaL; 74 | 0x0a637dc5a2c898a6L; 0x113f9804bef90daeL; 0x1b710b35131c471bL; 75 | 0x28db77f523047d84L; 0x32caab7b40c72493L; 0x3c9ebe0a15c9bebcL; 76 | 0x431d67c49c100d4cL; 0x4cc5d4becb3e42b6L; 0x597f299cfc657e2aL; 77 | 0x5fcb6fab3ad6faecL; 0x6c44198c4a475817L; 78 | |] 79 | 80 | let e0 x = Int64.(ror64 x 28 lxor ror64 x 34 lxor ror64 x 39) 81 | let e1 x = Int64.(ror64 x 14 lxor ror64 x 18 lxor ror64 x 41) 82 | let s0 x = Int64.(ror64 x 1 lxor ror64 x 8 lxor (x lsr 7)) 83 | let s1 x = Int64.(ror64 x 19 lxor ror64 x 61 lxor (x lsr 6)) 84 | 85 | let sha512_do_chunk : 86 | type a. be64_to_cpu:(a -> int -> int64) -> ctx -> a -> int -> unit = 87 | fun ~be64_to_cpu ctx buf off -> 88 | let a, b, c, d, e, f, g, h, t1, t2 = 89 | ( ref ctx.h.(0), 90 | ref ctx.h.(1), 91 | ref ctx.h.(2), 92 | ref ctx.h.(3), 93 | ref ctx.h.(4), 94 | ref ctx.h.(5), 95 | ref ctx.h.(6), 96 | ref ctx.h.(7), 97 | ref 0L, 98 | ref 0L ) in 99 | let w = Array.make 80 0L in 100 | for i = 0 to 15 do 101 | w.(i) <- be64_to_cpu buf (off + (i * 8)) 102 | done ; 103 | let ( -- ) a b = a - b in 104 | for i = 16 to 79 do 105 | w.(i) <- Int64.(s1 w.(i -- 2) + w.(i -- 7) + s0 w.(i -- 15) + w.(i -- 16)) 106 | done ; 107 | let round a b c d e f g h k w = 108 | let open Int64 in 109 | t1 := !h + e1 !e + (!g lxor (!e land (!f lxor !g))) + k + w ; 110 | t2 := e0 !a + (!a land !b lor (!c land (!a lor !b))) ; 111 | d := !d + !t1 ; 112 | h := !t1 + !t2 in 113 | for i = 0 to 9 do 114 | round a b c d e f g h k.((i * 8) + 0) w.((i * 8) + 0) ; 115 | round h a b c d e f g k.((i * 8) + 1) w.((i * 8) + 1) ; 116 | round g h a b c d e f k.((i * 8) + 2) w.((i * 8) + 2) ; 117 | round f g h a b c d e k.((i * 8) + 3) w.((i * 8) + 3) ; 118 | round e f g h a b c d k.((i * 8) + 4) w.((i * 8) + 4) ; 119 | round d e f g h a b c k.((i * 8) + 5) w.((i * 8) + 5) ; 120 | round c d e f g h a b k.((i * 8) + 6) w.((i * 8) + 6) ; 121 | round b c d e f g h a k.((i * 8) + 7) w.((i * 8) + 7) 122 | done ; 123 | let open Int64 in 124 | ctx.h.(0) <- ctx.h.(0) + !a ; 125 | ctx.h.(1) <- ctx.h.(1) + !b ; 126 | ctx.h.(2) <- ctx.h.(2) + !c ; 127 | ctx.h.(3) <- ctx.h.(3) + !d ; 128 | ctx.h.(4) <- ctx.h.(4) + !e ; 129 | ctx.h.(5) <- ctx.h.(5) + !f ; 130 | ctx.h.(6) <- ctx.h.(6) + !g ; 131 | ctx.h.(7) <- ctx.h.(7) + !h ; 132 | () 133 | 134 | let feed : 135 | type a. 136 | blit:(a -> int -> By.t -> int -> int -> unit) -> 137 | be64_to_cpu:(a -> int -> int64) -> 138 | ctx -> 139 | a -> 140 | int -> 141 | int -> 142 | unit = 143 | fun ~blit ~be64_to_cpu ctx buf off len -> 144 | let idx = ref Int64.(to_int (ctx.size.(0) land 0x7FL)) in 145 | let len = ref len in 146 | let off = ref off in 147 | let to_fill = 128 - !idx in 148 | ctx.size.(0) <- Int64.add ctx.size.(0) (Int64.of_int !len) ; 149 | if ctx.size.(0) < Int64.of_int !len 150 | then ctx.size.(1) <- Int64.succ ctx.size.(1) ; 151 | if !idx <> 0 && !len >= to_fill 152 | then ( 153 | blit buf !off ctx.b !idx to_fill ; 154 | sha512_do_chunk ~be64_to_cpu:By.be64_to_cpu ctx ctx.b 0 ; 155 | len := !len - to_fill ; 156 | off := !off + to_fill ; 157 | idx := 0) ; 158 | while !len >= 128 do 159 | sha512_do_chunk ~be64_to_cpu ctx buf !off ; 160 | len := !len - 128 ; 161 | off := !off + 128 162 | done ; 163 | if !len <> 0 then blit buf !off ctx.b !idx !len ; 164 | () 165 | 166 | let unsafe_feed_bytes = feed ~blit:By.blit ~be64_to_cpu:By.be64_to_cpu 167 | 168 | let unsafe_feed_bigstring = 169 | feed ~blit:By.blit_from_bigstring ~be64_to_cpu:Bi.be64_to_cpu 170 | 171 | let unsafe_get ctx = 172 | let index = Int64.(to_int (ctx.size.(0) land 0x7FL)) in 173 | let padlen = if index < 112 then 112 - index else 128 + 112 - index in 174 | let padding = By.init padlen (function 0 -> '\x80' | _ -> '\x00') in 175 | let bits = By.create 16 in 176 | By.cpu_to_be64 bits 0 Int64.((ctx.size.(1) lsl 3) lor (ctx.size.(0) lsr 61)) ; 177 | By.cpu_to_be64 bits 8 Int64.(ctx.size.(0) lsl 3) ; 178 | unsafe_feed_bytes ctx padding 0 padlen ; 179 | unsafe_feed_bytes ctx bits 0 16 ; 180 | let res = By.create (8 * 8) in 181 | for i = 0 to 7 do 182 | By.cpu_to_be64 res (i * 8) ctx.h.(i) 183 | done ; 184 | res 185 | end 186 | -------------------------------------------------------------------------------- /src-ocaml/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name digestif_ocaml) 3 | (public_name digestif.ocaml) 4 | (implements digestif) 5 | (libraries eqaf) 6 | (private_modules xor digestif_eq digestif_conv digestif_by digestif_bi 7 | baijiu_whirlpool baijiu_sha1 baijiu_sha256 baijiu_sha384 baijiu_sha224 8 | baijiu_sha512 baijiu_sha3_224 baijiu_sha256 baijiu_sha3_384 9 | baijiu_sha3_512 baijiu_rmd160 baijiu_md5 baijiu_blake2s baijiu_blake2b) 10 | (flags 11 | (:standard -no-keep-locs))) 12 | 13 | (copy_files# ../src/*.ml) 14 | -------------------------------------------------------------------------------- /src-ocaml/xor.ml: -------------------------------------------------------------------------------- 1 | module Nat = struct 2 | include Nativeint 3 | 4 | let ( lxor ) = Nativeint.logxor 5 | end 6 | 7 | module type BUFFER = sig 8 | type t 9 | 10 | val length : t -> int 11 | val sub : t -> int -> int -> t 12 | val copy : t -> t 13 | val benat_to_cpu : t -> int -> nativeint 14 | val cpu_to_benat : t -> int -> nativeint -> unit 15 | end 16 | 17 | let imin (a : int) (b : int) = if a < b then a else b 18 | 19 | module Make (B : BUFFER) = struct 20 | let size_of_long = Sys.word_size / 8 21 | 22 | (* XXX(dinosaure): I'm not sure about this code. May be we don't need the 23 | first loop and the _optimization_ is irrelevant. *) 24 | let xor_into src src_off dst dst_off n = 25 | let n = ref n in 26 | let i = ref 0 in 27 | while !n >= size_of_long do 28 | B.cpu_to_benat dst (dst_off + !i) 29 | Nat.( 30 | B.benat_to_cpu dst (dst_off + !i) 31 | lxor B.benat_to_cpu src (src_off + !i)) ; 32 | n := !n - size_of_long ; 33 | i := !i + size_of_long 34 | done ; 35 | while !n > 0 do 36 | B.cpu_to_benat dst (dst_off + !i) 37 | Nat.( 38 | B.benat_to_cpu src (src_off + !i) 39 | lxor B.benat_to_cpu dst (dst_off + !i)) ; 40 | incr i ; 41 | decr n 42 | done 43 | 44 | let xor_into a b n = 45 | if n > imin (B.length a) (B.length b) 46 | then raise (Invalid_argument "Baijiu.Xor.xor_inrot: buffers to small") 47 | else xor_into a 0 b 0 n 48 | 49 | let xor a b = 50 | let l = imin (B.length a) (B.length b) in 51 | let r = B.copy (B.sub b 0 l) in 52 | xor_into a r l ; 53 | r 54 | end 55 | 56 | module Bytes = Make (Digestif_by) 57 | module Bigstring = Make (Digestif_bi) 58 | -------------------------------------------------------------------------------- /src/digestif_bi.ml: -------------------------------------------------------------------------------- 1 | open Bigarray 2 | 3 | type t = (char, int8_unsigned_elt, c_layout) Array1.t 4 | 5 | let create n = Array1.create Char c_layout n 6 | let length = Array1.dim 7 | let sub = Array1.sub 8 | let empty = Array1.create Char c_layout 0 9 | let get = Array1.get 10 | 11 | let copy t = 12 | let r = create (length t) in 13 | Array1.blit t r ; 14 | r 15 | 16 | let init l f = 17 | let v = Array1.create Char c_layout l in 18 | for i = 0 to l - 1 do 19 | Array1.set v i (f i) 20 | done ; 21 | v 22 | 23 | external unsafe_get_32 : t -> int -> int32 = "%caml_bigstring_get32u" 24 | external unsafe_get_64 : t -> int -> int64 = "%caml_bigstring_get64u" 25 | 26 | let unsafe_get_nat : t -> int -> nativeint = 27 | fun s i -> 28 | if Sys.word_size = 32 29 | then Nativeint.of_int32 @@ unsafe_get_32 s i 30 | else Int64.to_nativeint @@ unsafe_get_64 s i 31 | 32 | external unsafe_set_32 : t -> int -> int32 -> unit = "%caml_bigstring_set32u" 33 | external unsafe_set_64 : t -> int -> int64 -> unit = "%caml_bigstring_set64u" 34 | 35 | let unsafe_set_nat : t -> int -> nativeint -> unit = 36 | fun s i v -> 37 | if Sys.word_size = 32 38 | then unsafe_set_32 s i (Nativeint.to_int32 v) 39 | else unsafe_set_64 s i (Int64.of_nativeint v) 40 | 41 | let to_string v = String.init (length v) (Array1.get v) 42 | 43 | let blit_from_bytes src src_off dst dst_off len = 44 | for i = 0 to len - 1 do 45 | Array1.set dst (dst_off + i) (Bytes.get src (src_off + i)) 46 | done 47 | 48 | external swap32 : int32 -> int32 = "%bswap_int32" 49 | external swap64 : int64 -> int64 = "%bswap_int64" 50 | external swapnat : nativeint -> nativeint = "%bswap_native" 51 | 52 | let cpu_to_be32 s i v = 53 | if Sys.big_endian then unsafe_set_32 s i v else unsafe_set_32 s i (swap32 v) 54 | 55 | let cpu_to_le32 s i v = 56 | if Sys.big_endian then unsafe_set_32 s i (swap32 v) else unsafe_set_32 s i v 57 | 58 | let cpu_to_be64 s i v = 59 | if Sys.big_endian then unsafe_set_64 s i v else unsafe_set_64 s i (swap64 v) 60 | 61 | let cpu_to_le64 s i v = 62 | if Sys.big_endian then unsafe_set_64 s i (swap64 v) else unsafe_set_64 s i v 63 | 64 | let be32_to_cpu s i = 65 | if Sys.big_endian then unsafe_get_32 s i else swap32 @@ unsafe_get_32 s i 66 | 67 | let le32_to_cpu s i = 68 | if Sys.big_endian then swap32 @@ unsafe_get_32 s i else unsafe_get_32 s i 69 | 70 | let be64_to_cpu s i = 71 | if Sys.big_endian then unsafe_get_64 s i else swap64 @@ unsafe_get_64 s i 72 | 73 | let le64_to_cpu s i = 74 | if Sys.big_endian then swap64 @@ unsafe_get_64 s i else unsafe_get_64 s i 75 | 76 | let benat_to_cpu s i = 77 | if Sys.big_endian then unsafe_get_nat s i else swapnat @@ unsafe_get_nat s i 78 | 79 | let cpu_to_benat s i v = 80 | if Sys.big_endian 81 | then unsafe_set_nat s i v 82 | else unsafe_set_nat s i (swapnat v) 83 | -------------------------------------------------------------------------------- /src/digestif_by.ml: -------------------------------------------------------------------------------- 1 | include Bytes 2 | 3 | external unsafe_get_32 : t -> int -> int32 = "%caml_bytes_get32u" 4 | external unsafe_get_64 : t -> int -> int64 = "%caml_bytes_get64u" 5 | 6 | let unsafe_get_nat : t -> int -> nativeint = 7 | fun s i -> 8 | if Sys.word_size = 32 9 | then Nativeint.of_int32 @@ unsafe_get_32 s i 10 | else Int64.to_nativeint @@ unsafe_get_64 s i 11 | 12 | external unsafe_set_32 : t -> int -> int32 -> unit = "%caml_bytes_set32u" 13 | external unsafe_set_64 : t -> int -> int64 -> unit = "%caml_bytes_set64u" 14 | 15 | let unsafe_set_nat : t -> int -> nativeint -> unit = 16 | fun s i v -> 17 | if Sys.word_size = 32 18 | then unsafe_set_32 s i (Nativeint.to_int32 v) 19 | else unsafe_set_64 s i (Int64.of_nativeint v) 20 | 21 | let blit_from_bigstring src src_off dst dst_off len = 22 | for i = 0 to len - 1 do 23 | set dst (dst_off + i) src.{src_off + i} 24 | done 25 | 26 | let rpad a size x = 27 | let l = length a in 28 | let b = create size in 29 | blit a 0 b 0 l ; 30 | fill b l (size - l) x ; 31 | b 32 | 33 | external swap32 : int32 -> int32 = "%bswap_int32" 34 | external swap64 : int64 -> int64 = "%bswap_int64" 35 | external swapnat : nativeint -> nativeint = "%bswap_native" 36 | 37 | let cpu_to_be32 s i v = 38 | if Sys.big_endian then unsafe_set_32 s i v else unsafe_set_32 s i (swap32 v) 39 | 40 | let cpu_to_le32 s i v = 41 | if Sys.big_endian then unsafe_set_32 s i (swap32 v) else unsafe_set_32 s i v 42 | 43 | let cpu_to_be64 s i v = 44 | if Sys.big_endian then unsafe_set_64 s i v else unsafe_set_64 s i (swap64 v) 45 | 46 | let cpu_to_le64 s i v = 47 | if Sys.big_endian then unsafe_set_64 s i (swap64 v) else unsafe_set_64 s i v 48 | 49 | let be32_to_cpu s i = 50 | if Sys.big_endian then unsafe_get_32 s i else swap32 @@ unsafe_get_32 s i 51 | 52 | let le32_to_cpu s i = 53 | if Sys.big_endian then swap32 @@ unsafe_get_32 s i else unsafe_get_32 s i 54 | 55 | let be64_to_cpu s i = 56 | if Sys.big_endian then unsafe_get_64 s i else swap64 @@ unsafe_get_64 s i 57 | 58 | let le64_to_cpu s i = 59 | if Sys.big_endian then swap64 @@ unsafe_get_64 s i else unsafe_get_64 s i 60 | 61 | let benat_to_cpu s i = 62 | if Sys.big_endian then unsafe_get_nat s i else swapnat @@ unsafe_get_nat s i 63 | 64 | let cpu_to_benat s i v = 65 | if Sys.big_endian 66 | then unsafe_set_nat s i v 67 | else unsafe_set_nat s i (swapnat v) 68 | -------------------------------------------------------------------------------- /src/digestif_conv.ml: -------------------------------------------------------------------------------- 1 | let invalid_arg fmt = Format.ksprintf (fun s -> invalid_arg s) fmt 2 | 3 | module Make (D : sig 4 | val digest_size : int 5 | end) = 6 | struct 7 | let to_hex hash = 8 | let res = Bytes.create (D.digest_size * 2) in 9 | let chr x = 10 | match x with 11 | | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 -> Char.chr (48 + x) 12 | | _ -> Char.chr (97 + (x - 10)) in 13 | for i = 0 to D.digest_size - 1 do 14 | let v = Char.code hash.[i] in 15 | Bytes.unsafe_set res (i * 2) (chr (v lsr 4)) ; 16 | Bytes.unsafe_set res ((i * 2) + 1) (chr (v land 0x0F)) 17 | done ; 18 | Bytes.unsafe_to_string res 19 | 20 | let code x = 21 | match x with 22 | | '0' .. '9' -> Char.code x - Char.code '0' 23 | | 'A' .. 'F' -> Char.code x - Char.code 'A' + 10 24 | | 'a' .. 'f' -> Char.code x - Char.code 'a' + 10 25 | | _ -> invalid_arg "of_hex: %02X" (Char.code x) 26 | 27 | let decode chr1 chr2 = Char.chr ((code chr1 lsl 4) lor code chr2) 28 | 29 | let of_hex hex = 30 | let offset = ref 0 in 31 | let rec go have_first idx = 32 | if !offset + idx >= String.length hex 33 | then '\x00' 34 | else 35 | match hex.[!offset + idx] with 36 | | ' ' | '\t' | '\r' | '\n' -> 37 | incr offset ; 38 | go have_first idx 39 | | chr2 when have_first -> chr2 40 | | chr1 -> 41 | incr offset ; 42 | let chr2 = go true idx in 43 | if chr2 <> '\x00' 44 | then decode chr1 chr2 45 | else invalid_arg "of_hex: odd number of hex characters" in 46 | String.init D.digest_size (go false) 47 | 48 | let of_hex_opt hex = 49 | match of_hex hex with 50 | | digest -> Some digest 51 | | exception Invalid_argument _ -> None 52 | 53 | let consistent_of_hex str = 54 | let offset = ref 0 in 55 | let rec go have_first idx = 56 | if !offset + idx >= String.length str 57 | then invalid_arg "Not enough hex value" 58 | else 59 | match str.[!offset + idx] with 60 | | ' ' | '\t' | '\r' | '\n' -> 61 | incr offset ; 62 | go have_first idx 63 | | chr2 when have_first -> chr2 64 | | chr1 -> 65 | incr offset ; 66 | let chr2 = go true idx in 67 | decode chr1 chr2 in 68 | let res = String.init D.digest_size (go false) in 69 | let is_wsp = function ' ' | '\t' | '\r' | '\n' -> true | _ -> false in 70 | while 71 | D.digest_size + !offset < String.length str 72 | && is_wsp str.[!offset + (D.digest_size * 2)] 73 | do 74 | incr offset 75 | done ; 76 | if !offset + D.digest_size = String.length str 77 | then res 78 | else 79 | invalid_arg "Too much enough bytes (reach: %d, expect: %d)" 80 | (!offset + (D.digest_size * 2)) 81 | (String.length str) 82 | 83 | let consistent_of_hex_opt hex = 84 | match consistent_of_hex hex with 85 | | digest -> Some digest 86 | | exception Invalid_argument _ -> None 87 | 88 | let pp ppf hash = 89 | for i = 0 to D.digest_size - 1 do 90 | Format.fprintf ppf "%02x" (Char.code hash.[i]) 91 | done 92 | 93 | let of_raw_string x = 94 | if String.length x <> D.digest_size 95 | then invalid_arg "invalid hash size" 96 | else x 97 | 98 | let of_raw_string_opt x = 99 | match of_raw_string x with 100 | | digest -> Some digest 101 | | exception Invalid_argument _ -> None 102 | 103 | let to_raw_string x = x 104 | end 105 | -------------------------------------------------------------------------------- /src/digestif_eq.ml: -------------------------------------------------------------------------------- 1 | module Make (D : sig 2 | val digest_size : int 3 | end) = 4 | struct 5 | let _ = D.digest_size 6 | let equal a b = Eqaf.equal a b 7 | let unsafe_compare a b = String.compare a b 8 | end 9 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name digestif) 3 | (public_name digestif) 4 | (modules digestif) 5 | (wrapped false) 6 | (virtual_modules digestif) 7 | (default_implementation digestif.c) 8 | (libraries eqaf)) 9 | -------------------------------------------------------------------------------- /test/c/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (modules test) 4 | (libraries fmt alcotest digestif.c)) 5 | 6 | (rule 7 | (alias runtest) 8 | (deps 9 | (:test test.exe) 10 | ../blake2b.test 11 | ../blake2s.test 12 | ../sha3_224_fips_202.txt 13 | ../sha3_256_fips_202.txt 14 | ../sha3_384_fips_202.txt 15 | ../sha3_512_fips_202.txt 16 | ../keccak_256.txt) 17 | (action 18 | (run %{test} --color=always))) 19 | 20 | (executable 21 | (name test_cve) 22 | (modules test_cve) 23 | (enabled_if 24 | (or 25 | (= %{architecture} "arm64") 26 | (= %{architecture} "amd64"))) 27 | (libraries fmt alcotest digestif.c)) 28 | 29 | (rule 30 | (alias runtest) 31 | (enabled_if 32 | (or 33 | (= %{architecture} "arm64") 34 | (= %{architecture} "amd64"))) 35 | (deps 36 | (:test test_cve.exe)) 37 | (action 38 | (run %{test} --quick-tests --color=always))) 39 | 40 | (rule 41 | (copy# ../test.ml test.ml)) 42 | 43 | (rule 44 | (copy# ../test_cve.ml test_cve.ml)) 45 | -------------------------------------------------------------------------------- /test/conv/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test_conv) 3 | (modules test_conv) 4 | (libraries digestif.c fmt alcotest)) 5 | 6 | (rule 7 | (alias runtest) 8 | (enabled_if 9 | (= ${os_type} "Unix")) 10 | (action 11 | (run ./test_conv.exe --color=always))) 12 | -------------------------------------------------------------------------------- /test/conv/test_conv.ml: -------------------------------------------------------------------------------- 1 | external random_seed : unit -> int array = "caml_sys_random_seed" 2 | 3 | let seed = random_seed () 4 | let () = Random.full_init seed 5 | let () = Fmt.epr "seed: %a.\n%!" Fmt.(Dump.array int) seed 6 | let strf = Fmt.str 7 | let invalid_arg = Fmt.invalid_arg 8 | 9 | let list_init f l = 10 | let rec go acc = function 11 | | 0 -> List.rev acc 12 | | n -> go (f n :: acc) (pred n) in 13 | go [] l 14 | 15 | let random_string length _ = 16 | let ic = open_in_bin "/dev/urandom" in 17 | let rs = really_input_string ic length in 18 | close_in ic ; 19 | rs 20 | 21 | let hashes = list_init (random_string Digestif.SHA1.digest_size) 32 22 | let hashes = List.map Digestif.SHA1.of_raw_string hashes 23 | 24 | let consistent_hex = 25 | List.map Digestif.SHA1.to_hex (* XXX(dinosaure): an oracle [to_hex]? *) hashes 26 | 27 | let random_wsp length = 28 | let go _ = 29 | match Random.int 4 with 30 | | 0 -> ' ' 31 | | 1 -> '\t' 32 | | 2 -> '\n' 33 | | 3 -> '\r' 34 | | _ -> assert false in 35 | String.init length go 36 | 37 | let spaces_expand hex = 38 | let rt = ref [] in 39 | String.iter 40 | (fun chr -> rt := !rt @ [ random_wsp (Random.int 10); String.make 1 chr ]) 41 | hex ; 42 | String.concat "" !rt 43 | 44 | let spaces_hex = List.map spaces_expand consistent_hex 45 | 46 | let random_hex length = 47 | let go _ = 48 | match Random.int (10 + 26 + 26) with 49 | | n when n < 10 -> Char.chr (Char.code '0' + n) 50 | | n when n < 10 + 26 -> Char.chr (Char.code 'a' + n - 10) 51 | | n -> Char.chr (Char.code 'A' + n - (10 + 26)) in 52 | String.init length go 53 | 54 | let inconsistent_hex = 55 | let expand hex = 56 | String.concat "" 57 | [ spaces_expand hex; spaces_expand (random_hex (5 + Random.int 20)) ] 58 | in 59 | List.map expand consistent_hex 60 | 61 | let test_consistent_hex_success i hex = 62 | Alcotest.test_case (strf "consistent hex:%d" i) `Quick @@ fun () -> 63 | ignore @@ Digestif.SHA1.consistent_of_hex hex 64 | 65 | let test_hex_success i hex = 66 | Alcotest.test_case (strf "hex:%d" i) `Quick @@ fun () -> 67 | ignore @@ Digestif.SHA1.of_hex hex 68 | 69 | let test_consistent_hex_fail i hex = 70 | Alcotest.test_case (strf "consistent hex fail:%d" i) `Quick @@ fun () -> 71 | try 72 | let _ = Digestif.SHA1.consistent_of_hex hex in 73 | assert false 74 | with Invalid_argument _ -> () 75 | 76 | let sha1 = Alcotest.testable Digestif.SHA1.pp Digestif.SHA1.equal 77 | 78 | let test_hex_iso i random_input = 79 | Alcotest.test_case (strf "iso:%d" i) `Quick @@ fun () -> 80 | let hash : Digestif.SHA1.t = Digestif.SHA1.of_raw_string random_input in 81 | let hex = Digestif.SHA1.to_hex hash in 82 | Alcotest.(check sha1) "iso hex" (Digestif.SHA1.of_hex hex) hash 83 | 84 | let test_consistent_hex_iso i random_input = 85 | Alcotest.test_case (strf "iso:%d" i) `Quick @@ fun () -> 86 | let hash : Digestif.SHA1.t = Digestif.SHA1.of_raw_string random_input in 87 | let hex = Digestif.SHA1.to_hex hash in 88 | Alcotest.(check sha1) 89 | "iso consistent hex" 90 | (Digestif.SHA1.consistent_of_hex hex) 91 | hash 92 | 93 | let tests () = 94 | Alcotest.run "digestif" 95 | [ 96 | ("of_hex 0", List.mapi test_hex_success consistent_hex); 97 | ( "consistent_of_hex 0", 98 | List.mapi test_consistent_hex_success consistent_hex ); 99 | ("of_hex 1", List.mapi test_hex_success spaces_hex); 100 | ("consistent_of_hex 1", List.mapi test_consistent_hex_success spaces_hex); 101 | ("of_hex 2", List.mapi test_hex_success inconsistent_hex); 102 | ( "consistent_of_hex 2", 103 | List.mapi test_consistent_hex_fail inconsistent_hex ); 104 | ( "iso of_hex", 105 | List.mapi test_hex_iso 106 | (list_init (random_string Digestif.SHA1.digest_size) 64) ); 107 | ( "iso consistent_of_hex", 108 | List.mapi test_consistent_hex_iso 109 | (list_init (random_string Digestif.SHA1.digest_size) 64) ); 110 | ] 111 | 112 | let () = tests () 113 | -------------------------------------------------------------------------------- /test/ocaml/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (modules test) 4 | (libraries fmt alcotest digestif.ocaml)) 5 | 6 | (rule 7 | (alias runtest) 8 | (deps 9 | (:test test.exe) 10 | ../blake2b.test 11 | ../blake2s.test 12 | ../sha3_224_fips_202.txt 13 | ../sha3_256_fips_202.txt 14 | ../sha3_384_fips_202.txt 15 | ../sha3_512_fips_202.txt 16 | ../keccak_256.txt) 17 | (action 18 | (run %{test} --quick-tests --color=always))) 19 | 20 | (executable 21 | (name test_cve) 22 | (modules test_cve) 23 | (enabled_if 24 | (or 25 | (= %{architecture} "arm64") 26 | (= %{architecture} "amd64"))) 27 | (libraries fmt alcotest digestif.ocaml)) 28 | 29 | (rule 30 | (alias runtest) 31 | (enabled_if 32 | (or 33 | (= %{architecture} "arm64") 34 | (= %{architecture} "amd64"))) 35 | (deps 36 | (:test test_cve.exe)) 37 | (action 38 | (run %{test} --quick-tests --color=always))) 39 | 40 | (rule 41 | (copy# ../test.ml test.ml)) 42 | 43 | (rule 44 | (copy# ../test_cve.ml test_cve.ml)) 45 | -------------------------------------------------------------------------------- /test/test_cve.ml: -------------------------------------------------------------------------------- 1 | external unsafe_set_uint8 : 2 | (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -> 3 | int -> 4 | int -> 5 | unit = "%caml_ba_set_1" 6 | 7 | external unsafe_set_uint32 : 8 | (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t -> 9 | int -> 10 | int32 -> 11 | unit = "%caml_bigstring_set32" 12 | 13 | let fill ba chr = 14 | let len = Bigarray.Array1.dim ba in 15 | let len0 = len land 3 in 16 | let len1 = len asr 2 in 17 | let v0 = Char.code chr in 18 | let v1 = Int32.of_int v0 in 19 | 20 | for i = 0 to len1 - 1 do 21 | let i = i * 4 in 22 | unsafe_set_uint32 ba i v1 23 | done ; 24 | 25 | for i = 0 to len0 - 1 do 26 | let i = (len1 * 4) + i in 27 | unsafe_set_uint8 ba i v0 28 | done 29 | 30 | let sha3_cve_2022_37454_0 = 31 | Alcotest.test_case "buffer overflow" `Slow @@ fun () -> 32 | Gc.full_major () ; 33 | let a = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 1 in 34 | let b = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 4294967295 in 35 | fill a '\x00' ; 36 | fill b '\x00' ; 37 | let ctx = Digestif.SHA3_224.empty in 38 | let ctx = Digestif.SHA3_224.feed_bigstring ctx a in 39 | let ctx = Digestif.SHA3_224.feed_bigstring ctx b in 40 | let hash = Digestif.SHA3_224.get ctx in 41 | Alcotest.(check (testable Digestif.SHA3_224.pp Digestif.SHA3_224.equal)) 42 | "result" hash 43 | (Digestif.SHA3_224.of_hex 44 | "c5bcc3bc73b5ef45e91d2d7c70b64f196fac08eee4e4acf6e6571ebe") 45 | 46 | let sha3_cve_2022_37454_1 = 47 | Alcotest.test_case "infinite loop" `Slow @@ fun () -> 48 | Gc.full_major () ; 49 | let a = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 1 in 50 | let b = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 4294967296 in 51 | fill a '\x00' ; 52 | fill b '\x00' ; 53 | let ctx = Digestif.SHA3_224.empty in 54 | let ctx = Digestif.SHA3_224.feed_bigstring ctx a in 55 | let ctx = Digestif.SHA3_224.feed_bigstring ctx b in 56 | let hash = Digestif.SHA3_224.get ctx in 57 | Alcotest.(check (testable Digestif.SHA3_224.pp Digestif.SHA3_224.equal)) 58 | "result" hash 59 | (Digestif.SHA3_224.of_hex 60 | "bdd5167212d2dc69665f5a8875ab87f23d5ce7849132f56371a19096") 61 | 62 | let () = 63 | Alcotest.run "digestif (CVE)" 64 | [ 65 | ("sha3 (CVE-2022-37454)", [ sha3_cve_2022_37454_0; sha3_cve_2022_37454_1 ]); 66 | ] 67 | -------------------------------------------------------------------------------- /test/test_runes.ml: -------------------------------------------------------------------------------- 1 | #use "topfind" 2 | 3 | #require "astring" 4 | 5 | #require "fpath" 6 | 7 | #require "bos" 8 | 9 | open Rresult 10 | 11 | let is_opt x = String.length x > 1 && x.[0] = '-' 12 | 13 | let parse_opt_arg x = 14 | let l = String.length x in 15 | if x.[1] <> '-' 16 | then 17 | if l = 2 18 | then (x, None) 19 | else (String.sub x 0 2, Some (String.sub x 2 (l - 2))) 20 | else 21 | try 22 | let i = String.index x '=' in 23 | (String.sub x 0 i, Some (String.sub x (i + 1) (l - i - 1))) 24 | with Not_found -> (x, None) 25 | 26 | type arg = 27 | | Path of Fpath.t 28 | | Library of [ `Abs of Fpath.t | `Rel of Fpath.t | `Name of string ] 29 | 30 | let parse_lL_value name value = 31 | match name with 32 | | "-L" -> ( 33 | match Fpath.of_string value with 34 | | Ok v when Fpath.is_dir_path v && Sys.is_directory value -> R.ok (Path v) 35 | | Ok v when Sys.is_directory value -> R.ok (Path (Fpath.to_dir_path v)) 36 | | Ok v -> R.error_msgf "Directory <%a> does not exist" Fpath.pp v 37 | | Error err -> Error err) 38 | | "-l" -> ( 39 | match Astring.String.cut ~sep:":" value with 40 | | Some ("", path) -> ( 41 | match Fpath.of_string path with 42 | | Ok v when Fpath.is_abs v && Sys.file_exists path -> 43 | Ok (Library (`Abs v)) 44 | | Ok v when Fpath.is_rel v -> Ok (Library (`Rel v)) 45 | | Ok v -> R.error_msgf "Library <%a> does not exist" Fpath.pp v 46 | | Error err -> Error err) 47 | | Some (_, _) -> R.error_msgf "Invalid %S" value 48 | | None -> 49 | match Fpath.of_string value with 50 | | Ok v when Fpath.is_file_path v && Fpath.filename v = value -> 51 | Ok (Library (`Name value)) 52 | | Ok v -> R.error_msgf "Invalid library name <%a>" Fpath.pp v 53 | | Error err -> Error err) 54 | | _ -> Fmt.failwith "Invalid argument name %S" name 55 | 56 | let parse_lL_args args = 57 | let rec go lL_args = function 58 | | [] | "--" :: _ -> R.ok (List.rev lL_args) 59 | | x :: args -> ( 60 | if not (is_opt x) 61 | then go lL_args args 62 | else 63 | let name, value = parse_opt_arg x in 64 | match name with 65 | | "-L" | "-l" -> ( 66 | match value with 67 | | Some value -> 68 | parse_lL_value name value >>= fun v -> go (v :: lL_args) args 69 | | None -> 70 | match args with 71 | | [] -> R.error_msgf "%s must have a value." name 72 | | value :: args -> 73 | if is_opt value 74 | then R.error_msgf "%s must have a value." name 75 | else 76 | parse_lL_value name value >>= fun v -> 77 | go (v :: lL_args) args) 78 | | _ -> go lL_args args) in 79 | go [] args 80 | 81 | let is_path = function Path _ -> true | Library _ -> false 82 | let prj_path = function Path x -> x | _ -> assert false 83 | let prj_libraries = function Library x -> x | _ -> assert false 84 | 85 | let libraries_exist args = 86 | let paths, libraries = List.partition is_path args in 87 | let paths = List.map prj_path paths in 88 | let libraries = List.map prj_libraries libraries in 89 | let rec go = function 90 | | [] -> R.ok () 91 | | `Rel library :: libraries -> 92 | let rec check = function 93 | | [] -> R.error_msgf "Library <:%a> does not exist." Fpath.pp library 94 | | p0 :: ps -> ( 95 | let path = Fpath.(p0 // library) in 96 | Bos.OS.Path.exists path >>= function 97 | | true -> go libraries 98 | | false -> check ps) in 99 | check paths 100 | | `Name library :: libraries -> 101 | let lib = Fmt.str "lib%s.a" library in 102 | let rec check = function 103 | | [] -> R.error_msgf "Library lib%s.a does not exist." library 104 | | p0 :: ps -> ( 105 | let path = Fpath.(p0 / lib) in 106 | Bos.OS.Path.exists path >>= function 107 | | true -> go libraries 108 | | false -> check ps) in 109 | check paths 110 | | `Abs path :: libraries -> ( 111 | Bos.OS.Path.exists path >>= function 112 | | true -> go libraries 113 | | false -> R.error_msgf "Library <%a> does not exist." Fpath.pp path) 114 | in 115 | go libraries 116 | 117 | let exists lib = 118 | let open Bos in 119 | let command = Cmd.(v "ocamlfind" % "query" % lib) in 120 | OS.Cmd.run_out command |> OS.Cmd.out_null >>= function 121 | | (), (_, `Exited 0) -> R.ok true 122 | | _ -> R.ok false 123 | 124 | let query target lib = 125 | let open Bos in 126 | let format = Fmt.str "-L%%d %%(%s_linkopts)" target in 127 | let command = Cmd.(v "ocamlfind" % "query" % "-format" % format % lib) in 128 | OS.Cmd.run_out command 129 | |> OS.Cmd.out_lines 130 | >>= (function 131 | | output, (_, `Exited 0) -> R.ok output 132 | | _ -> R.error_msgf " does not properly exit.") 133 | >>| String.concat " " 134 | >>| Astring.String.cuts ~sep:" " ~empty:false 135 | 136 | let run () = 137 | (exists "mirage-xen-posix" >>= function 138 | | true -> query "xen" "digestif" >>= parse_lL_args >>= libraries_exist 139 | | false -> R.ok ()) 140 | >>= fun () -> 141 | (exists "ocaml-freestanding" >>= function 142 | | true -> 143 | query "freestanding" "digestif" >>= parse_lL_args >>= libraries_exist 144 | | false -> R.ok ()) 145 | >>= fun () -> R.ok () 146 | 147 | let exit_success = 0 148 | let exit_failure = 1 149 | 150 | let () = 151 | match run () with 152 | | Ok () -> exit exit_success 153 | | Error (`Msg err) -> 154 | Fmt.epr "%s\n%!" err ; 155 | exit exit_failure 156 | --------------------------------------------------------------------------------