├── .github └── workflows │ └── main.yml ├── .gitignore ├── .ocamlformat ├── CHANGES.md ├── LICENSE.md ├── README.md ├── doc └── api.odocl ├── dune-project ├── key-parsers.opam ├── lib ├── asn1.ml ├── asn1.mli ├── cvc.ml ├── cvc.mli ├── derivable.ml ├── derivable.mli ├── dune ├── ltpa.ml ├── ltpa.mli ├── pgp.ml └── pgp.mli └── tests ├── dune ├── keys ├── bad_file.pgp ├── bad_file_header.pgp ├── bad_pub_algo.pgp ├── dh_param.der ├── dh_private.der ├── dh_public.der ├── dsa_pkcs8.der ├── dsa_private.pgp ├── dsa_private_key.der ├── dsa_public.pgp ├── dsa_x509.der ├── ecdsa_cvc_dummy.key ├── elgamal_public.pgp ├── negative_rsa.der ├── p256v1_explicit_param.der ├── p256v1_named_param.der ├── p256v1_pkcs8.der ├── p256v1_x509.der ├── revocation_signature.pgp ├── rsa_cvc_dummy.key ├── rsa_pkcs1.der ├── rsa_pkcs1_pub.der ├── rsa_pkcs8.der ├── rsa_private.pgp ├── rsa_public.pgp ├── rsa_tag0.pgp ├── rsa_x509.der ├── rsa_x509_no_params.der ├── sect113r1_explicit_param.der └── test_marker.pgp ├── test_all.ml ├── test_asn1.ml ├── test_cvc.ml ├── test_helpers.ml ├── test_helpers.mli ├── test_ltpa.ml ├── test_pgp.ml └── test_util.ml /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: main 2 | 3 | on: 4 | - pull_request 5 | - push 6 | 7 | jobs: 8 | build: 9 | strategy: 10 | fail-fast: false 11 | matrix: 12 | os: 13 | - macos-latest 14 | - ubuntu-latest 15 | - windows-latest 16 | ocaml-compiler: 17 | - 4.08.0 18 | - 4.14.2 19 | - 5.2.0 20 | exclude: 21 | - os: macos-latest 22 | ocaml-compiler: 4.08.0 23 | - os: windows-latest 24 | ocaml-compiler: 5.2.0 25 | runs-on: ${{ matrix.os }} 26 | steps: 27 | - name: Checkout code 28 | uses: actions/checkout@v3 29 | - name: Use OCaml ${{ matrix.ocaml-version }} 30 | uses: ocaml/setup-ocaml@v2 31 | with: 32 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 33 | - run: opam pin add key-parsers.dev . --no-action 34 | - run: opam depext key-parsers --yes --with-test 35 | - run: opam install . --deps-only --with-test 36 | - run: opam exec -- dune build @all @runtest 37 | check-format: 38 | runs-on: ubuntu-latest 39 | steps: 40 | - name: Checkout code 41 | uses: actions/checkout@v3 42 | - name: Use OCaml 43 | uses: ocaml/setup-ocaml@v2 44 | with: 45 | ocaml-compiler: 4.14.2 46 | - run: opam pin add key-parsers.dev . --no-action 47 | - run: opam depext key-parsers --yes 48 | - run: opam install . --deps-only 49 | - run: opam install ocamlformat.0.26.2 50 | - run: opam exec -- dune build @fmt 51 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.native 3 | *.merlin 4 | *.install 5 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version=0.26.2 2 | break-cases=all 3 | break-fun-decl=fit-or-vertical 4 | break-fun-sig=fit-or-vertical 5 | break-infix-before-func=false 6 | break-infix=fit-or-vertical 7 | break-separators=before 8 | break-sequences=true 9 | cases-exp-indent=2 10 | doc-comments=before-except-val 11 | dock-collection-brackets=false 12 | if-then-else=k-r 13 | parens-tuple-patterns=always 14 | parens-tuple=always 15 | space-around-arrays=false 16 | space-around-lists=false 17 | space-around-records=false 18 | space-around-variants=false 19 | type-decl=sparse 20 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## Unreleased 2 | 3 | *2022-12-05* 4 | 5 | - Add alternative algorithm identifier for DSA keys 6 | - Improve reporting of unknown algorithm identifiers 7 | 8 | ## 1.4.0 9 | 10 | *2021-09-14* 11 | 12 | ### Changed 13 | 14 | - Parse Signature packets/Marker packets in the PGP module 15 | 16 | ## 1.3.0 17 | 18 | *2021-08-05* 19 | 20 | ### Changed 21 | 22 | - Change the way ID packets are represented in the PGP module 23 | 24 | ## 1.2.1 25 | 26 | *2021-07-30* 27 | 28 | ### Changed 29 | 30 | - Update the minimal Cstruct version to 6.0.0 and Dune to 2.0 31 | 32 | ## 1.2.0 33 | 34 | *2021-07-27* 35 | 36 | ### Added 37 | 38 | - Added the possibility of parsing PGP files to the library 39 | 40 | ## 1.1.0 41 | 42 | *2021-05-10* 43 | 44 | ### Added 45 | 46 | - Add non-pkcs8 (OpenSSL) DSA private keys 47 | 48 | ## 1.0.1 49 | 50 | *2021-04-28* 51 | 52 | ### Fixed 53 | 54 | - Detect malformed RSA keys and return an error 55 | 56 | ## 1.0.0 57 | 58 | *2020-12-03* 59 | 60 | ### Changed 61 | 62 | - Correct spelling 'alogrithm' -> 'algorithm' in some labels 63 | 64 | ### Removed 65 | 66 | - Remove dependency on ppx_deriving_yojson and ppx_bin_prot, and associated deprecated 67 | serialization values (`bin_t`, `bin_size_t`, `to_yojson`, etc). 68 | - Remove deprecated uppercase module aliases `RSA`, `DSA`, `EC` and `DH` in `Asn1`, `Cvc` 69 | and `Ltpa`. 70 | 71 | ## 0.10.1 72 | 73 | *2018-10-31* 74 | 75 | ### Fixed 76 | 77 | - Allow RSA parameters to be absent form the AlgorithmIdentifier Sequence 78 | 79 | ## 0.10.0 80 | 81 | *2018-08-27* 82 | 83 | ### Added 84 | 85 | - Lowercase aliases for uppercase modules `RSA`, `DSA`, `EC` and `DH` in `Asn1`, `Cvc` and `Ltpa` 86 | 87 | ### Deprecated 88 | 89 | - `Yojson` and `Bin_prot` (de)serializers are deprecated ahead of their removal in `1.0.0`. 90 | - Uppercase modules such as `Asn1.RSA` in favor of their lowercase counterparts 91 | 92 | ### Changed 93 | 94 | - Use dune instead of ocamlbuild and topkg 95 | - Rename uppercase private variants and modules to lowercase ones 96 | 97 | ## 0.9.2 98 | 99 | *2017-12-12* 100 | 101 | - Switch to `asn1-combinators >= 0.2.0` 102 | - Refactor `Kp_asn1` 103 | - Add documentation and README 104 | 105 | ## 0.9.1 106 | 107 | *2017-08-30* 108 | 109 | - remove `@tailcall` annotations to allow `ppx_deriving > 4.2` 110 | 111 | ## 0.9.0 112 | 113 | *2017-06-21* 114 | 115 | - encode Cstruct as 0x prefixed hex string (breaks json compatibility) 116 | 117 | ## 0.8.1 118 | 119 | *2017-05-03* 120 | 121 | - `ppx_bin_prot` 0.9.0 compatibility 122 | 123 | ## 0.8.0 124 | 125 | *2016-12-27* 126 | 127 | - Add an `equal` function for all exposed types 128 | - Add `bin_prot` serializer and deserializer for all exposed types 129 | 130 | ## 0.7.0 131 | 132 | *2016-11-28* 133 | 134 | (This release contains breaking changes) 135 | 136 | - Fixes CVC EC keys representation (Breaking change) 137 | - Accept a range of rsa and ecdsa oids for CVC keys 138 | 139 | ## v0.6.1 140 | 141 | *2016-11-15* 142 | 143 | - Fixes install 144 | 145 | 146 | ## v0.6.0 147 | 148 | *2016-11-14* 149 | 150 | - Build using `topkg` 151 | - Add `ppx_deriving.runtime` to `META` 152 | - Add support for parsing CVC keys 153 | 154 | ## v0.5.0 155 | 156 | *2016-08-10* 157 | 158 | - Explicitly define ocaml version 159 | - Widen dependencies version ranges 160 | - add `ppx_deriving` annotations for `ord` and `yojson` to most of the exposed types in `Asn1` and `Ltpa` 161 | 162 | ## v0.4.0 163 | 164 | *2016-07-25* 165 | 166 | - Accept ECDH and ECMQV OIDs for EC keys AlorithmIdentifier 167 | - Add support for encoding/decoding Diffie-Hellman keys 168 | - Use `ppx_deriving_yojson` 3.0 169 | 170 | ## v0.3.0 171 | 172 | *2016-03-10* 173 | 174 | - Add converters and compare functions to Asn1.EC 175 | - Split Key_parsers content between Asn1 and Ltpa submodules. 176 | Breaks compatibility with previous versions. 177 | - Add some tests 178 | - Decode functions now return ('a, string) Result.result. 179 | Breaks compatibility with previous versions. 180 | - Add LTPA RSA parsers 181 | 182 | ## v0.2.0 183 | 184 | *2016-02-15* 185 | 186 | - Add EC keys and parameters parsers 187 | - Compile with `-safe-string` 188 | 189 | ## v0.1.0 190 | 191 | *2015-11-27* 192 | 193 | - Initial release 194 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, Cryptosense SA 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | 1. Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | 2. Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 15 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 16 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 17 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 18 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 19 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 20 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 21 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 22 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 23 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # key-parsers 2 | 3 | [![Build Status][build_status_badge]][build_status_link] 4 | 5 | Key-parsers offers parsers and printers for various asymmetric key formats. 6 | 7 | ## `Key_parsers` 8 | 9 | It currently comes with four submodules. 10 | 11 | ### `Asn1` 12 | 13 | Note that all the parsers in this module expect the raw DER encoded byte string. They 14 | don't handle PEM armoring (`----BEGIN X----` and `----END X----`) nor decode Base64 or 15 | hex. 16 | 17 | Here you can find parsers for the following formats: 18 | 19 | - PKCS#1 encoding of RSA Private and Public keys as defined in 20 | [PKCS#1 v2.2](https://tools.ietf.org/html/rfc8017#appendix-A) 21 | - PKCS#8 encoding of RSA, DSA, EC and DH Private keys as defined in 22 | [RFC 5208](https://tools.ietf.org/html/rfc5208#section-5) 23 | - X.509 SubjectPublicKeyInfo encoding of RSA, DSA, EC and DH Public keys as defined in 24 | [RFC 5280](https://tools.ietf.org/html/rfc5280#appendix-A) 25 | - DER encodings of DSA, EC and DH Parameters and Private keys as produced by OpenSSL 26 | commands such as `dsaparam` and `gendsa` 27 | 28 | ### `Pgp` 29 | 30 | Parsers for PGP (Pretty Good Privacy) encodings of DSA, RSA and Elgamal Public and 31 | Private keys and user IDs as defined in [RFC 4880] (https://datatracker.ietf.org/doc/html/rfc4880) 32 | Note that the parsers in this module expect raw byte string. They don't handle PEM armoring 33 | nor decode Base64 or hex. 34 | 35 | ### `Ltpa` 36 | 37 | Parsers for LTPA (Lightweight Third Party Authentication) encodings of RSA private and 38 | public keys. 39 | 40 | ### `Cvc` 41 | 42 | Parsers for CVC (Card Verifiable Certificates) encodings of RSA and EC Public keys. 43 | 44 | ## Make a new version 45 | 46 | Check that the changelog is up to date. 47 | 48 | Create an annotated tag with the new version: 49 | 50 | ```bash 51 | git tag --message 'Version 1.2.3' 1.2.3 52 | ``` 53 | 54 | Then, use `dune-release`: 55 | 56 | ```bash 57 | dune-release distrib 58 | dune-release check 59 | dune-release publish 60 | dune-release opam pkg 61 | dune-release opam submit 62 | ``` 63 | 64 | The command `dune-release bistro` can do all of that in one invocation but can be more 65 | confusing if you're not used to `dune-release`. 66 | 67 | [build_status_badge]: https://github.com/cryptosense/key-parsers/actions/workflows/main.yml/badge.svg 68 | [build_status_link]: https://github.com/cryptosense/key-parsers/actions/workflows/main.yml 69 | -------------------------------------------------------------------------------- /doc/api.odocl: -------------------------------------------------------------------------------- 1 | Key_parsers 2 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.0) 2 | (name key-parsers) 3 | -------------------------------------------------------------------------------- /key-parsers.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Cryptosense " 3 | authors: [ 4 | "Cryptosense " 5 | "Nathan Rebours " 6 | ] 7 | homepage: "https://github.com/cryptosense/key-parsers" 8 | bug-reports: "https://github.com/cryptosense/key-parsers/issues" 9 | license: "BSD-2-Clause" 10 | dev-repo: "git+https://github.com/cryptosense/key-parsers.git" 11 | doc: "https://cryptosense.github.io/key-parsers/doc" 12 | build: [ 13 | [ "dune" "build" "-p" name "-j" jobs ] 14 | ] 15 | run-test: [ 16 | [ "dune" "runtest" "-p" name "-j" jobs ] 17 | ] 18 | depends: [ 19 | "asn1-combinators" {= "0.2.6"} 20 | "cstruct" {>= "6.0.0"} 21 | "dune" {>= "2.0"} 22 | "hex" {>= "1.0.0"} 23 | "ocaml" {>= "4.08.0"} 24 | "ounit" {with-test & >= "2.0.0"} 25 | "ppx_deriving" {>= "4.0"} 26 | "result" {>= "1.5"} 27 | "zarith" {>= "1.4.1"} 28 | ] 29 | conflicts: [ 30 | "ppx_driver" {= "v0.9.1"} 31 | ] 32 | synopsis: "Parsers for multiple key formats" 33 | description: """ 34 | This library provides parsers for several encodings of RSA, DSA, Diffie-Hellman or 35 | Elliptic curve public and private keys. 36 | """ 37 | -------------------------------------------------------------------------------- /lib/asn1.ml: -------------------------------------------------------------------------------- 1 | let raise_asn f = 2 | match f () with 3 | | Result.Ok x -> x 4 | | Result.Error s -> Asn.S.parse_error "%s" s 5 | 6 | let encode_helper grammar = 7 | let open Asn in 8 | encode (codec der grammar) 9 | 10 | let decode_helper name grammar x = 11 | let open Asn in 12 | let eprintf fmt = Printf.ksprintf (fun s -> Result.Error s) fmt in 13 | match decode (codec ber grammar) x with 14 | | Result.Ok (t, left) when Cstruct.length left = 0 -> Result.Ok t 15 | | Result.Ok _ -> eprintf "%s: non empty leftover" name 16 | | Result.Error (`Parse s) -> eprintf "%s: %s" name s 17 | 18 | module Rsa = struct 19 | module Params = struct 20 | type t = unit 21 | 22 | let grammar = Asn.S.null 23 | end 24 | 25 | module Public = struct 26 | type t = 27 | { n : Derivable.Z.t 28 | ; e : Derivable.Z.t } 29 | [@@deriving ord, eq, show] 30 | 31 | let reject_negative_modulus = function 32 | | Ok {n; e} -> 33 | if Z.gt n Z.zero then 34 | Ok {n; e} 35 | else 36 | (* A few tools generate keys without leading 0 bit, which gets interpreted 37 | as a negative integer. *) 38 | Error "Negative modulus" 39 | | e -> e 40 | 41 | let grammar = 42 | let open Asn.S in 43 | let f (n, e) = {n; e} in 44 | let g {n; e} = (n, e) in 45 | map f g 46 | @@ sequence2 47 | (required ~label:"modulus" integer) 48 | (required ~label:"publicExponent" integer) 49 | 50 | let encode = encode_helper grammar 51 | 52 | let decode k = 53 | decode_helper "PKCS1 RSA public key" grammar k |> reject_negative_modulus 54 | end 55 | 56 | module Private = struct 57 | type other_prime = 58 | { r : Derivable.Z.t 59 | ; d : Derivable.Z.t 60 | ; t : Derivable.Z.t } 61 | [@@deriving ord, eq, show] 62 | 63 | let other_prime_grammar = 64 | let open Asn.S in 65 | let f (r, d, t) = {r; d; t} in 66 | let g {r; d; t} = (r, d, t) in 67 | map f g 68 | @@ sequence3 69 | (required ~label:"prime" integer) 70 | (required ~label:"exponent" integer) 71 | (required ~label:"coefficient" integer) 72 | 73 | type t = 74 | { n : Derivable.Z.t 75 | ; e : Derivable.Z.t 76 | ; d : Derivable.Z.t 77 | ; p : Derivable.Z.t 78 | ; q : Derivable.Z.t 79 | ; dp : Derivable.Z.t 80 | ; dq : Derivable.Z.t 81 | ; qinv : Derivable.Z.t 82 | ; other_primes : other_prime list } 83 | [@@deriving ord, eq, show] 84 | 85 | let grammar = 86 | let open Asn.S in 87 | let f = function 88 | | (0, (n, (e, (d, (p, (q, (dp, (dq, (qinv, None))))))))) -> 89 | {n; e; d; p; q; dp; dq; qinv; other_primes = []} 90 | | (1, (n, (e, (d, (p, (q, (dp, (dq, (qinv, Some other_primes))))))))) -> 91 | {n; e; d; p; q; dp; dq; qinv; other_primes} 92 | | _ -> 93 | parse_error 94 | "PKCS#1: RSA private key version inconsistent with key data" 95 | in 96 | let g {n; e; d; p; q; dp; dq; qinv; _} = 97 | (0, (n, (e, (d, (p, (q, (dp, (dq, (qinv, None))))))))) 98 | in 99 | map f g 100 | @@ sequence 101 | @@ required ~label:"version" int 102 | @ required ~label:"modulus" integer 103 | @ required ~label:"publicExponent" integer 104 | @ required ~label:"privateExponent" integer 105 | @ required ~label:"prime1" integer 106 | @ required ~label:"prime2" integer 107 | @ required ~label:"exponent1" integer 108 | @ required ~label:"exponent2" integer 109 | @ required ~label:"coefficient" integer 110 | -@ optional ~label:"otherPrimeInfo" (sequence_of other_prime_grammar) 111 | 112 | let encode = encode_helper grammar 113 | let decode = decode_helper "PKCS1 RSA private key" grammar 114 | end 115 | end 116 | 117 | module Dsa = struct 118 | module Params = struct 119 | type t = 120 | { p : Derivable.Z.t 121 | ; q : Derivable.Z.t 122 | ; g : Derivable.Z.t } 123 | [@@deriving ord, eq, show] 124 | 125 | let grammar = 126 | let open Asn.S in 127 | let f (p, q, g) = {p; q; g} in 128 | let g {p; q; g} = (p, q, g) in 129 | map f g 130 | @@ sequence3 131 | (required ~label:"p" integer) 132 | (required ~label:"q" integer) 133 | (required ~label:"g" integer) 134 | 135 | let encode = encode_helper grammar 136 | let decode = decode_helper "DSA params" grammar 137 | end 138 | 139 | module Public = struct 140 | type t = Derivable.Z.t [@@deriving ord, eq, show] 141 | 142 | let grammar = Asn.S.integer 143 | let encode = encode_helper grammar 144 | let decode = decode_helper "DSA public key" grammar 145 | end 146 | 147 | module Private = struct 148 | type t = Derivable.Z.t [@@deriving ord, eq, show] 149 | 150 | let grammar = Asn.S.integer 151 | let encode = encode_helper grammar 152 | let decode = decode_helper "DSA private key" grammar 153 | end 154 | end 155 | 156 | module Ec = struct 157 | type point = Derivable.Cstruct.t [@@deriving ord, eq, show] 158 | 159 | let point_grammar = Asn.S.octet_string 160 | 161 | module Field = struct 162 | let prime_oid = Asn.OID.(base 1 2 <|| [840; 10045; 1; 1]) 163 | let characteristic_two_oid = Asn.OID.(base 1 2 <|| [840; 10045; 1; 2]) 164 | let gn_oid = Asn.OID.(characteristic_two_oid <| 3 <| 1) 165 | let tp_oid = Asn.OID.(characteristic_two_oid <| 3 <| 2) 166 | let pp_oid = Asn.OID.(characteristic_two_oid <| 3 <| 3) 167 | 168 | type basis_type = 169 | | GN_typ 170 | | TP_typ 171 | | PP_typ 172 | 173 | let basis_type_grammar = 174 | let open Asn.S in 175 | let f = function 176 | | oid when oid = gn_oid -> GN_typ 177 | | oid when oid = tp_oid -> TP_typ 178 | | oid when oid = pp_oid -> PP_typ 179 | | _ -> parse_error "Ec: unexpected basis type OID" 180 | in 181 | let g = function 182 | | GN_typ -> gn_oid 183 | | TP_typ -> tp_oid 184 | | PP_typ -> pp_oid 185 | in 186 | map f g oid 187 | 188 | type basis = 189 | | GN 190 | | TP of Derivable.Z.t 191 | | PP of Derivable.Z.t * Derivable.Z.t * Derivable.Z.t 192 | [@@deriving ord, eq, show] 193 | 194 | let basis_grammar = 195 | let open Asn.S in 196 | let f = function 197 | | `C1 () -> GN 198 | | `C2 k -> TP k 199 | | `C3 (k1, k2, k3) -> PP (k1, k2, k3) 200 | in 201 | let g = function 202 | | GN -> `C1 () 203 | | TP k -> `C2 k 204 | | PP (k1, k2, k3) -> `C3 (k1, k2, k3) 205 | in 206 | map f g 207 | @@ choice3 null integer 208 | (sequence3 209 | (required ~label:"k1" integer) 210 | (required ~label:"k2" integer) 211 | (required ~label:"k3" integer)) 212 | 213 | type characteristic_two_params = 214 | { m : Derivable.Z.t 215 | ; basis : basis } 216 | [@@deriving ord, eq, show] 217 | 218 | let ctwo_params_grammar = 219 | let open Asn.S in 220 | let f = function 221 | | (m, GN_typ, GN) -> {m; basis = GN} 222 | | (m, TP_typ, TP k) -> {m; basis = TP k} 223 | | (m, PP_typ, PP (k1, k2, k3)) -> {m; basis = PP (k1, k2, k3)} 224 | | _ -> parse_error "Ec: field basis type and parameters don't match" 225 | in 226 | let g {m; basis} = 227 | match basis with 228 | | GN -> (m, GN_typ, GN) 229 | | TP k -> (m, TP_typ, TP k) 230 | | PP (k1, k2, k3) -> (m, PP_typ, PP (k1, k2, k3)) 231 | in 232 | map f g 233 | @@ sequence3 234 | (required ~label:"m" integer) 235 | (required ~label:"basis" basis_type_grammar) 236 | (required ~label:"parameters" basis_grammar) 237 | 238 | type typ = 239 | | Prime_typ 240 | | C_two_typ 241 | 242 | let typ_grammar = 243 | let open Asn.S in 244 | let f = function 245 | | oid when oid = prime_oid -> Prime_typ 246 | | oid when oid = characteristic_two_oid -> C_two_typ 247 | | _ -> parse_error "Ec: unexpected field type OID" 248 | in 249 | let g = function 250 | | Prime_typ -> prime_oid 251 | | C_two_typ -> characteristic_two_oid 252 | in 253 | map f g oid 254 | 255 | type parameters = 256 | | Prime_p of Derivable.Z.t 257 | | C_two_p of characteristic_two_params 258 | 259 | let parameters_grammar = 260 | let open Asn.S in 261 | let f = function 262 | | `C1 p -> Prime_p p 263 | | `C2 params -> C_two_p params 264 | in 265 | let g = function 266 | | Prime_p p -> `C1 p 267 | | C_two_p params -> `C2 params 268 | in 269 | map f g @@ choice2 integer ctwo_params_grammar 270 | 271 | type t = 272 | | Prime of Derivable.Z.t 273 | | C_two of characteristic_two_params 274 | [@@deriving ord, eq, show] 275 | 276 | let grammar = 277 | let open Asn.S in 278 | let f = function 279 | | (Prime_typ, Prime_p p) -> Prime p 280 | | (C_two_typ, C_two_p params) -> C_two params 281 | | _ -> parse_error "Ec: field type and parameters don't match" 282 | in 283 | let g = function 284 | | Prime p -> (Prime_typ, Prime_p p) 285 | | C_two params -> (C_two_typ, C_two_p params) 286 | in 287 | map f g 288 | @@ sequence2 289 | (required ~label:"fieldType" typ_grammar) 290 | (required ~label:"parameters" parameters_grammar) 291 | end 292 | 293 | module Specified_domain = struct 294 | type field_element = Derivable.Cstruct.t [@@deriving ord, eq, show] 295 | 296 | let field_element_grammar = Asn.S.octet_string 297 | 298 | type curve = 299 | { a : field_element 300 | ; b : field_element 301 | ; seed : Derivable.Cstruct.t option } 302 | [@@deriving ord, eq, show] 303 | 304 | let curve_grammar = 305 | let open Asn.S in 306 | let f (a, b, seed) = {a; b; seed} in 307 | let g {a; b; seed} = (a, b, seed) in 308 | map f g 309 | @@ sequence3 310 | (required ~label:"a" field_element_grammar) 311 | (required ~label:"b" field_element_grammar) 312 | (optional ~label:"seed" bit_string_cs) 313 | 314 | type t = 315 | { field : Field.t 316 | ; curve : curve 317 | ; base : point 318 | ; order : Derivable.Z.t 319 | ; cofactor : Derivable.Z.t option } 320 | [@@deriving ord, eq, show] 321 | 322 | let grammar = 323 | let open Asn.S in 324 | let f (version, field, curve, base, order, cofactor) = 325 | if version = 1 then 326 | {field; curve; base; order; cofactor} 327 | else 328 | parse_error "Ec: Unknown ECParameters version" 329 | in 330 | let g {field; curve; base; order; cofactor} = 331 | (1, field, curve, base, order, cofactor) 332 | in 333 | map f g 334 | @@ sequence6 335 | (required ~label:"version" int) 336 | (required ~label:"fieldID" Field.grammar) 337 | (required ~label:"curve" curve_grammar) 338 | (required ~label:"base" point_grammar) 339 | (required ~label:"order" integer) 340 | (optional ~label:"cofactor" integer) 341 | end 342 | 343 | module Params = struct 344 | type t = 345 | | Named of Derivable.Asn_oid.t 346 | | Implicit 347 | | Specified of Specified_domain.t 348 | [@@deriving ord, eq, show] 349 | 350 | let grammar = 351 | let open Asn.S in 352 | let f = function 353 | | `C1 oid -> Named oid 354 | | `C2 () -> Implicit 355 | | `C3 domain -> Specified domain 356 | in 357 | let g = function 358 | | Named oid -> `C1 oid 359 | | Implicit -> `C2 () 360 | | Specified domain -> `C3 domain 361 | in 362 | map f g @@ choice3 oid null Specified_domain.grammar 363 | 364 | let encode = encode_helper grammar 365 | let decode = decode_helper "EC parameters" grammar 366 | end 367 | 368 | module Public = struct 369 | type t = point [@@deriving ord, eq, show] 370 | 371 | let grammar = point_grammar 372 | let encode = encode_helper grammar 373 | let decode = decode_helper "EC public key" grammar 374 | end 375 | 376 | module Private = struct 377 | type t = 378 | { k : Derivable.Cstruct.t 379 | ; params : Params.t option 380 | ; public_key : Public.t option } 381 | [@@deriving ord, eq, show] 382 | 383 | let grammar = 384 | let open Asn.S in 385 | let f (version, k, params, public_key) = 386 | if version = 1 then 387 | {k; params; public_key} 388 | else 389 | parse_error "Ec: unknown private key version" 390 | in 391 | let g {k; params; public_key} = (1, k, params, public_key) in 392 | map f g 393 | @@ sequence4 394 | (required ~label:"version" int) 395 | (required ~label:"privateKey" octet_string) 396 | (optional ~label:"ECParameters" @@ explicit 0 Params.grammar) 397 | (optional ~label:"publicKey" @@ explicit 1 bit_string_cs) 398 | 399 | let encode = encode_helper grammar 400 | let decode = decode_helper "EC private key" grammar 401 | end 402 | end 403 | 404 | module Dh = struct 405 | module Params = struct 406 | type t = 407 | { p : Derivable.Z.t 408 | ; g : Derivable.Z.t 409 | ; l : Derivable.Z.t option (* privateValueLength *) } 410 | [@@deriving ord, eq, show] 411 | 412 | let grammar = 413 | let open Asn.S in 414 | let to_struct (p, g, l) = {p; g; l} in 415 | let of_struct {p; g; l} = (p, g, l) in 416 | map to_struct of_struct 417 | @@ sequence3 418 | (required ~label:"p" integer) 419 | (required ~label:"g" integer) 420 | (optional ~label:"l" integer) 421 | 422 | let encode = encode_helper grammar 423 | let decode = decode_helper "DH params" grammar 424 | end 425 | 426 | module Public = struct 427 | type t = Derivable.Z.t [@@deriving ord, eq, show] 428 | 429 | let grammar = Asn.S.integer 430 | let encode = encode_helper grammar 431 | let decode = decode_helper "DH public key" grammar 432 | end 433 | 434 | module Private = struct 435 | type t = Derivable.Z.t [@@deriving ord, eq, show] 436 | 437 | let grammar = Asn.S.integer 438 | let encode = encode_helper grammar 439 | let decode = decode_helper "DH private key" grammar 440 | end 441 | end 442 | 443 | module Algorithm_identifier = struct 444 | module Algo = struct 445 | let rsa_oid = Asn.OID.(base 1 2 <|| [840; 113549; 1; 1; 1]) 446 | let dsa_oid = Asn.OID.(base 1 2 <|| [840; 10040; 4; 1]) 447 | let dsa_oiw = Asn.OID.(base 1 3 <|| [14; 3; 2; 12]) 448 | let ec_oid = Asn.OID.(base 1 2 <|| [840; 10045; 2; 1]) 449 | let dh_oid = Asn.OID.(base 1 2 <|| [840; 113549; 1; 3; 1]) 450 | let ec_dh = Asn.OID.(base 1 3 <|| [132; 1; 12]) 451 | let ec_mqv = Asn.OID.(base 1 3 <|| [132; 1; 13]) 452 | 453 | type t = 454 | | Dsa 455 | | Rsa 456 | | Ec 457 | | Dh 458 | | Unknown of Asn.OID.t 459 | 460 | let to_string = function 461 | | Dsa -> "DSA" 462 | | Rsa -> "RSA" 463 | | Ec -> "EC" 464 | | Dh -> "DH" 465 | | Unknown oid -> Format.asprintf "%a" Asn.OID.pp oid 466 | 467 | let grammar = 468 | let open Asn.S in 469 | let f = function 470 | | oid when oid = rsa_oid -> Rsa 471 | | oid when oid = dsa_oid || oid = dsa_oiw -> Dsa 472 | | oid when oid = ec_oid || oid = ec_dh || oid = ec_mqv -> Ec 473 | | oid when oid = dh_oid -> Dh 474 | | oid -> Unknown oid 475 | in 476 | let g = function 477 | | Rsa -> rsa_oid 478 | | Dsa -> dsa_oid 479 | | Ec -> ec_oid 480 | | Dh -> dh_oid 481 | | Unknown oid -> oid 482 | in 483 | map f g oid 484 | end 485 | 486 | let rsa_grammar = 487 | let open Asn.S in 488 | let f = function 489 | | (Algo.Rsa, _) -> () 490 | | (algo, _) -> 491 | parse_error "Algorithm %s and parameters don't match" 492 | (Algo.to_string algo) 493 | in 494 | let g () = (Algo.Rsa, Some ()) in 495 | map f g 496 | @@ sequence2 497 | (required ~label:"algorithm" Algo.grammar) 498 | (optional ~label:"parameters" Rsa.Params.grammar) 499 | 500 | let dsa_grammar = 501 | let open Asn.S in 502 | let f = function 503 | | (Algo.Dsa, params) -> params 504 | | (algo, _) -> 505 | parse_error "Algorithm %s and parameters don't match" 506 | (Algo.to_string algo) 507 | in 508 | let g params = (Algo.Dsa, params) in 509 | map f g 510 | @@ sequence2 511 | (required ~label:"algorithm" Algo.grammar) 512 | (required ~label:"parameters" Dsa.Params.grammar) 513 | 514 | let ec_grammar = 515 | let open Asn.S in 516 | let f = function 517 | | (Algo.Ec, params) -> params 518 | | (algo, _) -> 519 | parse_error "Algorithm %s and parameters don't match" 520 | (Algo.to_string algo) 521 | in 522 | let g params = (Algo.Ec, params) in 523 | map f g 524 | @@ sequence2 525 | (required ~label:"algorithm" Algo.grammar) 526 | (required ~label:"parameters" Ec.Params.grammar) 527 | 528 | let dh_grammar = 529 | let open Asn.S in 530 | let f = function 531 | | (Algo.Dh, params) -> params 532 | | (algo, _) -> 533 | parse_error "Algorithm %s and parameters don't match" 534 | (Algo.to_string algo) 535 | in 536 | let g params = (Algo.Dh, params) in 537 | map f g 538 | @@ sequence2 539 | (required ~label:"algorithm" Algo.grammar) 540 | (required ~label:"parameters" Dh.Params.grammar) 541 | end 542 | 543 | let map_result f = function 544 | | Result.Ok x -> Result.Ok (f x) 545 | | Result.Error _ as r -> r 546 | 547 | let default_result default = function 548 | | Result.Error _ -> default () 549 | | Result.Ok _ as r -> r 550 | 551 | module X509 = struct 552 | type t = 553 | [ `RSA of Rsa.Public.t 554 | | `DSA of Dsa.Params.t * Dsa.Public.t 555 | | `EC of Ec.Params.t * Ec.Public.t 556 | | `DH of Dh.Params.t * Dh.Public.t ] 557 | [@@deriving ord, eq, show] 558 | 559 | let rsa_grammar = 560 | let open Asn.S in 561 | let f ((), bit_string) = 562 | raise_asn @@ fun () -> Rsa.Public.decode bit_string 563 | in 564 | let g key = ((), Rsa.Public.encode key) in 565 | map f g 566 | @@ sequence2 567 | (required ~label:"algorithm" Algorithm_identifier.rsa_grammar) 568 | (required ~label:"subjectPublicKey" bit_string_cs) 569 | 570 | let dsa_grammar = 571 | let open Asn.S in 572 | let f (params, bit_string) = 573 | (params, raise_asn @@ fun () -> Dsa.Public.decode bit_string) 574 | in 575 | let g (params, key) = (params, Dsa.Public.encode key) in 576 | map f g 577 | @@ sequence2 578 | (required ~label:"algorithm" Algorithm_identifier.dsa_grammar) 579 | (required ~label:"subjectPublicKey" bit_string_cs) 580 | 581 | let ec_grammar = 582 | let open Asn.S in 583 | let f (params, bit_string) = (params, bit_string) in 584 | let g (params, key) = (params, key) in 585 | map f g 586 | @@ sequence2 587 | (required ~label:"algorithm" Algorithm_identifier.ec_grammar) 588 | (required ~label:"subjectPublicKey" bit_string_cs) 589 | 590 | let dh_grammar = 591 | let open Asn.S in 592 | let f (params, bit_string) = 593 | (params, raise_asn @@ fun () -> Dh.Public.decode bit_string) 594 | in 595 | let g (params, key) = (params, Dh.Public.encode key) in 596 | map f g 597 | @@ sequence2 598 | (required ~label:"algorithm" Algorithm_identifier.dh_grammar) 599 | (required ~label:"subjectPublicKey" bit_string_cs) 600 | 601 | let encode_rsa = encode_helper rsa_grammar 602 | let encode_dsa = encode_helper dsa_grammar 603 | let encode_ec = encode_helper ec_grammar 604 | let encode_dh = encode_helper dh_grammar 605 | 606 | let encode = function 607 | | `RSA key -> encode_rsa key 608 | | `DSA key -> encode_dsa key 609 | | `EC key -> encode_ec key 610 | | `DH key -> encode_dh key 611 | 612 | let decode_rsa = decode_helper "X509 RSA key" rsa_grammar 613 | let decode_dsa = decode_helper "X509 DSA key" dsa_grammar 614 | let decode_ec = decode_helper "X509 EC key" ec_grammar 615 | let decode_dh = decode_helper "X509 DH key" dh_grammar 616 | 617 | let decode key : (t, string) Result.result = 618 | map_result (fun x -> `RSA x) (decode_rsa key) 619 | |> default_result (fun () -> map_result (fun x -> `DSA x) (decode_dsa key)) 620 | |> default_result (fun () -> map_result (fun x -> `EC x) (decode_ec key)) 621 | |> default_result (fun () -> map_result (fun x -> `DH x) (decode_dh key)) 622 | |> default_result @@ fun () -> Result.Error "Couldn't parse key" 623 | end 624 | 625 | module PKCS8 = struct 626 | type t = 627 | [ `RSA of Rsa.Private.t 628 | | `DSA of Dsa.Params.t * Dsa.Private.t 629 | | `EC of Ec.Params.t * Ec.Private.t 630 | | `DH of Dh.Params.t * Dh.Private.t ] 631 | [@@deriving ord, eq, show] 632 | 633 | let rsa_grammar = 634 | let open Asn.S in 635 | let f (version, (), octet_string, _attributes) = 636 | if version = 0 then 637 | raise_asn @@ fun () -> Rsa.Private.decode octet_string 638 | else 639 | parse_error "PKCS8: version %d not supported" version 640 | in 641 | let g key = (0, (), Rsa.Private.encode key, None) in 642 | map f g 643 | @@ sequence4 644 | (required ~label:"version" int) 645 | (required ~label:"privateKeyAlgorithm" Algorithm_identifier.rsa_grammar) 646 | (required ~label:"privateKey" octet_string) 647 | (optional ~label:"attributes" @@ implicit 0 null) 648 | 649 | let dsa_grammar = 650 | let open Asn.S in 651 | let f (version, params, octet_string, _attributes) = 652 | if version = 0 then 653 | (params, raise_asn @@ fun () -> Dsa.Private.decode octet_string) 654 | else 655 | parse_error "PKCS8: version %d not supported" version 656 | in 657 | let g (params, key) = (0, params, Dsa.Private.encode key, None) in 658 | map f g 659 | @@ sequence4 660 | (required ~label:"version" int) 661 | (required ~label:"privateKeyAlgorithm" Algorithm_identifier.dsa_grammar) 662 | (required ~label:"privateKey" octet_string) 663 | (optional ~label:"attributes" @@ implicit 0 null) 664 | 665 | let ec_grammar = 666 | let open Asn.S in 667 | let f (version, params, octet_string, _attributes) = 668 | if version = 0 then 669 | (params, raise_asn @@ fun () -> Ec.Private.decode octet_string) 670 | else 671 | parse_error "PKCS8: version %d not supported" version 672 | in 673 | let g (params, key) = (0, params, Ec.Private.encode key, None) in 674 | map f g 675 | @@ sequence4 676 | (required ~label:"version" int) 677 | (required ~label:"privateKeyAlgorithm" Algorithm_identifier.ec_grammar) 678 | (required ~label:"privateKey" octet_string) 679 | (optional ~label:"attributes" @@ implicit 0 null) 680 | 681 | let dh_grammar = 682 | let open Asn.S in 683 | let f (version, params, octet_string, _attributes) = 684 | if version = 0 then 685 | (params, raise_asn @@ fun () -> Dh.Private.decode octet_string) 686 | else 687 | parse_error "PKCS8: version %d not supported" version 688 | in 689 | let g (params, key) = (0, params, Dh.Private.encode key, None) in 690 | map f g 691 | @@ sequence4 692 | (required ~label:"version" int) 693 | (required ~label:"privateKeyAlgorithm" Algorithm_identifier.dh_grammar) 694 | (required ~label:"privateKey" octet_string) 695 | (optional ~label:"attributes" @@ implicit 0 null) 696 | 697 | let encode_rsa = encode_helper rsa_grammar 698 | let encode_dsa = encode_helper dsa_grammar 699 | let encode_ec = encode_helper ec_grammar 700 | let encode_dh = encode_helper dh_grammar 701 | 702 | let encode = function 703 | | `RSA key -> encode_rsa key 704 | | `DSA key -> encode_dsa key 705 | | `EC key -> encode_ec key 706 | | `DH key -> encode_dh key 707 | 708 | let decode_rsa = decode_helper "PKCS8 RSA key" rsa_grammar 709 | let decode_dsa = decode_helper "PKCS8 DSA key" dsa_grammar 710 | let decode_ec = decode_helper "PKCS8 EC key" ec_grammar 711 | let decode_dh = decode_helper "PKCS8 DH key" dh_grammar 712 | 713 | let decode key : (t, string) Result.result = 714 | map_result (fun x -> `RSA x) (decode_rsa key) 715 | |> default_result (fun () -> map_result (fun x -> `DSA x) (decode_dsa key)) 716 | |> default_result (fun () -> map_result (fun x -> `EC x) (decode_ec key)) 717 | |> default_result (fun () -> map_result (fun x -> `DH x) (decode_dh key)) 718 | |> default_result @@ fun () -> Result.Error "Couldn't parse key" 719 | end 720 | 721 | module Dsa_private_key = struct 722 | type t = 723 | { p : Derivable.Z.t 724 | ; q : Derivable.Z.t 725 | ; g : Derivable.Z.t 726 | ; public_key : Derivable.Z.t 727 | ; private_key : Derivable.Z.t } 728 | [@@deriving ord, eq, show] 729 | 730 | let grammar = 731 | let open Asn.S in 732 | let f (_version, p, q, g, public_key, private_key) = 733 | {p; q; g; public_key; private_key} 734 | in 735 | let g {p; q; g; public_key; private_key} = 736 | (0, p, q, g, public_key, private_key) 737 | in 738 | map f g 739 | @@ sequence6 740 | (required ~label:"version" int) 741 | (required ~label:"p" integer) 742 | (required ~label:"q" integer) 743 | (required ~label:"g" integer) 744 | (required ~label:"publicKey" integer) 745 | (required ~label:"privateKey" integer) 746 | 747 | let encode = encode_helper grammar 748 | let decode = decode_helper "Private DSA key" grammar 749 | end 750 | -------------------------------------------------------------------------------- /lib/asn1.mli: -------------------------------------------------------------------------------- 1 | (** Parsers for RSA PKCS#1 and RSA, DSA, DH and EC PKCS#8 and X509 formats *) 2 | 3 | module Rsa : sig 4 | module Params : sig 5 | type t = unit 6 | 7 | val grammar : t Asn.t 8 | end 9 | 10 | module Public : sig 11 | type t = 12 | { n : Z.t 13 | ; e : Z.t } 14 | [@@deriving ord, eq, show] 15 | 16 | val grammar : t Asn.t 17 | val encode : t -> Cstruct.t 18 | val decode : Cstruct.t -> (t, string) Result.result 19 | end 20 | 21 | module Private : sig 22 | type other_prime = 23 | { r : Z.t 24 | ; d : Z.t 25 | ; t : Z.t } 26 | [@@deriving ord, eq, show] 27 | 28 | type t = 29 | { n : Z.t 30 | ; e : Z.t 31 | ; d : Z.t 32 | ; p : Z.t 33 | ; q : Z.t 34 | ; dp : Z.t 35 | ; dq : Z.t 36 | ; qinv : Z.t 37 | ; other_primes : other_prime list } 38 | [@@deriving ord, eq, show] 39 | 40 | val other_prime_grammar : other_prime Asn.t 41 | val grammar : t Asn.t 42 | val encode : t -> Cstruct.t 43 | val decode : Cstruct.t -> (t, string) Result.result 44 | end 45 | end 46 | 47 | module Dsa : sig 48 | module Params : sig 49 | type t = 50 | { p : Z.t 51 | ; q : Z.t 52 | ; g : Z.t } 53 | [@@deriving ord, eq, show] 54 | 55 | val grammar : t Asn.t 56 | val encode : t -> Cstruct.t 57 | val decode : Cstruct.t -> (t, string) Result.result 58 | end 59 | 60 | module Public : sig 61 | type t = Z.t [@@deriving ord, eq, show] 62 | 63 | val grammar : t Asn.t 64 | val encode : t -> Cstruct.t 65 | val decode : Cstruct.t -> (t, string) Result.result 66 | end 67 | 68 | module Private : sig 69 | type t = Z.t [@@deriving ord, eq, show] 70 | 71 | val grammar : t Asn.t 72 | val encode : t -> Cstruct.t 73 | val decode : Cstruct.t -> (t, string) Result.result 74 | end 75 | end 76 | 77 | module Ec : sig 78 | type point = Cstruct.t [@@deriving ord, eq, show] 79 | 80 | val point_grammar : point Asn.t 81 | 82 | module Field : sig 83 | type basis = 84 | | GN 85 | | TP of Z.t 86 | | PP of Z.t * Z.t * Z.t 87 | [@@deriving ord, eq, show] 88 | 89 | val basis_grammar : basis Asn.t 90 | 91 | type characteristic_two_params = 92 | { m : Z.t 93 | ; basis : basis } 94 | [@@deriving ord, eq, show] 95 | 96 | val ctwo_params_grammar : characteristic_two_params Asn.t 97 | 98 | type t = 99 | | Prime of Z.t 100 | | C_two of characteristic_two_params 101 | [@@deriving ord, eq, show] 102 | 103 | val grammar : t Asn.t 104 | end 105 | 106 | module Specified_domain : sig 107 | type field_element = Cstruct.t [@@deriving eq, ord, show] 108 | 109 | val field_element_grammar : field_element Asn.t 110 | 111 | type curve = 112 | { a : field_element 113 | ; b : field_element 114 | ; seed : Cstruct.t option } 115 | [@@deriving ord, eq, show] 116 | 117 | val curve_grammar : curve Asn.t 118 | 119 | type t = 120 | { field : Field.t 121 | ; curve : curve 122 | ; base : point 123 | ; order : Z.t 124 | ; cofactor : Z.t option } 125 | [@@deriving ord, eq, show] 126 | 127 | val grammar : t Asn.t 128 | end 129 | 130 | module Params : sig 131 | type t = 132 | | Named of Asn.OID.t 133 | | Implicit 134 | | Specified of Specified_domain.t 135 | [@@deriving ord, eq, show] 136 | 137 | val grammar : t Asn.t 138 | val encode : t -> Cstruct.t 139 | val decode : Cstruct.t -> (t, string) Result.result 140 | end 141 | 142 | module Public : sig 143 | type t = point [@@deriving ord, eq, show] 144 | 145 | val grammar : t Asn.t 146 | val encode : t -> Cstruct.t 147 | val decode : Cstruct.t -> (t, string) Result.result 148 | end 149 | 150 | module Private : sig 151 | type t = 152 | { k : Cstruct.t 153 | ; params : Params.t option 154 | ; public_key : Public.t option } 155 | [@@deriving ord, eq, show] 156 | 157 | val grammar : t Asn.t 158 | val encode : t -> Cstruct.t 159 | val decode : Cstruct.t -> (t, string) Result.result 160 | end 161 | end 162 | 163 | module Dh : sig 164 | module Params : sig 165 | type t = 166 | { p : Z.t 167 | ; g : Z.t 168 | ; l : Z.t option } 169 | [@@deriving ord, eq, show] 170 | 171 | val grammar : t Asn.t 172 | val encode : t -> Cstruct.t 173 | val decode : Cstruct.t -> (t, string) Result.result 174 | end 175 | 176 | module Public : sig 177 | type t = Z.t [@@deriving ord, eq, show] 178 | 179 | val grammar : t Asn.t 180 | val encode : t -> Cstruct.t 181 | val decode : Cstruct.t -> (t, string) Result.result 182 | end 183 | 184 | module Private : sig 185 | type t = Z.t [@@deriving ord, eq, show] 186 | 187 | val grammar : t Asn.t 188 | val encode : t -> Cstruct.t 189 | val decode : Cstruct.t -> (t, string) Result.result 190 | end 191 | end 192 | 193 | module Algorithm_identifier : sig 194 | val rsa_grammar : Rsa.Params.t Asn.t 195 | val dsa_grammar : Dsa.Params.t Asn.t 196 | val ec_grammar : Ec.Params.t Asn.t 197 | val dh_grammar : Dh.Params.t Asn.t 198 | end 199 | 200 | module X509 : sig 201 | type t = 202 | [ `RSA of Rsa.Public.t 203 | | `DSA of Dsa.Params.t * Dsa.Public.t 204 | | `EC of Ec.Params.t * Ec.Public.t 205 | | `DH of Dh.Params.t * Dh.Public.t ] 206 | [@@deriving ord, eq, show] 207 | 208 | val rsa_grammar : Rsa.Public.t Asn.t 209 | val dsa_grammar : (Dsa.Params.t * Dsa.Public.t) Asn.t 210 | val ec_grammar : (Ec.Params.t * Ec.Public.t) Asn.t 211 | val dh_grammar : (Dh.Params.t * Dh.Public.t) Asn.t 212 | val encode : t -> Cstruct.t 213 | val encode_rsa : Rsa.Public.t -> Cstruct.t 214 | val encode_dsa : Dsa.Params.t * Dsa.Public.t -> Cstruct.t 215 | val encode_ec : Ec.Params.t * Ec.Public.t -> Cstruct.t 216 | val encode_dh : Dh.Params.t * Dh.Public.t -> Cstruct.t 217 | val decode : Cstruct.t -> (t, string) Result.result 218 | val decode_rsa : Cstruct.t -> (Rsa.Public.t, string) Result.result 219 | 220 | val decode_dsa : 221 | Cstruct.t -> (Dsa.Params.t * Dsa.Public.t, string) Result.result 222 | 223 | val decode_ec : Cstruct.t -> (Ec.Params.t * Ec.Public.t, string) Result.result 224 | val decode_dh : Cstruct.t -> (Dh.Params.t * Dh.Public.t, string) Result.result 225 | end 226 | 227 | module PKCS8 : sig 228 | type t = 229 | [ `RSA of Rsa.Private.t 230 | | `DSA of Dsa.Params.t * Dsa.Private.t 231 | | `EC of Ec.Params.t * Ec.Private.t 232 | | `DH of Dh.Params.t * Dh.Private.t ] 233 | [@@deriving ord, eq, show] 234 | 235 | val rsa_grammar : Rsa.Private.t Asn.t 236 | val dsa_grammar : (Dsa.Params.t * Dsa.Private.t) Asn.t 237 | val ec_grammar : (Ec.Params.t * Ec.Private.t) Asn.t 238 | val dh_grammar : (Dh.Params.t * Dh.Private.t) Asn.t 239 | val encode : t -> Cstruct.t 240 | val encode_rsa : Rsa.Private.t -> Cstruct.t 241 | val encode_dsa : Dsa.Params.t * Dsa.Private.t -> Cstruct.t 242 | val encode_ec : Ec.Params.t * Ec.Private.t -> Cstruct.t 243 | val encode_dh : Dh.Params.t * Dh.Private.t -> Cstruct.t 244 | val decode : Cstruct.t -> (t, string) Result.result 245 | val decode_rsa : Cstruct.t -> (Rsa.Private.t, string) Result.result 246 | 247 | val decode_dsa : 248 | Cstruct.t -> (Dsa.Params.t * Dsa.Private.t, string) Result.result 249 | 250 | val decode_ec : 251 | Cstruct.t -> (Ec.Params.t * Ec.Private.t, string) Result.result 252 | 253 | val decode_dh : 254 | Cstruct.t -> (Dh.Params.t * Dh.Private.t, string) Result.result 255 | end 256 | 257 | module Dsa_private_key : sig 258 | type t = 259 | { p : Derivable.Z.t 260 | ; q : Derivable.Z.t 261 | ; g : Derivable.Z.t 262 | ; public_key : Derivable.Z.t 263 | ; private_key : Derivable.Z.t } 264 | [@@deriving ord, eq, show] 265 | 266 | val grammar : t Asn.t 267 | val encode : t -> Cstruct.t 268 | val decode : Cstruct.t -> (t, string) Result.result 269 | end 270 | -------------------------------------------------------------------------------- /lib/cvc.ml: -------------------------------------------------------------------------------- 1 | let base_rsa_oid = Asn.OID.(base 0 4 <|| [0; 127; 0; 7; 2; 2; 2; 1]) 2 | let base_ecdsa_oid = Asn.OID.(base 0 4 <|| [0; 127; 0; 7; 2; 2; 2; 2]) 3 | 4 | let rsa_oids = 5 | let open Asn.OID in 6 | [ base_rsa_oid 7 | ; base_rsa_oid <| 1 8 | ; base_rsa_oid <| 2 9 | ; base_rsa_oid <| 3 10 | ; base_rsa_oid <| 4 11 | ; base_rsa_oid <| 5 12 | ; base_rsa_oid <| 6 ] 13 | 14 | let ecdsa_oids = 15 | let open Asn.OID in 16 | [ base_ecdsa_oid 17 | ; base_ecdsa_oid <| 1 18 | ; base_ecdsa_oid <| 2 19 | ; base_ecdsa_oid <| 3 20 | ; base_ecdsa_oid <| 4 21 | ; base_ecdsa_oid <| 5 ] 22 | 23 | type algo_typ = 24 | | Rsa of Asn.OID.t 25 | | Ecdsa of Asn.OID.t 26 | | Unknown of Asn.OID.t 27 | 28 | type parser_state = 29 | | Init 30 | | Type 31 | | Length 32 | | Value of int 33 | 34 | let cvc_object_types = 35 | [ (0x7F49, (`PUBLIC_KEY, true)) 36 | ; (0x06, (`OID, false)) 37 | ; (0x81, (`MODULUS, false)) 38 | ; (0x82, (`EXPONENT, false)) 39 | ; (0x82, (`COEFFICIENT_A, false)) 40 | ; (0x83, (`COEFFICIENT_B, false)) 41 | ; (0x84, (`BASE_POINT_G, false)) 42 | ; (0x85, (`BASE_POINT_R_ORDER, false)) 43 | ; (0x86, (`PUBLIC_POINT_Y, false)) 44 | ; (0x87, (`COFACTOR_F, false)) ] 45 | 46 | let find_cvc_object_type tag = 47 | let code = Cstruct.get_uint8 tag 0 in 48 | try (code, List.assoc code cvc_object_types) with 49 | | Not_found -> 50 | let code = 51 | let msb = code * 0x100 in 52 | let lsb = Cstruct.get_uint8 tag 1 in 53 | msb + lsb 54 | in 55 | (code, List.assoc code cvc_object_types) 56 | 57 | (* utility function to parse a big-endian blob as a Derivable.Z.t *) 58 | let atoz_bigendian s = 59 | let reverse s = 60 | let n = String.length s in 61 | String.init n (fun i -> s.[n - 1 - i]) 62 | in 63 | Z.of_bits @@ reverse @@ Cstruct.to_string s 64 | 65 | let grammar = 66 | let open Asn.S in 67 | let f = function 68 | | oid when List.mem oid rsa_oids -> Rsa oid 69 | | oid when List.mem oid ecdsa_oids -> Ecdsa oid 70 | | oid -> Unknown oid 71 | in 72 | let g = function 73 | | Rsa oid -> oid 74 | | Ecdsa oid -> oid 75 | | Unknown oid -> oid 76 | in 77 | map f g oid 78 | 79 | let decode_oid str = 80 | match Asn.(decode (codec ber grammar) str) with 81 | | Ok (t, left) when Cstruct.length left = 0 -> t 82 | | Ok _ -> Asn.S.parse_error "CVC: OID with leftover" 83 | | Error _ -> Asn.S.parse_error "Cannot parse CVC OID" 84 | 85 | let decode bytes = 86 | let buffer = Cstruct.create 4_096 in 87 | (* FSM to produce `Type ..., `Length ..., `Value ... tokens from a blob. 88 | * This tries to exploit tailcall recursion as much as possible in order to 89 | * avoid a stack explosion 90 | *) 91 | let rec tokenize ~acc bytes i lim state = function 92 | | Init -> 93 | if i >= lim then 94 | List.rev acc 95 | else 96 | tokenize ~acc bytes i lim None Type 97 | | Type -> ( 98 | Cstruct.blit bytes i buffer 0 2; 99 | let cvc_type = find_cvc_object_type buffer in 100 | let acc = `Type cvc_type :: acc in 101 | match cvc_type with 102 | | (tag, _) when tag <= 0xff -> 103 | let i = i + 1 in 104 | tokenize ~acc bytes i lim (Some cvc_type) Length 105 | | (_, _) -> 106 | let i = i + 2 in 107 | tokenize ~acc bytes i lim (Some cvc_type) Length) 108 | | Length -> ( 109 | let code = Cstruct.get_uint8 bytes i in 110 | if code < 0x80 then 111 | let i = i + 1 in 112 | tokenize ~acc:(`Length code :: acc) bytes i lim state (Value code) 113 | else 114 | match code with 115 | | 0x81 -> 116 | let code = Cstruct.get_uint8 bytes (i + 1) in 117 | let i = i + 2 in 118 | tokenize ~acc:(`Length code :: acc) bytes i lim state (Value code) 119 | | 0x82 -> 120 | let code = Cstruct.BE.get_uint16 bytes (i + 1) in 121 | let i = i + 3 in 122 | tokenize ~acc:(`Length code :: acc) bytes i lim state (Value code) 123 | | _ -> raise (Failure "Invalid LENGTH field in TLV encoded CVC data")) 124 | | Value length -> 125 | let is_rec = 126 | match state with 127 | | None -> false 128 | | Some (_, (_, x)) -> x 129 | in 130 | let acc = 131 | if is_rec then 132 | `Value (tokenize ~acc:[] bytes i (i + length) None Init) :: acc 133 | else 134 | let bytes' = Cstruct.sub bytes i length in 135 | `Bytes bytes' :: acc 136 | in 137 | if length + i >= Cstruct.length bytes then 138 | List.rev acc 139 | else 140 | tokenize ~acc bytes (i + length) lim None Init 141 | in 142 | let tokens = tokenize ~acc:[] bytes 0 (Cstruct.length bytes) None Init in 143 | let rec parse = function 144 | | `Type (_, (`PUBLIC_KEY, _)) :: `Length _ :: `Value ls :: _ -> parse ls 145 | | `Type (_, (`OID, _)) :: `Length _ :: `Bytes bytes :: tl -> 146 | let bytes = 147 | let prefix = 148 | Printf.sprintf "\006%c" (Char.chr (Cstruct.length bytes)) 149 | |> Cstruct.of_string 150 | in 151 | Cstruct.append prefix bytes 152 | in 153 | `Oid (decode_oid bytes) :: parse tl 154 | | `Type (_, (`MODULUS, _)) :: `Length _ :: `Bytes bytes :: tl -> 155 | `Modulus (atoz_bigendian bytes) :: parse tl 156 | | `Type (0x82, ((*`EXPONENT or COEFFICIENT_A *) _, _)) 157 | :: `Length _ 158 | :: `Bytes bytes 159 | :: tl -> 160 | `Exponent bytes :: parse tl 161 | | `Type (_, (`COEFFICIENT_B, _)) :: `Length _ :: `Bytes bytes :: tl -> 162 | `Coefficient_b bytes :: parse tl 163 | | `Type (_, (`BASE_POINT_G, _)) :: `Length _ :: `Bytes bytes :: tl -> 164 | `Base_point_g bytes :: parse tl 165 | | `Type (_, (`BASE_POINT_R_ORDER, _)) :: `Length _ :: `Bytes bytes :: tl -> 166 | `Base_point_r_order (atoz_bigendian bytes) :: parse tl 167 | | `Type (_, (`PUBLIC_POINT_Y, _)) :: `Length _ :: `Bytes bytes :: tl -> 168 | `Public_point_y bytes :: parse tl 169 | | `Type (_, (`COFACTOR_F, _)) :: `Length _ :: `Bytes bytes :: tl -> 170 | `Cofactor_f (atoz_bigendian bytes) :: parse tl 171 | | [] -> [] 172 | | `Type (_, _) :: tl 173 | | `Length _ :: tl 174 | | `Bytes _ :: tl 175 | | `Value _ :: tl -> 176 | parse tl 177 | in 178 | let symbols = parse tokens in 179 | let oid = 180 | try 181 | let x = 182 | List.find 183 | (function 184 | | `Oid _ -> true 185 | | _ -> false) 186 | symbols 187 | in 188 | match x with 189 | | `Oid x -> Some x 190 | | _ -> None 191 | with 192 | | Not_found -> None 193 | in 194 | let open Result in 195 | match oid with 196 | | Some (Rsa _) -> ( 197 | match symbols with 198 | | [`Oid _; `Modulus n; `Exponent e] -> Ok (`Rsa (n, atoz_bigendian e)) 199 | | _ -> 200 | Error "Parse error: some elements are missing or are not correctly sorted" 201 | ) 202 | | Some (Ecdsa _) -> ( 203 | match symbols with 204 | | [ `Oid _ 205 | ; `Modulus modulus 206 | ; `Exponent (* `Coefficient_a *) coefficient_a 207 | ; `Coefficient_b coefficient_b 208 | ; `Base_point_g base_point_g 209 | ; `Base_point_r_order base_point_r_order 210 | ; `Public_point_y public_point_y 211 | ; `Cofactor_f cofactor_f ] -> 212 | Ok 213 | (`Ecdsa 214 | ( modulus 215 | , coefficient_a 216 | , coefficient_b 217 | , base_point_g 218 | , base_point_r_order 219 | , public_point_y 220 | , cofactor_f )) 221 | | _ -> 222 | Error "Parse error: some elements are missing or are not correctly sorted" 223 | ) 224 | | Some (Unknown oid) -> 225 | Error (Printf.sprintf "unknown OID \"%s\"." (Derivable.Asn_oid.show oid)) 226 | | None -> Error "invalid CVC key: OID not found" 227 | 228 | module Rsa = struct 229 | module Public = struct 230 | type t = 231 | { n : Derivable.Z.t 232 | ; e : Derivable.Z.t } 233 | [@@deriving eq, ord, show] 234 | 235 | let decode bytes = 236 | let open Result in 237 | match decode bytes with 238 | | Ok (`Rsa (n, e)) -> Ok {n; e} 239 | | Ok (`Ecdsa _) 240 | | Ok `Unknown -> 241 | Error "CVC: Algorithm OID and parameters do not match." 242 | | Error _ as err -> err 243 | end 244 | end 245 | 246 | module Ec = struct 247 | module Public = struct 248 | type t = 249 | { modulus : Derivable.Z.t 250 | ; coefficient_a : Derivable.Cstruct.t 251 | ; coefficient_b : Derivable.Cstruct.t 252 | ; base_point_g : Derivable.Cstruct.t 253 | ; base_point_r_order : Derivable.Z.t 254 | ; public_point_y : Derivable.Cstruct.t 255 | ; cofactor_f : Derivable.Z.t } 256 | [@@deriving eq, ord, show] 257 | 258 | let decode bytes = 259 | let open Result in 260 | match decode bytes with 261 | | Ok 262 | (`Ecdsa 263 | ( modulus 264 | , coefficient_a 265 | , coefficient_b 266 | , base_point_g 267 | , base_point_r_order 268 | , public_point_y 269 | , cofactor_f )) -> 270 | Ok 271 | { modulus 272 | ; coefficient_a 273 | ; coefficient_b 274 | ; base_point_g 275 | ; base_point_r_order 276 | ; public_point_y 277 | ; cofactor_f } 278 | | Ok (`Rsa _) 279 | | Ok `Unknown -> 280 | Error "CVC: Algorithm OID and parameters do not match." 281 | | Error _ as err -> err 282 | end 283 | end 284 | -------------------------------------------------------------------------------- /lib/cvc.mli: -------------------------------------------------------------------------------- 1 | (** Parsers for RSA and EC Card Verifiable Certificate key formats *) 2 | 3 | module Rsa : sig 4 | module Public : sig 5 | type t = 6 | { n : Z.t 7 | ; e : Z.t } 8 | [@@deriving eq, ord, show] 9 | 10 | val decode : Cstruct.t -> (t, string) Result.result 11 | end 12 | end 13 | 14 | module Ec : sig 15 | module Public : sig 16 | type t = 17 | { modulus : Z.t 18 | ; coefficient_a : Cstruct.t 19 | ; coefficient_b : Cstruct.t 20 | ; base_point_g : Cstruct.t 21 | ; base_point_r_order : Z.t 22 | ; public_point_y : Cstruct.t 23 | ; cofactor_f : Z.t } 24 | [@@deriving eq, ord, show] 25 | 26 | val decode : Cstruct.t -> (t, string) Result.result 27 | end 28 | end 29 | -------------------------------------------------------------------------------- /lib/derivable.ml: -------------------------------------------------------------------------------- 1 | let pp_of_to_string to_string fmt x = Format.pp_print_string fmt (to_string x) 2 | 3 | module Z = struct 4 | type t = Z.t [@@deriving eq, ord] 5 | 6 | let show = Z.to_string 7 | let pp = pp_of_to_string show 8 | end 9 | 10 | module Cstruct = struct 11 | type t = Cstruct.t [@@deriving eq, ord] 12 | 13 | let to_hex_string cs = 14 | let (`Hex hs) = Hex.of_cstruct cs in 15 | hs 16 | 17 | let show = to_hex_string 18 | let pp = pp_of_to_string show 19 | end 20 | 21 | module Asn_oid = struct 22 | type t = Asn.OID.t [@@deriving eq, ord, show] 23 | end 24 | -------------------------------------------------------------------------------- /lib/derivable.mli: -------------------------------------------------------------------------------- 1 | module Z : sig 2 | type t = Z.t [@@deriving eq, ord, show] 3 | end 4 | 5 | module Cstruct : sig 6 | type t = Cstruct.t [@@deriving eq, ord, show] 7 | end 8 | 9 | module Asn_oid : sig 10 | type t = Asn.OID.t [@@deriving eq, ord, show] 11 | end 12 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name key_parsers) 3 | (public_name key-parsers) 4 | (libraries asn1-combinators hex result str zarith) 5 | (preprocess 6 | (pps ppx_deriving.std))) 7 | -------------------------------------------------------------------------------- /lib/ltpa.ml: -------------------------------------------------------------------------------- 1 | (** Read a big-endian arbitrary length number *) 2 | let get_z_be cs off len = 3 | let r = ref Z.zero in 4 | let base = Z.of_int 0x100 in 5 | for i = off to off + len - 1 do 6 | r := Z.add (Z.mul base !r) @@ Z.of_int @@ Cstruct.get_uint8 cs i 7 | done; 8 | !r 9 | 10 | module Rsa = struct 11 | (** If public exponent is not 0x10001, it is unclear how to parse the key *) 12 | let check_public_exponent e = 13 | if not (Z.equal e (Z.of_int 0x10001)) then 14 | invalid_arg ("RSA_LTPA: invalid public exponent: " ^ Z.to_string e) 15 | 16 | module Private = struct 17 | type t = 18 | { e : Derivable.Z.t 19 | ; d : Derivable.Z.t 20 | ; p : Derivable.Z.t 21 | ; q : Derivable.Z.t } 22 | [@@deriving ord, eq, show] 23 | 24 | let decode cs = 25 | try 26 | let d_len = Int32.to_int @@ Cstruct.BE.get_uint32 cs 0 in 27 | let d = get_z_be cs 4 d_len in 28 | let e_off = 4 + d_len in 29 | let e_len = 3 in 30 | let e = get_z_be cs e_off e_len in 31 | check_public_exponent e; 32 | let p_len = (d_len / 2) + 1 in 33 | let p_off = e_off + 3 in 34 | let p = get_z_be cs p_off p_len in 35 | let q = get_z_be cs (p_off + p_len) p_len in 36 | Result.Ok {e; d; p; q} 37 | with 38 | | Invalid_argument s -> Result.Error s 39 | end 40 | 41 | module Public = struct 42 | type t = 43 | { e : Derivable.Z.t 44 | ; n : Derivable.Z.t } 45 | [@@deriving ord, eq, show] 46 | 47 | let decode cs = 48 | try 49 | let e_off = Cstruct.length cs - 3 in 50 | let e_len = 3 in 51 | let e = get_z_be cs e_off e_len in 52 | check_public_exponent e; 53 | let n_len = e_off in 54 | let n = get_z_be cs 0 n_len in 55 | Result.Ok {e; n} 56 | with 57 | | Invalid_argument s -> Result.Error s 58 | end 59 | end 60 | 61 | module RSA = Rsa 62 | -------------------------------------------------------------------------------- /lib/ltpa.mli: -------------------------------------------------------------------------------- 1 | (** Lightweight Third Party Authentication - keys used in IBM Websphere & Lotus Notes*) 2 | 3 | module Rsa : sig 4 | module Private : sig 5 | (** The format for private keys is: 6 | 7 | - 4 bytes: size of d encoded in big endian 8 | - d 9 | - 3 bytes: e (0x01 0x00 0x01) 10 | - p 11 | - q 12 | 13 | d, p and q are encoded with a leading 0x00. The size of p and q is 14 | determined from that of d (|p| = |q| = |d|/2 + 1). 15 | 16 | The format is a bit ambiguous if e is not 0x010001, so an error will be 17 | raised in that case. 18 | *) 19 | 20 | type t = 21 | { e : Z.t 22 | ; d : Z.t 23 | ; p : Z.t 24 | ; q : Z.t } 25 | [@@deriving eq, ord, show] 26 | 27 | val decode : Cstruct.t -> (t, string) Result.result 28 | end 29 | 30 | module Public : sig 31 | (** The format for public keys is: 32 | 33 | - n 34 | - e 35 | 36 | Here again there is an ambiguity, so e is assumed to be 0x010001: this 37 | is checked and an error is parsed if that is not the case. 38 | *) 39 | type t = 40 | { e : Z.t 41 | ; n : Z.t } 42 | [@@deriving eq, ord, show] 43 | 44 | val decode : Cstruct.t -> (t, string) Result.result 45 | end 46 | end 47 | 48 | module RSA = Rsa [@@ocaml.deprecated "Use module Rsa instead"] 49 | -------------------------------------------------------------------------------- /lib/pgp.ml: -------------------------------------------------------------------------------- 1 | let ( >>= ) = Result.bind 2 | let ( >|= ) result f = Result.map f result 3 | 4 | module Packet_error = struct 5 | type t = 6 | | Fatal of string 7 | | Header of 8 | { skip_length : int 9 | ; message : string } 10 | end 11 | 12 | let get_z_be cs ~off ~len = 13 | let r = ref Z.zero in 14 | let base = Z.of_int 0x100 in 15 | for i = off to off + len - 1 do 16 | r := Z.add (Z.mul base !r) @@ Z.of_int @@ Cstruct.get_uint8 cs i 17 | done; 18 | !r 19 | 20 | let decode_mpi_shift cs ~off = 21 | let bit_length = Cstruct.BE.get_uint16 cs off in 22 | let length = (bit_length / 8) + min 1 (bit_length mod 8) in 23 | let shifted_cs = Cstruct.shift cs (length + 2) in 24 | (shifted_cs, get_z_be cs ~off:(2 + off) ~len:length) 25 | 26 | module Algo = struct 27 | module Public = struct 28 | type t = 29 | | Rsa_enc_sign 30 | | Rsa_enc_only 31 | | Rsa_sign_only 32 | | Elgamal_enc_only 33 | | Dsa 34 | | Ec 35 | | Ecdsa 36 | | Unknown 37 | [@@deriving ord, eq, show] 38 | 39 | let of_int tag = 40 | match tag with 41 | | 1 -> Rsa_enc_sign 42 | | 2 -> Rsa_enc_only 43 | | 3 -> Rsa_sign_only 44 | | 16 -> Elgamal_enc_only 45 | | 17 -> Dsa 46 | | 18 -> Ec 47 | | 19 -> Ecdsa 48 | | _ -> Unknown 49 | 50 | let name algo = 51 | match algo with 52 | | Rsa_enc_sign -> "RSA Encryption & Signature" 53 | | Rsa_enc_only -> "RSA Encryption only" 54 | | Rsa_sign_only -> "RSA Signature only" 55 | | Elgamal_enc_only -> "Elgamal Encryption only" 56 | | Dsa -> "DSA" 57 | | Ec -> "EC" 58 | | Ecdsa -> "ECDSA" 59 | | Unknown -> "Unknown public algorithm" 60 | end 61 | 62 | module Hash = struct 63 | type t = 64 | | Md5 65 | | Sha1 66 | | Ripe_md160 67 | | Sha2_256 68 | | Sha2_384 69 | | Sha2_512 70 | | Sha2_224 71 | | Sha3_256 72 | | Sha3_512 73 | | Unknown_hash_algo 74 | [@@deriving ord, eq, show] 75 | 76 | let of_int tag = 77 | match tag with 78 | | 1 -> Md5 79 | | 2 -> Sha1 80 | | 3 -> Ripe_md160 81 | | 8 -> Sha2_256 82 | | 9 -> Sha2_384 83 | | 10 -> Sha2_512 84 | | 11 -> Sha2_224 85 | | 12 -> Sha3_256 86 | | 14 -> Sha3_512 87 | | _ -> Unknown_hash_algo 88 | 89 | let name algo = 90 | match algo with 91 | | Md5 -> "MD5" 92 | | Sha1 -> "SHA1" 93 | | Ripe_md160 -> "RIPE_MD160" 94 | | Sha2_256 -> "SHA2 256" 95 | | Sha2_384 -> "SHA2 384" 96 | | Sha2_512 -> "SHA2 512" 97 | | Sha2_224 -> "SHA2 224" 98 | | Sha3_256 -> "SHA3 256" 99 | | Sha3_512 -> "SHA3 512" 100 | | Unknown_hash_algo -> "Unknown hash algorithm" 101 | end 102 | 103 | module Symmetric = struct 104 | type t = 105 | | Plaintext 106 | | Idea 107 | | Triple_des 108 | | Cast_5 109 | | Blowfish 110 | | Aes_128 111 | | Aes_192 112 | | Aes_256 113 | | Twofish_256 114 | | Unknown 115 | 116 | let size algo = 117 | match algo with 118 | | Plaintext -> 0 119 | | Idea -> 8 120 | | Triple_des -> 8 121 | | Cast_5 -> 16 122 | | Blowfish -> 8 123 | | Aes_128 -> 16 124 | | Aes_192 -> 24 125 | | Aes_256 -> 32 126 | | Twofish_256 -> 32 127 | | Unknown -> 0 128 | 129 | let name algo = 130 | match algo with 131 | | Plaintext -> "Plain text" 132 | | Idea -> "IDEA" 133 | | Triple_des -> "Triple DES" 134 | | Cast_5 -> "Cast5" 135 | | Blowfish -> "Blowfish" 136 | | Aes_128 -> "AES 128" 137 | | Aes_192 -> "AES 192" 138 | | Aes_256 -> "AES 256" 139 | | Twofish_256 -> "Twofish 256" 140 | | Unknown -> "Unknown symmetric-key algorithm" 141 | 142 | let of_int tag = 143 | match tag with 144 | | 0 -> Plaintext 145 | | 1 -> Idea 146 | | 2 -> Triple_des 147 | | 3 -> Cast_5 148 | | 4 -> Blowfish 149 | | 7 -> Aes_128 150 | | 8 -> Aes_192 151 | | 9 -> Aes_256 152 | | 10 -> Twofish_256 153 | | _ -> Unknown 154 | end 155 | end 156 | 157 | module Rsa = struct 158 | module Public = struct 159 | type t = 160 | { n : Derivable.Z.t 161 | ; e : Derivable.Z.t } 162 | [@@deriving ord, eq, show] 163 | 164 | let decode packet ~off = 165 | let (cs, n) = decode_mpi_shift packet ~off in 166 | let (shifted_cs, e) = decode_mpi_shift cs ~off in 167 | let public_key = {n; e} in 168 | (shifted_cs, public_key) 169 | end 170 | 171 | module Private = struct 172 | type t = 173 | { d : Derivable.Z.t 174 | ; p : Derivable.Z.t 175 | ; q : Derivable.Z.t 176 | ; u : Derivable.Z.t } 177 | [@@deriving ord, eq, show] 178 | 179 | let decode packet ~off = 180 | let (cs1, d) = decode_mpi_shift packet ~off in 181 | let (cs2, p) = decode_mpi_shift cs1 ~off in 182 | let (cs3, q) = decode_mpi_shift cs2 ~off in 183 | let (shifted_cs, u) = decode_mpi_shift cs3 ~off in 184 | (shifted_cs, {d; p; q; u}) 185 | end 186 | end 187 | 188 | module Dsa = struct 189 | module Public = struct 190 | type t = 191 | { p : Derivable.Z.t 192 | ; q : Derivable.Z.t 193 | ; g : Derivable.Z.t 194 | ; y : Derivable.Z.t } 195 | [@@deriving ord, eq, show] 196 | 197 | let decode packet ~off = 198 | let (cs1, p) = decode_mpi_shift packet ~off in 199 | let (cs2, q) = decode_mpi_shift cs1 ~off in 200 | let (cs3, g) = decode_mpi_shift cs2 ~off in 201 | let (shifted_cs, y) = decode_mpi_shift cs3 ~off in 202 | (shifted_cs, {p; q; g; y}) 203 | end 204 | 205 | module Private = struct 206 | type t = Derivable.Z.t [@@deriving ord, eq, show] 207 | 208 | let decode packet ~off = decode_mpi_shift packet ~off 209 | end 210 | end 211 | 212 | module Elgamal = struct 213 | module Public = struct 214 | type t = 215 | { p : Derivable.Z.t 216 | ; g : Derivable.Z.t 217 | ; y : Derivable.Z.t } 218 | [@@deriving ord, eq, show] 219 | 220 | let decode packet ~off = 221 | let (cs1, p) = decode_mpi_shift packet ~off in 222 | let (cs2, g) = decode_mpi_shift cs1 ~off in 223 | let (shifted_cs, y) = decode_mpi_shift cs2 ~off in 224 | let public_key = {p; g; y} in 225 | (shifted_cs, public_key) 226 | end 227 | 228 | module Private = struct 229 | type t = Derivable.Z.t [@@deriving ord, eq, show] 230 | 231 | let decode packet ~off = decode_mpi_shift packet ~off 232 | end 233 | end 234 | 235 | module Packet = struct 236 | type packet_type = 237 | | Session_key 238 | | Signature 239 | | Secret_key 240 | | Public_key 241 | | Secret_subkey 242 | | Id 243 | | Marker 244 | | Public_subkey 245 | | Unknown_packet 246 | [@@deriving ord, eq, show] 247 | 248 | let of_int tag = 249 | match tag with 250 | | 0 -> Error "Tag 0" 251 | | 1 -> Ok Session_key 252 | | 2 -> Ok Signature 253 | | 5 -> Ok Secret_key 254 | | 6 -> Ok Public_key 255 | | 7 -> Ok Secret_subkey 256 | | 10 -> Ok Marker 257 | | 13 -> Ok Id 258 | | 14 -> Ok Public_subkey 259 | | _ -> Ok Unknown_packet 260 | 261 | let name packet = 262 | match packet with 263 | | Session_key -> "Session key packet" 264 | | Signature -> "Signature packet" 265 | | Secret_key -> "Secret Key packet" 266 | | Public_key -> "Public key packet" 267 | | Secret_subkey -> "Secret subkey packet" 268 | | Id -> "Identity packet" 269 | | Marker -> "Marker packet" 270 | | Public_subkey -> "Public subkey packet" 271 | | Unknown_packet -> "Unknown packet" 272 | 273 | module Header = struct 274 | type t = 275 | { packet_type : packet_type 276 | ; packet_length : int 277 | ; is_new : bool } 278 | [@@deriving ord, eq, show] 279 | 280 | let is_new_type header_code = 281 | if header_code >= 192 then 282 | Ok true 283 | else if header_code >= 128 then 284 | Ok false 285 | else 286 | Error (Packet_error.Fatal "Bad header code") 287 | 288 | let get_tag header_code = 289 | is_new_type header_code >|= fun is_new -> 290 | if is_new then 291 | (is_new, header_code - 192) 292 | else 293 | (is_new, (header_code - 128) / 4) 294 | 295 | let get_old_length_size length_tag = 296 | match length_tag with 297 | | 0 -> Ok 2 298 | | 1 -> Ok 3 299 | | 2 -> Ok 5 300 | | 3 -> Error "Length size not implemented" 301 | | _ -> Error "Bad length size" 302 | 303 | let get_old_length cs header_code = 304 | get_old_length_size (header_code mod 4) >>= fun n -> 305 | match n with 306 | | 2 -> Ok (n, Cstruct.get_uint8 cs 1) 307 | | 3 -> Ok (n, Cstruct.BE.get_uint16 cs 1) 308 | | 5 -> Ok (n, Int32.to_int (Cstruct.BE.get_uint32 cs 1)) 309 | | _ -> Error "Bad length size" 310 | 311 | let get_new_length cs = 312 | let first_byte = Cstruct.get_uint8 cs 1 in 313 | if first_byte < 192 then 314 | Ok (2, first_byte) 315 | else if first_byte < 224 then 316 | let second_byte = Cstruct.get_uint8 cs 2 in 317 | let length = 192 + second_byte + (256 * (first_byte - 192)) in 318 | Ok (3, length) 319 | else if first_byte < 255 then 320 | Error "Partial body lengths are not treated" 321 | else 322 | let length = Cstruct.BE.get_uint32 cs 2 in 323 | Ok (6, Int32.to_int length) 324 | 325 | let decode cs = 326 | let header_code = Cstruct.get_uint8 cs 0 in 327 | get_tag header_code >>= fun (is_new, tag) -> 328 | let length_infos = 329 | if is_new then 330 | get_new_length cs 331 | else 332 | get_old_length cs header_code 333 | in 334 | match length_infos with 335 | | Error error -> Error (Fatal error) 336 | | Ok (header_length, packet_length) -> ( 337 | match of_int tag with 338 | | Ok packet_type -> 339 | Ok (header_length, {packet_type; packet_length; is_new}) 340 | | Error message -> 341 | Error (Header {skip_length = header_length + packet_length; message})) 342 | end 343 | 344 | module Id = struct 345 | type t = string [@@deriving ord, eq, show] 346 | 347 | let decode cs = Cstruct.to_string cs 348 | end 349 | 350 | module Public_key = struct 351 | module Value = struct 352 | type t = 353 | | Rsa of Rsa.Public.t 354 | | Dsa of Dsa.Public.t 355 | | Elgamal of Elgamal.Public.t 356 | [@@deriving ord, eq, show] 357 | end 358 | 359 | type t = 360 | { version : int 361 | ; creation_time : int32 362 | ; validity_period : int32 option 363 | ; algo : Algo.Public.t 364 | ; public_key : Value.t } 365 | [@@deriving ord, eq, show] 366 | 367 | let decode_public_key (algo : Algo.Public.t) packet ~version = 368 | let offset = 369 | (*A public key packet has another header*) 370 | match version with 371 | | 2 372 | | 3 -> 373 | Ok 8 374 | (*and a version 2 or 3 public key packet also contains a validity period*) 375 | | 4 -> Ok 6 376 | | _ -> 377 | Error 378 | (Printf.sprintf "Unexpected public key packet version: %d" version) 379 | in 380 | offset >>= fun off -> 381 | match algo with 382 | | Rsa_enc_sign 383 | | Rsa_enc_only 384 | | Rsa_sign_only -> 385 | let (cs, key) = Rsa.Public.decode packet ~off in 386 | Ok (cs, Value.Rsa key) 387 | | Dsa -> 388 | let (cs, key) = Dsa.Public.decode packet ~off in 389 | Ok (cs, Dsa key) 390 | | Elgamal_enc_only -> 391 | let (cs, key) = Elgamal.Public.decode packet ~off in 392 | Ok (cs, Elgamal key) 393 | | Ec 394 | | Ecdsa 395 | | Unknown -> 396 | Error ("Unsupported algorithm: " ^ Algo.Public.name algo) 397 | 398 | let decode packet = 399 | let version = Cstruct.get_uint8 packet 0 in 400 | let creation_time = Cstruct.BE.get_uint32 packet 1 in 401 | (match version with 402 | | 4 -> 403 | let algo = Algo.Public.of_int (Cstruct.get_uint8 packet 5) in 404 | Ok (algo, None) 405 | | 2 406 | | 3 -> 407 | let algo = Algo.Public.of_int (Cstruct.get_uint8 packet 7) in 408 | let time = Cstruct.BE.get_uint16 packet 5 in 409 | Ok (algo, Some (Int32.of_int time)) 410 | | _ -> 411 | Error 412 | (Printf.sprintf "Unexpected public key packet version: %d" version)) 413 | >>= fun (algo, validity_period) -> 414 | decode_public_key algo packet ~version >|= fun (cs, public_key) -> 415 | (cs, {version; creation_time; validity_period; algo; public_key}) 416 | end 417 | 418 | module Private_key_value = struct 419 | type t = 420 | | Rsa of Rsa.Private.t 421 | | Dsa of Dsa.Private.t 422 | | Elgamal of Elgamal.Private.t 423 | [@@deriving ord, eq, show] 424 | end 425 | 426 | module Secret_key = struct 427 | module S2k = struct 428 | type s2k_type = 429 | | Simple 430 | | Salted 431 | | Iterated_salted 432 | | Unknown 433 | 434 | let of_int tag = 435 | match tag with 436 | | 0 -> Simple 437 | | 1 -> Salted 438 | | 3 -> Iterated_salted 439 | | _ -> Unknown 440 | 441 | let name specifier = 442 | match specifier with 443 | | Simple -> "Simple String2Key" 444 | | Salted -> "Salted String2Key" 445 | | Iterated_salted -> "Iterated&Salted String2Key" 446 | | Unknown -> "Unknown String2Key" 447 | 448 | type t = 449 | | Simple of Algo.Hash.t 450 | | Salted of Algo.Hash.t * int64 451 | | Iterated_salted of Algo.Hash.t * int64 * int 452 | [@@deriving ord, eq, show] 453 | end 454 | 455 | type t = 456 | { public_key : Public_key.t 457 | ; s2k : S2k.t option 458 | ; initial_vector : string option 459 | ; private_key : Private_key_value.t option 460 | ; checksum : string option 461 | ; hash : string option } 462 | [@@deriving ord, eq, show] 463 | 464 | let decode_s2k packet s2k_specifier = 465 | let hash_tag = Cstruct.get_uint8 packet 3 in 466 | let hash_algo = Algo.Hash.of_int hash_tag in 467 | match s2k_specifier with 468 | | S2k.Unknown -> Error "Unknown String2key" 469 | | Simple -> Ok (S2k.Simple hash_algo, 4) 470 | | Salted -> 471 | let salt_value = Cstruct.BE.get_uint64 packet 4 in 472 | Ok (S2k.Salted (hash_algo, salt_value), 12) 473 | | Iterated_salted -> 474 | let salt_value = Cstruct.BE.get_uint64 packet 4 in 475 | let count = Cstruct.get_uint8 packet 12 in 476 | Ok (S2k.Iterated_salted (hash_algo, salt_value, count), 13) 477 | 478 | let decode_private_key packet (algo : Algo.Public.t) = 479 | match algo with 480 | | Rsa_enc_sign 481 | | Rsa_enc_only 482 | | Rsa_sign_only -> 483 | let (cs, key) = Rsa.Private.decode packet ~off:0 in 484 | Ok (cs, Private_key_value.Rsa key) 485 | | Dsa -> 486 | let (cs, key) = Dsa.Private.decode packet ~off:0 in 487 | Ok (cs, Dsa key) 488 | | Elgamal_enc_only -> 489 | let (cs, key) = Elgamal.Private.decode packet ~off:0 in 490 | Ok (cs, Elgamal key) 491 | | Ec 492 | | Ecdsa 493 | | Unknown -> 494 | Error ("Not implemented for algorithm:" ^ Algo.Public.name algo) 495 | 496 | let decode_convention (public_key : Public_key.t) packet convention = 497 | match convention with 498 | | 0 -> 499 | let secret_packet = Cstruct.shift packet 1 in 500 | decode_private_key secret_packet public_key.algo 501 | >|= fun (cs, private_key) -> 502 | let checksum_int = Cstruct.BE.get_uint16 cs 0 in 503 | let checksum = Z.format "0x0100" (Z.of_int checksum_int) in 504 | { public_key 505 | ; s2k = None 506 | ; initial_vector = None 507 | ; private_key = Some private_key 508 | ; checksum = Some checksum 509 | ; hash = None } 510 | | 254 -> 511 | let sym_tag = Cstruct.get_uint8 packet 1 in 512 | let sym_algo = Algo.Symmetric.of_int sym_tag in 513 | let s2k_tag = Cstruct.get_uint8 packet 2 in 514 | let s2k_specifier = S2k.of_int s2k_tag in 515 | decode_s2k packet s2k_specifier >>= fun (s2k, offset) -> 516 | if offset <= Cstruct.length packet then 517 | let cs_shifted = Cstruct.shift packet offset in 518 | let cipher_block = Algo.Symmetric.size sym_algo in 519 | let initial_vector_z = get_z_be cs_shifted ~off:0 ~len:cipher_block in 520 | let initial_vector = Z.format "0x100" initial_vector_z in 521 | Ok 522 | { s2k = Some s2k 523 | ; public_key 524 | ; initial_vector = Some initial_vector 525 | ; private_key = None 526 | ; hash = None 527 | ; checksum = None } 528 | else 529 | Error "Bad offset in String2Key" 530 | | _ -> Error "Private key type not treated." 531 | 532 | let decode packet = 533 | Public_key.decode packet >>= fun (cs, public_key) -> 534 | let offset = 535 | match public_key.version with 536 | | 3 -> Ok 8 537 | | 4 -> Ok 6 538 | | version -> 539 | Error 540 | (Printf.sprintf "Unexpected public key packet version: %d" version) 541 | in 542 | offset >>= fun offset -> 543 | let secret_packet = Cstruct.shift cs offset in 544 | let convention = Cstruct.get_uint8 secret_packet 0 in 545 | decode_convention public_key secret_packet convention 546 | end 547 | 548 | module Signature = struct 549 | module Subpacket = struct 550 | type key_flag = 551 | | Certification 552 | | Sign_data 553 | | Encrypt_communication 554 | | Encrypt_storage 555 | | Split 556 | | Authentication 557 | | Private_shared 558 | | Unknown_flag 559 | [@@deriving ord, eq, show] 560 | 561 | let tag_to_keyflag tag = 562 | match tag with 563 | | 0 -> Certification 564 | | 1 -> Sign_data 565 | | 2 -> Encrypt_communication 566 | | 3 -> Encrypt_storage 567 | | 4 -> Split 568 | | 5 -> Authentication 569 | | 7 -> Private_shared 570 | | _ -> Unknown_flag 571 | 572 | type revocation_reason = 573 | | Key_superseded of string 574 | | Compromised of string 575 | | Key_retired of string 576 | | User_ID_not_valid of string 577 | | Unknown_reason of string 578 | [@@deriving ord, eq, show] 579 | 580 | type t = 581 | | Key_expiration_time of int32 582 | | Revocation_reason of revocation_reason 583 | | Issuer_id of string 584 | | Uses of key_flag list 585 | | Unknown 586 | [@@deriving ord, eq, show] 587 | 588 | let get_length cs = 589 | let first_byte = Cstruct.get_uint8 cs 0 in 590 | if first_byte < 192 then 591 | (1, first_byte) 592 | else if first_byte < 255 then 593 | let second_byte = Cstruct.get_uint8 cs 1 in 594 | let length = 192 + second_byte + (256 * (first_byte - 192)) in 595 | (2, length) 596 | else 597 | let length = Cstruct.BE.get_uint32 cs 1 in 598 | (5, Int32.to_int length) 599 | 600 | let rec keep_some opt_list = 601 | match opt_list with 602 | | Some x :: _list -> x :: keep_some _list 603 | | None :: _list -> keep_some _list 604 | | [] -> [] 605 | 606 | let decode_uses cs = 607 | let nth_bit x n = x land (1 lsl n) <> 0 in 608 | let flag_int = Cstruct.get_uint8 cs 1 in 609 | let map_tag tag flag = 610 | if flag then 611 | Some (tag_to_keyflag tag) 612 | else 613 | None 614 | in 615 | let flags = List.init 8 (nth_bit flag_int) in 616 | if List.nth flags 6 then 617 | Error (Printf.sprintf "Bad tag for a key flag: 0x40") 618 | else 619 | Ok (Uses (keep_some (List.mapi map_tag flags))) 620 | 621 | let decode_code_reason code : (string -> revocation_reason, string) result 622 | = 623 | match code with 624 | | 0 -> Ok (fun reason -> Unknown_reason reason) 625 | | 1 -> Ok (fun reason -> Key_superseded reason) 626 | | 2 -> Ok (fun reason -> Compromised reason) 627 | | 3 -> Ok (fun reason -> Key_retired reason) 628 | | i when 100 <= i && i <= 110 -> 629 | Ok (fun reason -> Unknown_reason reason) 630 | | 32 -> Ok (fun reason -> User_ID_not_valid reason) 631 | | code -> Error (Printf.sprintf "Bad revocation reason code: %i" code) 632 | 633 | let decode_revocation_reason cs = 634 | let code = Cstruct.get_uint8 cs 1 in 635 | decode_code_reason code >|= fun reason -> 636 | let reason_string = Cstruct.to_string ~off:2 cs in 637 | Revocation_reason (reason reason_string) 638 | 639 | let decode_subpacket cs = 640 | let type_code = Cstruct.get_uint8 cs 0 in 641 | match type_code with 642 | | 9 -> Ok (Key_expiration_time (Cstruct.BE.get_uint32 cs 1)) 643 | | 16 -> 644 | let id = Cstruct.BE.get_uint64 cs 1 in 645 | Ok (Issuer_id (Printf.sprintf "%Lx" id)) 646 | | 27 -> decode_uses cs 647 | | 29 -> decode_revocation_reason cs 648 | | _ -> Ok Unknown 649 | 650 | let rec decode_rec cs subpacket_list = 651 | if Cstruct.length cs != 0 then 652 | let (offset, length) = get_length cs in 653 | let next_cs = Cstruct.shift cs (length + offset) in 654 | let subpacket_cs = Cstruct.sub cs offset length in 655 | decode_subpacket subpacket_cs >>= fun subpacket -> 656 | decode_rec next_cs (subpacket :: subpacket_list) 657 | else 658 | Ok (List.rev subpacket_list) 659 | 660 | let decode cs = 661 | let is_filter_unknown_subpacket = function 662 | | Unknown -> false 663 | | _ -> true 664 | in 665 | decode_rec cs [] >|= fun subpacket_list -> 666 | List.filter is_filter_unknown_subpacket subpacket_list 667 | end 668 | 669 | type signature_type = 670 | | Revocation 671 | | Subkey_binding 672 | | User_certification 673 | | Other 674 | [@@deriving ord, eq, show] 675 | 676 | let tag_to_sigtype tag = 677 | match tag with 678 | | 16 679 | | 17 680 | | 18 681 | | 19 -> 682 | User_certification 683 | | 32 684 | | 40 -> 685 | Revocation 686 | | 24 -> Subkey_binding 687 | | _ -> Other 688 | 689 | type t = 690 | { tag : int 691 | ; version : int 692 | ; signature_type : signature_type 693 | ; subpackets : Subpacket.t list } 694 | [@@deriving ord, eq, show] 695 | 696 | let decode_v3 packet = 697 | let hash_material_len = Cstruct.get_uint8 packet 0 in 698 | let tag = Cstruct.get_uint8 packet 1 in 699 | let signature_type = tag_to_sigtype tag in 700 | if hash_material_len == 5 then 701 | let key_id_int = Cstruct.BE.get_uint64 packet 6 in 702 | let key_id = Printf.sprintf "%Lx" key_id_int in 703 | Ok {tag; version = 3; subpackets = [Issuer_id key_id]; signature_type} 704 | else 705 | Error "Bad hash material length in v3 signature packet" 706 | 707 | let decode_v4 packet = 708 | let tag = Cstruct.get_uint8 packet 0 in 709 | let hashed_subpackets_len = Cstruct.BE.get_uint16 packet 3 in 710 | let hashed_subpackets_cs = Cstruct.sub packet 5 hashed_subpackets_len in 711 | Subpacket.decode hashed_subpackets_cs >>= fun hashed_subpackets -> 712 | let unhashed_subpackets_len = 713 | Cstruct.BE.get_uint16 packet (5 + hashed_subpackets_len) 714 | in 715 | let unhashed_subpackets_cs = 716 | Cstruct.sub packet (7 + hashed_subpackets_len) unhashed_subpackets_len 717 | in 718 | Subpacket.decode unhashed_subpackets_cs >|= fun unhashed_subpackets -> 719 | let subpackets = hashed_subpackets @ unhashed_subpackets in 720 | let signature_type = tag_to_sigtype tag in 721 | {tag; version = 4; subpackets; signature_type} 722 | 723 | let decode packet = 724 | match Cstruct.get_uint8 packet 0 with 725 | | 3 -> decode_v3 (Cstruct.shift packet 1) 726 | | 4 -> decode_v4 (Cstruct.shift packet 1) 727 | | version -> 728 | Error 729 | ("Unexpected signature packet version number: " 730 | ^ Int.to_string version) 731 | end 732 | 733 | module Body = struct 734 | type t = 735 | | Id of Id.t 736 | | Secret_key of Secret_key.t 737 | | Public_key of Public_key.t 738 | | Signature of Signature.t 739 | | Secret_subkey of Secret_key.t 740 | | Public_subkey of Public_key.t 741 | | Marker 742 | | Unknown 743 | [@@deriving ord, eq, show] 744 | 745 | let decode packet_type packet = 746 | match (packet_type : packet_type) with 747 | | Id -> Ok (Id (Id.decode packet)) 748 | | Marker -> Ok Marker 749 | | Secret_key -> Secret_key.decode packet >|= fun key -> Secret_key key 750 | | Public_key -> 751 | Public_key.decode packet >|= fun (_, key) -> Public_key key 752 | | Signature -> 753 | Signature.decode packet >|= fun signature -> Signature signature 754 | | Secret_subkey -> 755 | Secret_key.decode packet >|= fun key -> Secret_subkey key 756 | | Public_subkey -> 757 | Public_key.decode packet >|= fun (_, key) -> Public_subkey key 758 | | Session_key 759 | | Unknown_packet -> 760 | Ok Unknown 761 | end 762 | 763 | type t = 764 | { header : Header.t 765 | ; packet : Body.t } 766 | [@@deriving ord, eq, show] 767 | 768 | let decode cs = 769 | Header.decode cs >>= fun (header_length, header) -> 770 | if header.packet_length + header_length <= Cstruct.length cs then 771 | let packet_cs = Cstruct.sub cs header_length header.packet_length in 772 | let res = Body.decode header.packet_type packet_cs in 773 | match res with 774 | | Error message -> 775 | Error 776 | (Header {skip_length = header_length + header.packet_length; message}) 777 | (*When a packet can't be parsed, but the header is correct*) 778 | | Ok packet -> 779 | let next_cs = Cstruct.shift cs (header_length + header.packet_length) in 780 | Ok (next_cs, {header; packet}) 781 | else 782 | Error (Fatal "Bad packet header: length is greater than packet size") 783 | end 784 | 785 | let rec decode_rec cs packet_list = 786 | if Cstruct.length cs != 0 then 787 | let decoded_packet = 788 | try Packet.decode cs with 789 | | _ -> Error (Fatal "Incorrect packet") 790 | in 791 | match decoded_packet with 792 | | Ok (next_cs, packet) -> decode_rec next_cs (Ok packet :: packet_list) 793 | | Error (Fatal message) -> List.rev (Error message :: packet_list) 794 | (* When the length of the header can't be parsed *) 795 | | Error (Header error) -> 796 | (*When the length of the header can be parsed*) 797 | let next_cs = Cstruct.shift cs error.skip_length in 798 | decode_rec next_cs (Error error.message :: packet_list) 799 | else 800 | List.rev packet_list 801 | 802 | let decode cs = decode_rec cs [] 803 | -------------------------------------------------------------------------------- /lib/pgp.mli: -------------------------------------------------------------------------------- 1 | module Packet_error : sig 2 | type t = 3 | | Fatal of string 4 | | Header of 5 | { skip_length : int 6 | ; message : string } 7 | end 8 | 9 | module Algo : sig 10 | module Public : sig 11 | type t = 12 | | Rsa_enc_sign 13 | | Rsa_enc_only 14 | | Rsa_sign_only 15 | | Elgamal_enc_only 16 | | Dsa 17 | | Ec 18 | | Ecdsa 19 | | Unknown 20 | [@@deriving ord, eq, show] 21 | 22 | val of_int : int -> t 23 | val name : t -> string 24 | end 25 | 26 | module Hash : sig 27 | type t = 28 | | Md5 29 | | Sha1 30 | | Ripe_md160 31 | | Sha2_256 32 | | Sha2_384 33 | | Sha2_512 34 | | Sha2_224 35 | | Sha3_256 36 | | Sha3_512 37 | | Unknown_hash_algo 38 | [@@deriving ord, eq, show] 39 | 40 | val of_int : int -> t 41 | val name : t -> string 42 | end 43 | 44 | module Symmetric : sig 45 | type t = 46 | | Plaintext 47 | | Idea 48 | | Triple_des 49 | | Cast_5 50 | | Blowfish 51 | | Aes_128 52 | | Aes_192 53 | | Aes_256 54 | | Twofish_256 55 | | Unknown 56 | 57 | val size : t -> int 58 | val name : t -> string 59 | val of_int : int -> t 60 | end 61 | end 62 | 63 | module Rsa : sig 64 | module Public : sig 65 | type t = 66 | { n : Derivable.Z.t 67 | ; e : Derivable.Z.t } 68 | [@@deriving ord, eq, show] 69 | 70 | val decode : Cstruct.t -> off:int -> Cstruct.t * t 71 | end 72 | 73 | module Private : sig 74 | type t = 75 | { d : Derivable.Z.t 76 | ; p : Derivable.Z.t 77 | ; q : Derivable.Z.t 78 | ; u : Derivable.Z.t } 79 | [@@deriving ord, eq, show] 80 | 81 | val decode : Cstruct.t -> off:int -> Cstruct.t * t 82 | end 83 | end 84 | 85 | module Dsa : sig 86 | module Public : sig 87 | type t = 88 | { p : Derivable.Z.t 89 | ; q : Derivable.Z.t 90 | ; g : Derivable.Z.t 91 | ; y : Derivable.Z.t } 92 | [@@deriving ord, eq, show] 93 | 94 | val decode : Cstruct.t -> off:int -> Cstruct.t * t 95 | end 96 | 97 | module Private : sig 98 | type t = Derivable.Z.t [@@deriving ord, eq, show] 99 | 100 | val decode : Cstruct.t -> off:int -> Cstruct.t * t 101 | end 102 | end 103 | 104 | module Elgamal : sig 105 | module Public : sig 106 | type t = 107 | { p : Derivable.Z.t 108 | ; g : Derivable.Z.t 109 | ; y : Derivable.Z.t } 110 | [@@deriving ord, eq, show] 111 | 112 | val decode : Cstruct.t -> off:int -> Cstruct.t * t 113 | end 114 | 115 | module Private : sig 116 | type t = Derivable.Z.t [@@deriving ord, eq, show] 117 | 118 | val decode : Cstruct.t -> off:int -> Cstruct.t * t 119 | end 120 | end 121 | 122 | module Packet : sig 123 | type packet_type = 124 | | Session_key 125 | | Signature 126 | | Secret_key 127 | | Public_key 128 | | Secret_subkey 129 | | Id 130 | | Marker 131 | | Public_subkey 132 | | Unknown_packet 133 | [@@deriving ord, eq, show] 134 | 135 | val name : packet_type -> string 136 | 137 | module Header : sig 138 | type t = 139 | { packet_type : packet_type 140 | ; packet_length : int 141 | ; is_new : bool } 142 | [@@deriving ord, eq, show] 143 | 144 | val decode : Cstruct.t -> (int * t, Packet_error.t) result 145 | end 146 | 147 | module Id : sig 148 | type t = string [@@deriving ord, eq, show] 149 | 150 | val decode : Cstruct.t -> t 151 | end 152 | 153 | module Public_key : sig 154 | module Value : sig 155 | type t = 156 | | Rsa of Rsa.Public.t 157 | | Dsa of Dsa.Public.t 158 | | Elgamal of Elgamal.Public.t 159 | [@@deriving ord, eq, show] 160 | end 161 | 162 | type t = 163 | { version : int 164 | ; creation_time : int32 165 | ; validity_period : int32 option 166 | ; algo : Algo.Public.t 167 | ; public_key : Value.t } 168 | [@@deriving ord, eq, show] 169 | 170 | val decode : Cstruct.t -> (Cstruct.t * t, string) result 171 | end 172 | 173 | module Private_key_value : sig 174 | type t = 175 | | Rsa of Rsa.Private.t 176 | | Dsa of Dsa.Private.t 177 | | Elgamal of Elgamal.Private.t 178 | [@@deriving ord, eq, show] 179 | end 180 | 181 | module Secret_key : sig 182 | module S2k : sig 183 | type s2k_type = 184 | | Simple 185 | | Salted 186 | | Iterated_salted 187 | | Unknown 188 | 189 | val name : s2k_type -> string 190 | 191 | type t = 192 | | Simple of Algo.Hash.t 193 | | Salted of Algo.Hash.t * int64 194 | | Iterated_salted of Algo.Hash.t * int64 * int 195 | [@@deriving ord, eq, show] 196 | end 197 | 198 | type t = 199 | { public_key : Public_key.t 200 | ; s2k : S2k.t option 201 | ; initial_vector : string option 202 | ; private_key : Private_key_value.t option 203 | ; checksum : string option 204 | ; hash : string option } 205 | [@@deriving ord, eq, show] 206 | 207 | val decode : Cstruct.t -> (t, string) result 208 | end 209 | 210 | module Signature : sig 211 | module Subpacket : sig 212 | type key_flag = 213 | | Certification 214 | | Sign_data 215 | | Encrypt_communication 216 | | Encrypt_storage 217 | | Split 218 | | Authentication 219 | | Private_shared 220 | | Unknown_flag 221 | [@@deriving ord, eq, show] 222 | 223 | type revocation_reason = 224 | | Key_superseded of string 225 | | Compromised of string 226 | | Key_retired of string 227 | | User_ID_not_valid of string 228 | | Unknown_reason of string 229 | [@@deriving ord, eq, show] 230 | 231 | type t = 232 | | Key_expiration_time of int32 233 | | Revocation_reason of revocation_reason 234 | | Issuer_id of string 235 | | Uses of key_flag list 236 | | Unknown 237 | [@@deriving ord, eq, show] 238 | end 239 | 240 | type signature_type = 241 | | Revocation 242 | | Subkey_binding 243 | | User_certification 244 | | Other 245 | [@@deriving ord, eq, show] 246 | 247 | type t = 248 | { tag : int 249 | ; version : int 250 | ; signature_type : signature_type 251 | ; subpackets : Subpacket.t list } 252 | [@@deriving ord, eq, show] 253 | 254 | val decode : Cstruct.t -> (t, string) result 255 | end 256 | 257 | module Body : sig 258 | type t = 259 | | Id of Id.t 260 | | Secret_key of Secret_key.t 261 | | Public_key of Public_key.t 262 | | Signature of Signature.t 263 | | Secret_subkey of Secret_key.t 264 | | Public_subkey of Public_key.t 265 | | Marker 266 | | Unknown 267 | [@@deriving ord, eq, show] 268 | 269 | val decode : packet_type -> Cstruct.t -> (t, string) result 270 | end 271 | 272 | type t = 273 | { header : Header.t 274 | ; packet : Body.t } 275 | [@@deriving ord, eq, show] 276 | 277 | val decode : Cstruct.t -> (Cstruct.t * t, Packet_error.t) result 278 | end 279 | 280 | val decode : Cstruct.t -> (Packet.t, string) result list 281 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test_all) 3 | (deps 4 | (glob_files keys/*)) 5 | (libraries key-parsers oUnit) 6 | (preprocess 7 | (pps ppx_deriving.std))) 8 | -------------------------------------------------------------------------------- /tests/keys/bad_file.pgp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/bad_file.pgp -------------------------------------------------------------------------------- /tests/keys/bad_file_header.pgp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/bad_file_header.pgp -------------------------------------------------------------------------------- /tests/keys/bad_pub_algo.pgp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/bad_pub_algo.pgp -------------------------------------------------------------------------------- /tests/keys/dh_param.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/dh_param.der -------------------------------------------------------------------------------- /tests/keys/dh_private.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/dh_private.der -------------------------------------------------------------------------------- /tests/keys/dh_public.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/dh_public.der -------------------------------------------------------------------------------- /tests/keys/dsa_pkcs8.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/dsa_pkcs8.der -------------------------------------------------------------------------------- /tests/keys/dsa_private.pgp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/dsa_private.pgp -------------------------------------------------------------------------------- /tests/keys/dsa_private_key.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/dsa_private_key.der -------------------------------------------------------------------------------- /tests/keys/dsa_public.pgp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/dsa_public.pgp -------------------------------------------------------------------------------- /tests/keys/dsa_x509.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/dsa_x509.der -------------------------------------------------------------------------------- /tests/keys/ecdsa_cvc_dummy.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/ecdsa_cvc_dummy.key -------------------------------------------------------------------------------- /tests/keys/elgamal_public.pgp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/elgamal_public.pgp -------------------------------------------------------------------------------- /tests/keys/negative_rsa.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/negative_rsa.der -------------------------------------------------------------------------------- /tests/keys/p256v1_explicit_param.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/p256v1_explicit_param.der -------------------------------------------------------------------------------- /tests/keys/p256v1_named_param.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/p256v1_named_param.der -------------------------------------------------------------------------------- /tests/keys/p256v1_pkcs8.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/p256v1_pkcs8.der -------------------------------------------------------------------------------- /tests/keys/p256v1_x509.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/p256v1_x509.der -------------------------------------------------------------------------------- /tests/keys/revocation_signature.pgp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/revocation_signature.pgp -------------------------------------------------------------------------------- /tests/keys/rsa_cvc_dummy.key: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/rsa_cvc_dummy.key -------------------------------------------------------------------------------- /tests/keys/rsa_pkcs1.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/rsa_pkcs1.der -------------------------------------------------------------------------------- /tests/keys/rsa_pkcs1_pub.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/rsa_pkcs1_pub.der -------------------------------------------------------------------------------- /tests/keys/rsa_pkcs8.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/rsa_pkcs8.der -------------------------------------------------------------------------------- /tests/keys/rsa_private.pgp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/rsa_private.pgp -------------------------------------------------------------------------------- /tests/keys/rsa_public.pgp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/rsa_public.pgp -------------------------------------------------------------------------------- /tests/keys/rsa_tag0.pgp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/rsa_tag0.pgp -------------------------------------------------------------------------------- /tests/keys/rsa_x509.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/rsa_x509.der -------------------------------------------------------------------------------- /tests/keys/rsa_x509_no_params.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/rsa_x509_no_params.der -------------------------------------------------------------------------------- /tests/keys/sect113r1_explicit_param.der: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/sect113r1_explicit_param.der -------------------------------------------------------------------------------- /tests/keys/test_marker.pgp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cryptosense/key-parsers/ffee3b37707e53cd52ce9ae0a988513c8e9307d1/tests/keys/test_marker.pgp -------------------------------------------------------------------------------- /tests/test_all.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let suite = 4 | "Key-parsers" 5 | >::: [ "LTPA" >::: Test_ltpa.suite 6 | ; "ASN1" >::: Test_asn1.suite 7 | ; "CVC" >::: Test_cvc.suite 8 | ; "PGP" >::: Test_pgp.suite ] 9 | 10 | let _ = run_test_tt_main suite 11 | -------------------------------------------------------------------------------- /tests/test_asn1.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open Test_helpers 3 | 4 | module Rsa = struct 5 | (* This key pair was generated using openssl genrsa*) 6 | let (expected_public, expected_private) = 7 | let n = 8 | Z.of_string 9 | "0x00B0DF8DE301B3E8D567285E754661230BEDD203F62C7FF101AA3BBAA1D268C85883D9DCAD1CB39FC51857B10D4EF6BEF6B4FE720E67C1978E4B7801FECB1FBB29" 10 | in 11 | let e = Z.of_string "0x010001" in 12 | let d = 13 | Z.of_string 14 | "0x766C074CB12C2ABD0F07694EEDE3459ACC0D2C17DBAD81C89298D1195D8E486C5567B0A0CDCC88E14F98838C7C093295F57E0366FE0E8C7955D92CA1E86B3C9D" 15 | in 16 | let p = 17 | Z.of_string 18 | "0x00E6896FAD354609DEF3AA5CE8CDCF91FD1977BEA0D36B131429AF78241290B54B" 19 | in 20 | let q = 21 | Z.of_string 22 | "0x00C468BF9C0087E05E327B5B91CFA786682EE320979B458DE66850F09CB3EB6CDB" 23 | in 24 | let dp = 25 | Z.of_string 26 | "0x00C78DA5FE9F83ADDDB0BC024A7E84B3910BAF8C72382F92473CC227D3C9C23B3B" 27 | in 28 | let dq = 29 | Z.of_string 30 | "0x00AF9317DE43D73329E1A4C679B51083A5346CD320D3ABBCAAC08BC25BC2B66CCB" 31 | in 32 | let qinv = 33 | Z.of_string 34 | "0x008355897ABCEA9F39B116A241872E971F5F85AD2C435FD085D4C665C58B271B17" 35 | in 36 | let open Key_parsers.Asn1.Rsa in 37 | (Public.{n; e}, Private.{n; e; d; p; q; dp; dq; qinv; other_primes = []}) 38 | 39 | let test_pub ~decode expected der ctxt = 40 | let open Key_parsers.Asn1.Rsa in 41 | let actual = decode der in 42 | Test_util.assert_ok actual @@ fun actual -> 43 | assert_equal ~ctxt ~cmp:[%eq: Public.t] ~printer:[%show: Public.t] expected 44 | actual 45 | 46 | let test_error ~decode expected der ctxt = 47 | let actual = decode der in 48 | Test_util.assert_error actual @@ fun actual -> 49 | assert_equal ~ctxt ~cmp:[%eq: string] ~printer:[%show: string] expected 50 | actual 51 | 52 | let test_priv ~decode expected der ctxt = 53 | let open Key_parsers.Asn1.Rsa in 54 | let actual = decode der in 55 | Test_util.assert_ok actual @@ fun actual -> 56 | assert_equal ~ctxt ~cmp:[%eq: Private.t] ~printer:[%show: Private.t] 57 | expected actual 58 | 59 | let test_pkcs1 = 60 | let open Key_parsers.Asn1.Rsa in 61 | "PKCS#1" 62 | >::: [ "Private" 63 | >:: test_priv ~decode:Private.decode expected_private 64 | (fixture "rsa_pkcs1.der") 65 | ; "Public" 66 | >:: test_pub ~decode:Public.decode expected_public 67 | (fixture "rsa_pkcs1_pub.der") ] 68 | 69 | let test_x509 = 70 | let decode = Key_parsers.Asn1.X509.decode_rsa in 71 | "X509" 72 | >::: [ "Public" >:: test_pub ~decode expected_public (fixture "rsa_x509.der") 73 | ; "Without parameters" 74 | >:: test_pub ~decode expected_public 75 | (fixture "rsa_x509_no_params.der") ] 76 | 77 | let test_pkcs8 = 78 | let decode = Key_parsers.Asn1.PKCS8.decode_rsa in 79 | "PKCS#8" 80 | >::: [ "Private" 81 | >:: test_priv ~decode expected_private (fixture "rsa_pkcs8.der") ] 82 | 83 | let test_negative_key = 84 | let decode = Key_parsers.Asn1.X509.decode_rsa in 85 | "X509" 86 | >::: [ "Negative Public Key" 87 | >:: test_error ~decode "X509 RSA key: Negative modulus" 88 | (fixture "negative_rsa.der") ] 89 | 90 | let suite = "Rsa" >::: [test_pkcs1; test_x509; test_pkcs8; test_negative_key] 91 | end 92 | 93 | let dsa_suite = 94 | let open Key_parsers.Asn1.Dsa in 95 | (* These parameters and key pair were generated using openssl dsaparam and gendsa *) 96 | let p = 97 | Z.of_string 98 | "0x00E21ECE0A801FFBFBA42C78331538C38E004BF7EBD2F882B5AAB6B17AD0F9BE7352DFEB7522BCA514884CBBC78197B3889DF954D6C5E06EF824B7DD54F256A6AF04B77D1A683E725AF3283C4A55A88FCEAACE54328FDF99A690A353E1D07041DD4D0EC391C8B1249E52541D7BC95229A783AA5C3BBFA0F5C21203B32C3BC2058D" 99 | in 100 | let q = Z.of_string "0x00B77D5A19B02F7827EE7086E58D669768BCBF6133" in 101 | let g = 102 | Z.of_string 103 | "0x00D827687BE818D99E654B04638F9B4C88C446CDDCDF5EFBB82C6834FDA74ECD9D119EAF7CF749270043068CA2E5A844C77B24E5429BD2DBB05C50DB96CD04BBFA769E52D4E8367AE0D926C7B9E7FE2464951BA2F0A190B0DD1E4540D85F6A89A01FD047972EA7FB21AD137A09C0B10087F627DB21A5F7630AC30A421F0585D1BC" 104 | in 105 | 106 | let dsa_public_key = 107 | Z.of_string 108 | "0x3D43977A2859A30F8BF890597DA1F24FB0978079770EDAAFCEFE4F6A8BB0C07DDBEF1B4D9FD487BEE92C230085365431215F1935507F8543D4111A59071B241064589ADCF8FF5037FA8C0FC590C6A41B381089BEC44979CF3B4B9F6EE93CA3D6C9C3AABF0242F64B1B1F9602E0C7A51E9C62E995F20A314B2EB642D7260149A0" 109 | in 110 | 111 | let dsa_private_key = 112 | Z.of_string "0x515347B306C0D6A4C172AFCB92E1147477EF7ADB" 113 | in 114 | 115 | let expected_dsa = 116 | let open Key_parsers.Asn1 in 117 | Dsa_private_key. 118 | {p; q; g; public_key = dsa_public_key; private_key = dsa_private_key} 119 | in 120 | 121 | let dsa_private_suite = 122 | let test expected_dsa der ctxt = 123 | let open Key_parsers.Asn1 in 124 | let actual = Dsa_private_key.decode der in 125 | Test_util.assert_ok actual @@ fun actual -> 126 | assert_equal ~ctxt ~cmp:[%eq: Dsa_private_key.t] 127 | ~printer:[%show: Dsa_private_key.t] expected_dsa actual 128 | in 129 | let der = fixture "dsa_private_key.der" in 130 | ["Private_key" >:: test expected_dsa der] 131 | in 132 | 133 | let expected_params = Params.{p; q; g} in 134 | let expected_public = (expected_params, dsa_public_key) in 135 | let expected_private = (expected_params, dsa_private_key) in 136 | let cmp = Z.equal in 137 | let printer = Z.to_string in 138 | let test_params expected real ctxt = 139 | let open Params in 140 | assert_equal ~ctxt ~cmp ~printer ~msg:"p" expected.p real.p; 141 | assert_equal ~ctxt ~cmp ~printer ~msg:"q" expected.q real.q; 142 | assert_equal ~ctxt ~cmp ~printer ~msg:"g" expected.g real.g 143 | in 144 | let test ~typ ~decode (expected_params, expected_key) der ctxt = 145 | let real = decode der in 146 | let msg = 147 | match typ with 148 | | `Public -> "y" 149 | | `Private -> "x" 150 | in 151 | Test_util.assert_ok real @@ fun (real_params, real_key) -> 152 | test_params expected_params real_params ctxt; 153 | assert_equal ~ctxt ~cmp ~printer ~msg expected_key real_key 154 | in 155 | let x509_suite = 156 | let typ = `Public in 157 | let der = fixture "dsa_x509.der" in 158 | [ "Public" 159 | >:: test ~typ ~decode:Key_parsers.Asn1.X509.decode_dsa expected_public der 160 | ] 161 | in 162 | let pkcs8_suite = 163 | let typ = `Private in 164 | let der = fixture "dsa_pkcs8.der" in 165 | [ "Private" 166 | >:: test ~typ ~decode:Key_parsers.Asn1.PKCS8.decode_dsa expected_private 167 | der ] 168 | in 169 | 170 | [ "DSA_PRIVATE" >::: dsa_private_suite 171 | ; "X509" >::: x509_suite 172 | ; "PKCS8" >::: pkcs8_suite ] 173 | 174 | let ec_suite = 175 | let open Key_parsers.Asn1.Ec in 176 | let p256v1_oid = Asn.OID.(base 1 2 <|| [840; 10045; 3; 1; 7]) in 177 | let exp_named_params = Params.Named p256v1_oid in 178 | let test_params expected real ctxt = 179 | let printer = Params.show in 180 | let cmp p p' = Params.compare p p' = 0 in 181 | assert_equal ~ctxt ~cmp ~printer ~msg:"params" expected real 182 | in 183 | let param_suite = 184 | let exp_specified_prime = 185 | let field = 186 | let p = 187 | Z.of_string 188 | "0x00FFFFFFFF00000001000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFF" 189 | in 190 | Field.Prime p 191 | in 192 | let curve = 193 | let a = 194 | Test_util.cstruct_of_hex 195 | "FFFFFFFF00000001000000000000000000000000FFFFFFFFFFFFFFFFFFFFFFFC" 196 | in 197 | let b = 198 | Test_util.cstruct_of_hex 199 | "5AC635D8AA3A93E7B3EBBD55769886BC651D06B0CC53B0F63BCE3C3E27D2604B" 200 | in 201 | let seed = 202 | Some 203 | (Test_util.cstruct_of_hex "C49D360886E704936A6678E1139D26B7819F7E90") 204 | in 205 | Specified_domain.{a; b; seed} 206 | in 207 | let base = 208 | Test_util.cstruct_of_hex 209 | "046B17D1F2E12C4247F8BCE6E563A440F277037D812DEB33A0F4A13945D898C2964FE342E2FE1A7F9B8EE7EB4A7C0F9E162BCE33576B315ECECBB6406837BF51F5" 210 | in 211 | let order = 212 | Z.of_string 213 | "0x00FFFFFFFF00000000FFFFFFFFFFFFFFFFBCE6FAADA7179E84F3B9CAC2FC632551" 214 | in 215 | let cofactor = Some (Z.of_int 1) in 216 | Params.Specified Specified_domain.{field; curve; base; order; cofactor} 217 | in 218 | let exp_specified_binary = 219 | let field = 220 | let m = Z.of_int 113 in 221 | let basis = Field.TP (Z.of_int 9) in 222 | Field.(C_two {m; basis}) 223 | in 224 | let curve = 225 | let a = Test_util.cstruct_of_hex "3088250CA6E7C7FE649CE85820F7" in 226 | let b = Test_util.cstruct_of_hex "E8BEE4D3E2260744188BE0E9C723" in 227 | let seed = 228 | Some 229 | (Test_util.cstruct_of_hex "10E723AB14D696E6768756151756FEBF8FCB49A9") 230 | in 231 | Specified_domain.{a; b; seed} 232 | in 233 | let base = 234 | Test_util.cstruct_of_hex 235 | "04009D73616F35F4AB1407D73562C10F00A52830277958EE84D1315ED31886" 236 | in 237 | let order = Z.of_string "0x0100000000000000D9CCEC8A39E56F" in 238 | let cofactor = Some (Z.of_int 2) in 239 | Params.Specified Specified_domain.{field; curve; base; order; cofactor} 240 | in 241 | let test_params expected der ctxt = 242 | let real = Params.decode der in 243 | Test_util.assert_ok real @@ fun real -> test_params expected real ctxt 244 | in 245 | let named_der = fixture "p256v1_named_param.der" in 246 | let prime_der = fixture "p256v1_explicit_param.der" in 247 | let bin_der = fixture "sect113r1_explicit_param.der" in 248 | [ "Named" >:: test_params exp_named_params named_der 249 | ; "Specifed" 250 | >::: [ "PrimeField" >:: test_params exp_specified_prime prime_der 251 | ; "BinaryField" >:: test_params exp_specified_binary bin_der ] ] 252 | in 253 | let h = 254 | Test_util.cstruct_of_hex 255 | "04DB81688B7871A0762ADCDC6109F37C45AA689BDB300E3036614C8FE21E7AB1C1E8A133D358F0ED65B478D97064535ECE5BC2809A2BC974D25639DEFE5D38EE89" 256 | in 257 | let exp_public = (exp_named_params, h) in 258 | let exp_private = 259 | let params = None in 260 | let k = 261 | Test_util.cstruct_of_hex 262 | "3F05F839F41567FF8A2D2ACA64BA92AEC698B43C52D4CF0D2264F4615F07FB86" 263 | in 264 | let public_key = Some h in 265 | (exp_named_params, Private.{k; params; public_key}) 266 | in 267 | let x509_suite = 268 | let test (expected_params, expected_key) der ctxt = 269 | let printer = Public.show in 270 | let cmp pub pub' = Public.compare pub pub' = 0 in 271 | let real = Key_parsers.Asn1.X509.decode_ec der in 272 | Test_util.assert_ok real @@ fun (real_params, real_key) -> 273 | test_params expected_params real_params ctxt; 274 | assert_equal ~ctxt ~cmp ~printer ~msg:"H" expected_key real_key 275 | in 276 | let der = fixture "p256v1_x509.der" in 277 | ["Public" >:: test exp_public der] 278 | in 279 | let pkcs8_suite = 280 | let test (expected_params, expected_key) der ctxt = 281 | let printer = Private.show in 282 | let cmp priv priv' = Private.compare priv priv' = 0 in 283 | let real = Key_parsers.Asn1.PKCS8.decode_ec der in 284 | Test_util.assert_ok real @@ fun (real_params, real_key) -> 285 | test_params expected_params real_params ctxt; 286 | assert_equal ~ctxt ~cmp ~printer ~msg:"privateKey" expected_key real_key 287 | in 288 | let der = fixture "p256v1_pkcs8.der" in 289 | ["Private" >:: test exp_private der] 290 | in 291 | ["Params" >::: param_suite; "X509" >::: x509_suite; "PKCS8" >::: pkcs8_suite] 292 | 293 | let dh_suite = 294 | let open Key_parsers.Asn1.Dh in 295 | (* These parameters and key pair were generated using openssl dhparam and genpkey *) 296 | let expected_params = 297 | let p = 298 | Z.of_string 299 | "0x00FD5E02F538091F7380991F204E931C62633358124FA1C3DE6A9F852B2C621F040F44B56F6C6605CFBBC4CF4ECD449BB2889CEA53E0FF88F1FE8D9471030EE893" 300 | in 301 | let g = Z.of_string "2" in 302 | Params.{p; g; l = None} 303 | in 304 | let expected_public = 305 | let y = 306 | Z.of_string 307 | "0x00DBF090700954EA1B1B05DBC33494D0EBC8E2C5E66AFB24D322877021C76C634A9227D5E6B77F15673AF5814DAA7106F8F040F89DDC3294362888B934F4D8E95E" 308 | in 309 | (expected_params, y) 310 | in 311 | let expected_private = 312 | let x = 313 | Z.of_string 314 | "0x4BE30C58EB827B66F853E57AC44E0D42850C284EF08D8406EFBED228A47F93667CCA1A84F1496AAFF545212B96D2E66FB8DE4AB20DB7E6747D21E8B1CFE040BE" 315 | in 316 | (expected_params, x) 317 | in 318 | let cmp = Z.equal in 319 | let printer = Z.to_string in 320 | let test_params expected real ctxt = 321 | let open Params in 322 | assert_equal ~ctxt ~cmp ~printer ~msg:"p" expected.p real.p; 323 | assert_equal ~ctxt ~cmp ~printer ~msg:"g" expected.g real.g; 324 | assert_equal ~ctxt 325 | ~cmp:(Test_util.equal_options ~equal:Z.equal) 326 | ~printer:(function 327 | | Some x -> Z.to_string x 328 | | None -> "nothing") 329 | ~msg:"l" expected.l real.l 330 | in 331 | let test ~typ ~decode (expected_params, expected_key) der ctxt = 332 | let real = decode der in 333 | let msg = 334 | match typ with 335 | | `Public -> "y" 336 | | `Private -> "x" 337 | in 338 | Test_util.assert_ok real @@ fun (real_params, real_key) -> 339 | test_params expected_params real_params ctxt; 340 | assert_equal ~ctxt ~cmp ~printer ~msg expected_key real_key 341 | in 342 | let x509_suite = 343 | let typ = `Public in 344 | let der = fixture "dh_public.der" in 345 | [ "Public" 346 | >:: test ~typ ~decode:Key_parsers.Asn1.X509.decode_dh expected_public der 347 | ] 348 | in 349 | let pkcs8_suite = 350 | let typ = `Private in 351 | let der = fixture "dh_private.der" in 352 | [ "Private" 353 | >:: test ~typ ~decode:Key_parsers.Asn1.PKCS8.decode_dh expected_private 354 | der ] 355 | in 356 | ["X509" >::: x509_suite; "PKCS8" >::: pkcs8_suite] 357 | 358 | let suite = 359 | [Rsa.suite; "Dsa" >::: dsa_suite; "Ec" >::: ec_suite; "Dh" >::: dh_suite] 360 | -------------------------------------------------------------------------------- /tests/test_cvc.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open Test_helpers 3 | 4 | let rsa_suite = 5 | let open Key_parsers in 6 | let open Cvc.Rsa in 7 | let expected_public = 8 | let n = 9 | Z.of_string 10 | "0x0102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f80" 11 | in 12 | let e = Z.of_string "0x010203" in 13 | Public.{n; e} 14 | in 15 | let cmp = Z.equal in 16 | let printer = Z.to_string in 17 | let test_pub ~decode (expected : Public.t) cvc ctxt = 18 | let real = decode cvc in 19 | let open Public in 20 | Test_util.assert_ok real @@ fun real -> 21 | assert_equal ~ctxt ~cmp ~printer ~msg:"n" expected.n real.n; 22 | assert_equal ~ctxt ~cmp ~printer ~msg:"e" expected.e real.e 23 | in 24 | let cvc = fixture "rsa_cvc_dummy.key" in 25 | ["Public" >:: test_pub ~decode:Cvc.Rsa.Public.decode expected_public cvc] 26 | 27 | let ec_suite = 28 | let open Key_parsers in 29 | let open Cvc in 30 | let open Ec in 31 | let expected_public = 32 | (* parameters from secp256r1, public_point_y generated using openssl ecparam and pkey *) 33 | let modulus = 34 | Z.of_string 35 | "0xffffffff00000001000000000000000000000000fffffffffffffffffffffffc" 36 | in 37 | let coefficient_a = 38 | Test_util.cstruct_of_hex 39 | "ffffffff00000001000000000000000000000000fffffffffffffffffffffffc" 40 | in 41 | let coefficient_b = 42 | Test_util.cstruct_of_hex 43 | "5ac635d8aa3a93e7b3ebbd55769886bc651d06b0cc53b0f63bce3c3e27d2604b" 44 | in 45 | let base_point_g = 46 | Test_util.cstruct_of_hex 47 | "046b17d1f2e12c4247f8bce6e563a440f277037d812deb33a0f4a13945d898c2964fe342e2fe1a7f9b8ee7eb4a7c0f9e162bce33576b315ececbb6406837bf51f5" 48 | in 49 | let base_point_r_order = 50 | Z.of_string 51 | "0xffffffff00000000ffffffffffffffffbce6faada7179e84f3b9cac2fc632551" 52 | in 53 | let public_point_y = 54 | Test_util.cstruct_of_hex 55 | "04E266926DF905285452A5BB4DFC70286D621BF8AF33FA8D2D2E4C5F86BF9DF3BA54CF49409095250A14A93B16D9B2F8B7D6E1C247CB939FE9F10924B54E0BA075" 56 | in 57 | let cofactor_f = Z.of_string "1" in 58 | let open Public in 59 | { modulus 60 | ; coefficient_a 61 | ; coefficient_b 62 | ; base_point_g 63 | ; base_point_r_order 64 | ; public_point_y 65 | ; cofactor_f } 66 | in 67 | let test_pub ~decode (expected : Public.t) cvc ctxt = 68 | let real = decode cvc in 69 | Test_util.assert_ok real @@ fun real -> 70 | let open Public in 71 | assert_equal ~ctxt ~printer:show ~cmp:equal expected real 72 | in 73 | let cvc = fixture "ecdsa_cvc_dummy.key" in 74 | ["Public" >:: test_pub ~decode:Cvc.Ec.Public.decode expected_public cvc] 75 | 76 | let suite = ["Rsa" >::: rsa_suite; "Ec" >::: ec_suite] 77 | -------------------------------------------------------------------------------- /tests/test_helpers.ml: -------------------------------------------------------------------------------- 1 | let read_cstruct path = 2 | let ic = open_in path in 3 | let len = in_channel_length ic in 4 | let s = really_input_string ic len in 5 | close_in ic; 6 | Cstruct.of_string s 7 | 8 | let fixture name = 9 | let path = Printf.sprintf "keys/%s" name in 10 | read_cstruct path 11 | -------------------------------------------------------------------------------- /tests/test_helpers.mli: -------------------------------------------------------------------------------- 1 | val fixture : string -> Cstruct.t 2 | (** Reads a file in [tests/keys] *) 3 | -------------------------------------------------------------------------------- /tests/test_ltpa.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let suite = 4 | (* These parameters were generated using openssl. *) 5 | let e = Z.of_string_base 16 "010001" in 6 | let n = 7 | Z.of_string_base 16 8 | "A8CA9E1529C91688FC0DC99FAA59D32ABEC31135E6A872F0AB541078B73E881582A658AFE4E5650D91FD9A354832EB1904617E7B26B63571FA8DA2E3743DB09A1DD328274D7C9360BEAE8212801F7BBE00F1AA6C9ACEDAF395681F0A983996E806E991204394DBA628A34E47C81075846F01780B5CB39848B20DA2222D2A9F3D" 9 | in 10 | let d = 11 | Z.of_string_base 16 12 | "73B27EED4EB9118350123B54003695F244D3FCE60F770362486DD4E489E688ED05A2F4438D08585E16E5D860115F259AFE4FBD9CB88A48D419C42014FCC69457D24BF3A46FEA7499E32822E4DBF5AC56A25666B4829D50BAAA8B9A94442F2DD5CE3800C60AA4E9F32A11FB517546DB3B450348A51F8D69F097DDB62DA5877B01" 13 | in 14 | let p = 15 | Z.of_string_base 16 16 | "D838C2E801F139175045D59478DA2E75CD98EBAF97D1E72EE456C239BDE57E50DD2D289574D9C94B22ACFC5B2A6D7BEC61D949318C11FFB6D4ADD7A38D41099D" 17 | in 18 | let q = 19 | Z.of_string_base 16 20 | "C7D81161C95B4C38679DA634E2B452D4B49C90DBA9DC41A5D4CF1744D1828D6304DDB4D0732568450C799C97BC2561F5DFDF14C848D0AE9CD1A20B6B2BB54A21" 21 | in 22 | let private_encoded = 23 | String.concat "" 24 | [ "\x00\x00\x00\x81" 25 | ; "\x00\x73\xB2\x7E\xED\x4E\xB9\x11\x83\x50\x12\x3B\x54\x00\x36\x95\xF2\x44\xD3\xFC\xE6\x0F\x77\x03\x62\x48\x6D\xD4\xE4\x89\xE6\x88\xED\x05\xA2\xF4\x43\x8D\x08\x58\x5E\x16\xE5\xD8\x60\x11\x5F\x25\x9A\xFE\x4F\xBD\x9C\xB8\x8A\x48\xD4\x19\xC4\x20\x14\xFC\xC6\x94\x57\xD2\x4B\xF3\xA4\x6F\xEA\x74\x99\xE3\x28\x22\xE4\xDB\xF5\xAC\x56\xA2\x56\x66\xB4\x82\x9D\x50\xBA\xAA\x8B\x9A\x94\x44\x2F\x2D\xD5\xCE\x38\x00\xC6\x0A\xA4\xE9\xF3\x2A\x11\xFB\x51\x75\x46\xDB\x3B\x45\x03\x48\xA5\x1F\x8D\x69\xF0\x97\xDD\xB6\x2D\xA5\x87\x7B\x01" 26 | ; "\x01\x00\x01" 27 | ; "\x00\xD8\x38\xC2\xE8\x01\xF1\x39\x17\x50\x45\xD5\x94\x78\xDA\x2E\x75\xCD\x98\xEB\xAF\x97\xD1\xE7\x2E\xE4\x56\xC2\x39\xBD\xE5\x7E\x50\xDD\x2D\x28\x95\x74\xD9\xC9\x4B\x22\xAC\xFC\x5B\x2A\x6D\x7B\xEC\x61\xD9\x49\x31\x8C\x11\xFF\xB6\xD4\xAD\xD7\xA3\x8D\x41\x09\x9D" 28 | ; "\x00\xC7\xD8\x11\x61\xC9\x5B\x4C\x38\x67\x9D\xA6\x34\xE2\xB4\x52\xD4\xB4\x9C\x90\xDB\xA9\xDC\x41\xA5\xD4\xCF\x17\x44\xD1\x82\x8D\x63\x04\xDD\xB4\xD0\x73\x25\x68\x45\x0C\x79\x9C\x97\xBC\x25\x61\xF5\xDF\xDF\x14\xC8\x48\xD0\xAE\x9C\xD1\xA2\x0B\x6B\x2B\xB5\x4A\x21" 29 | ] 30 | in 31 | let public_encoded = 32 | "\xA8\xCA\x9E\x15\x29\xC9\x16\x88\xFC\x0D\xC9\x9F\xAA\x59\xD3\x2A\xBE\xC3\x11\x35\xE6\xA8\x72\xF0\xAB\x54\x10\x78\xB7\x3E\x88\x15\x82\xA6\x58\xAF\xE4\xE5\x65\x0D\x91\xFD\x9A\x35\x48\x32\xEB\x19\x04\x61\x7E\x7B\x26\xB6\x35\x71\xFA\x8D\xA2\xE3\x74\x3D\xB0\x9A\x1D\xD3\x28\x27\x4D\x7C\x93\x60\xBE\xAE\x82\x12\x80\x1F\x7B\xBE\x00\xF1\xAA\x6C\x9A\xCE\xDA\xF3\x95\x68\x1F\x0A\x98\x39\x96\xE8\x06\xE9\x91\x20\x43\x94\xDB\xA6\x28\xA3\x4E\x47\xC8\x10\x75\x84\x6F\x01\x78\x0B\x5C\xB3\x98\x48\xB2\x0D\xA2\x22\x2D\x2A\x9F\x3D" 33 | ^ "\x01\x00\x01" 34 | in 35 | let printer = Z.to_string in 36 | let test_private ctxt = 37 | let open Key_parsers.Ltpa.Rsa.Private in 38 | let k = decode (Cstruct.of_string private_encoded) in 39 | Test_util.assert_ok k @@ fun k -> 40 | assert_equal ~ctxt ~printer ~msg:"e" e k.e; 41 | assert_equal ~ctxt ~printer ~msg:"d" d k.d; 42 | assert_equal ~ctxt ~printer ~msg:"p" p k.p; 43 | assert_equal ~ctxt ~printer ~msg:"q" q k.q 44 | in 45 | let test_public ctxt = 46 | let open Key_parsers.Ltpa.Rsa.Public in 47 | let k = decode (Cstruct.of_string public_encoded) in 48 | Test_util.assert_ok k @@ fun k -> 49 | assert_equal ~ctxt ~printer ~msg:"e" e k.e; 50 | assert_equal ~ctxt ~printer ~msg:"n" n k.n 51 | in 52 | ["Private" >:: test_private; "Public" >:: test_public] 53 | -------------------------------------------------------------------------------- /tests/test_pgp.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | open Test_helpers 3 | open Key_parsers.Pgp 4 | 5 | exception File of string 6 | 7 | let test_val ?(nth = 0) ~decode ~expected filename ctxt = 8 | let file = fixture filename in 9 | let res = decode file in 10 | let (public_packet : Packet.t) = Result.get_ok (List.nth res nth) in 11 | assert_equal ~printer:[%show: Packet.Body.t] ~ctxt public_packet.packet 12 | expected 13 | 14 | module Rsa = struct 15 | let public_packet = 16 | let expected_public = 17 | let n = 18 | Z.of_string 19 | "0xfb4be4285f7bf636362c2a86b2680899c30d9d07851850b474e8db8d96743001917984e222e989751930c09c6c88dff8f17ecf8be3d4796bd18946ffae7be00a95055ad9d508225ce3dcec571a804fb15b34dcea1c52ec3720852a0c3c19a5772b7b2fa3c602209df84bd9756cacc040e0e9b5b7b6eb4fdee3ca6afeadbfea0b2d69064208467bcccc509affe01a8a49778b70150e8d9d289de5229f23b7a414ac7f3f7f196f71767c6b3ff3f2fd46505d8bed9a531a9c9ba0f5024e52173f62e025b84a3038cd39ffe22bf6a0d21bd5de60d5a51df8b364a5878404ae00a25e72e1cec494104e5adff481640bd17df825f191366895939ca588f287ec047348e0250a36e1c5873d7c95ddf8c945d89f344fe67230628d8b3d50124ee6306bba214103102509412e1c0e5df173b4834b061662e4678a73589639eedd256a36425edfea899882c4904c492d45027d1688417913f6c84758852be127695b0804a4537d9eee12ff9dba06b53eeb4456b79079c8e4dfb3ca01fdd3c3e248f5c79905" 20 | in 21 | let e = Z.of_string "0x10001" in 22 | Rsa.Public.{n; e} 23 | in 24 | let packet = 25 | Packet.Public_key. 26 | { version = 4 27 | ; public_key = Rsa expected_public 28 | ; algo = Algo.Public.Rsa_enc_sign 29 | ; creation_time = 1626248155l 30 | ; validity_period = None } 31 | in 32 | Packet.Body.Public_key packet 33 | 34 | let secret_packet = 35 | let expected_public2 = 36 | let public_key2 = 37 | let n = 38 | Z.of_string 39 | "0xc64c9e5d63cf62479608c22ba50cf2cbda2497e2cd92bdbb536ab4d55f1befaf262ae89a739698e538c688bce698aa4258bff01464f714ce98a2b1bacf92871f6e2b040990924f2c6634804072a990c6328ccd580e01f54b013aa0e08a388a78cd20ece56ca865079c26e77875c3b1f42d6bf015bb95da4606bf3fb05608ec17f823373dd73b75d77d1a34568797a690cbd21c6c78dd99d4f8cbea71e0327e8ca544619c244d1e9fa1a624209a7986b8663a1b1b0044899120d0daffddcf06df12159f8962c433a3b3ae7d84c5630ad290d97921b21a318a80d6a3b702d51cb2ba23958141a1702096cf891794f929e8396645f697e4f928a8105102f2ffed7b2ea920ffea992e74bfaeef564a6a06a7a61a0a379446367de345e9865205d095be574bb3bbc47721f71d4adaa79e2e4dcc781c94f90c64f32720a61b8dda1e6cf7093a2144276f772844242444cb06e7cf42a7745baaf4eb40b7975cc89aa32ff1d34fa8cadfc5a6aae59fff707c0d225e943ad479585af4bed5b71e78e183f3" 40 | in 41 | let e = Z.of_string "0x10001" in 42 | Rsa.Public.{n; e} 43 | in 44 | Packet.Public_key. 45 | { version = 4 46 | ; public_key = Rsa public_key2 47 | ; algo = Algo.Public.Rsa_enc_sign 48 | ; creation_time = 1626770303l 49 | ; validity_period = None } 50 | in 51 | 52 | let d = 53 | Z.of_string 54 | "0x12ad92d91f16a09e378e99a37cc76c733117f34a84ac86bc874decbc9059d448be229a8839ccfc97d2b2389cfa6774da0cfbff441c827d6e3c484ecf56cfe974576f2bd12ed1e92d386f47894a83984462ec8a46fa02cb3506679c51aa134b4fb79a9b55bcd75bb4cccb894ffa5fb57a5770ec4b4fc0fcaf4de163c15b4939dbc41ea50c69228ba6017d9f626b2128aa48d8809ee2ff9486cfec7d27bec362d2229aff4ab2cca4ceca6e18c70d65d6ffb57951a6486f2c3a044a47e683e10537814d46d26c70f7b927b20dcbb6b81663642f31b248a24a16c3dfaa97ce96c873b8dbe6781e82f450b95bf52ca2e2b7da1129c94ea308c583fee97140d738d1fabdc63515ed27f1d545c3237e44c122d3316b6a591daaf68deac8b3c694aa8658cb7b05b21cd94964e8a4b78c5fa2f7da22006132256984b0c2656f54028979cd81d2a1c1a6cae65fbd3eacc91948069d773e1652f9856df3dc425e6aff95d0d106b7daa53c4734e772550675508fbdbc6a6bcef367a37fd8e7f674ad5610a9b9" 55 | in 56 | let p = 57 | Z.of_string 58 | "0xdf789fe3ccebdf5cfe996e4f3550674b033684adf1297a8f77529c55413b2a0fab11317104e18200b94820d5bd2ab62867e965af7c9fab81033439371b22d2ed9046e2fb505d79eff7ee9a3c3521dd88e204ee897e853c5ea5e77e7764e79c0809d6f1e50a83e2e2729d6dca68d89c465d952ff0036d4ce8539159c3b8ac62938f318abfe04e686c56f294caa1801025fd06dba3c79e6484d33b724939b073912367d4afdc0def7751c176fc8dffad3c593efaf39f70eea9a15a4b8ad31ddee5" 59 | in 60 | let q = 61 | Z.of_string 62 | "0xe329fe9f5a911de7197985e89ce543e0b12720ae8bb596b6c70fb99ab03358d781b68f862e707006552f8cba1b2e97b6a711b21a62ff9c00c9eaa47432091894add02560f2bccdf90a40ec5456e9df8980804753ad7e1ddffb875e4605d48d6997503cbb0dd71bc458edd62251a079a3d3793f907d342d78a34790a0940c959d1f587840fa7d1efc66cdd8d893dc4844c0365707b31812c5cd509280c045dc8f85d9c7269875792e182301f918c4da7ae519ce67b0af953ff7a5478173d551f7" 63 | in 64 | let u = 65 | Z.of_string 66 | "0xaf96592890d66e7c762d11774d700877a3dbc1406a843547fe63f36715cdc11e0f0e8174577ca807dde961358ee44f59170a8ebd1eedc98f0c0b22125c111e6d72ebbaa2a2a477d492840ccbd0ca7f77915fa13b891da483e689671a7321176cb851605ef2970fbe4c8d3c33fb5f48c52ff9e0c7803e5bc6db000dcbf82b77772fc09a6405d1166b6cd8ac1f1b97d142d4730d31deb02f5bed6b12625ab3bc7d46150e2ee5ab432d02e2ccbec991cb4b71b8d43c7b9ef90807c909b302fd11da" 67 | in 68 | 69 | let private_key = Rsa.Private.{d; p; q; u} in 70 | let packet = 71 | Packet.Secret_key. 72 | { public_key = expected_public2 73 | ; s2k = None 74 | ; initial_vector = None 75 | ; private_key = Some (Rsa private_key) 76 | ; checksum = Some "e90c" 77 | ; hash = None } 78 | in 79 | Packet.Body.Secret_key packet 80 | 81 | let test_rsa_public = 82 | test_val ~decode ~expected:public_packet "rsa_public.pgp" 83 | 84 | let test_rsa_private = 85 | test_val ~decode ~expected:secret_packet "rsa_private.pgp" 86 | 87 | let suite = ["Public" >:: test_rsa_public; "Secret" >:: test_rsa_private] 88 | end 89 | 90 | module Dsa = struct 91 | let public_packet = 92 | let expected_public = 93 | let p = 94 | Z.of_string 95 | "0xd93edd8915add1c50daa9f232b17be4b47e8af10d92505dbcd095a332f583c2a64176faa557e896a56e662e8fe72859edce012ca0977dff484a01d969376f46853b4f03a3c23829a2b5b1012b84fbe733d6e384d80ac7406581ae0524f69cf8580d25efd6d976a8756cad44bcbd5c3e34a357f929a2121809ee252eb193af25e7b42d59fe2eb83ed342c5537300b486c1a90c549ac12b53993166c9e98cf04f0200814bd6601e5393ad63c45ccd97280a8c00a66f88f44432f3e9a4c9f76f5862fb0618f507238ee7f864b827c2ad23bee13963295ca3c5b070eefcd15c128989168166edc7b5398b5620373c6c7484193d03a9796dc2e9b51700b80a09e125f" 96 | in 97 | let q = 98 | Z.of_string 99 | "0xaaead1eefc59d06dbee40202852b95764f45121d2ec392cbd877b562635dd281" 100 | in 101 | let g = 102 | Z.of_string 103 | "0x3fa31581b723648fd0bf7d87fb5ec3b9bc764ded7ff4961acb05f281f9bc0886819f320e21d9a84375d2aca85eb2b35589f84cf647d7967f001de7267c2b5fd5c28cfbedc5686e50bf9c3153242371d67a2e9ea703ca22c03c6b2904cdc30bd582885dab36b53ea2401d7d834f58f560744f8f185363c25168e63692b08fc21c6e9c688b0fa467057e99721dbd19601632e68501fff7650dfba40a8cc7362f4a95f612db3126ac83df3e60f5d54625430396caf09cd86a3c11391a1bf32af967f2121a8f7a247c5c99b8965405ac6d29477fa1e0e00aa10741c5b1cebcaf0b3fdce32f745a929ff5bffc5c1a918b99dcea2ce38f1ac96a64e1a3ab1d918c3a5d" 104 | in 105 | let y = 106 | Z.of_string 107 | "0x5c428f6d55e36966e1aef9de9564c3e100b1979a3c7c19c01ce1aca55e4afa5c57c113bc48c53eee53146701c8e6ae6a445d93c9ec8cf568755eb1c56810ba7e06fd33f5b03e22595e8104aadadf5a58a883d3262ea579bdd6792c493bebaeb0bf3b5570396cc9a88927d51d5919dc50237cef2af387a2d2591596096a09fc8f0995a1ef9a5d33bafabd6432d668b965ae8c800801e6042c38e5800e8d2023bb24420d865d96fb9737f21e0c0838fb798ff6251ac4b8100b2a1abf27bc8b332c35accf37f0b65e692c4595dc23bda3fe06e6c322aa818c8b4963358ad8150369f622c15ac74d65e7235fef6be91401695f530277d8d6f5e2b0e4bb5bb0821455" 108 | in 109 | 110 | Dsa.Public.{p; q; g; y} 111 | in 112 | let packet = 113 | Packet.Public_key. 114 | { version = 4 115 | ; public_key = Dsa expected_public 116 | ; algo = Algo.Public.Dsa 117 | ; creation_time = 1626683055l 118 | ; validity_period = None } 119 | in 120 | Packet.Body.Public_key packet 121 | 122 | let secret_packet = 123 | let expected_public2 = 124 | let p = 125 | Z.of_string 126 | "0xd57323e2c1c98bf7311d8b17236834fe339e6c6ac383e7bf87b96a5acb166c373a694ad843f798fe5639e8264164d6f4b9234168d135844ea86536e502a047c6f61b6bbb7f0da0fb50e6c8bedb58b01d7c158f819bc19d149b81b2280ea5c075c7cb54eada34034bb88b5d1a435fa15ad8b06eca669e6fab40549507acfa419993218ff50f77714188dea705e044e022913cff09ee1a69447f64236da72f33402fcb770f31e0e07ffb80977b828039b4438acf0c7db467f856d6f39e235a783f5ea5134abc13677b99413b33c57eb33a044fe712c59268dd0b1e60db488ae1a7a78d16401011ccb2317214436c4ac3b97a36d91be232890119dfd6421db5038b" 127 | in 128 | let q = 129 | Z.of_string 130 | "0x93a788d267164f3c93845da64ef124aca0078eb0618c4a2f42a64e40ca701453" 131 | in 132 | let g = 133 | Z.of_string 134 | "0x1679af5c139e050c9925c46c37fb6795d73a7cb31f07b1106c141239a0f02ff6551a62b71faa2d26d5ab2d01775e57cd2c3aa53106e1c40b1bff0b6a064fa9a3092f1b7435116baeec272bbb9faa7d35b72a5635b9fdbe735c9c2c4edff4c0a56407418efde1bc0df5f512a5bfef9c49cf2f1137c5c335db0ff6fcd8e7c928b10e052ab11fca3e43f6d870d6405a20bd30bf117dc914338045626356cfe79c1cceed3d0cca1b2e5c91ea2ca3be530047764fca840c8dfa117b871a0a751e2d3ab5af0b84a682efb08d4fbd4e6fad60127313c6ba7517b56fdb29464b78bd0b799c0423a61dc4002c3ac8431a2880c0a0865fb901596142ff9c2fb4207dcb0986" 135 | in 136 | let y = 137 | Z.of_string 138 | "0xc8234a448a9bb87273c33a7b14eaa65b32418586443e4f1aab324d490e451bfe8024c569ce54cea5a6a797277d57ee40987d60bbc77510bbb593f08736289dd1535a793b6f3d35a80dd834911cf09f3a3ef2dea5a54f131afe65bb099ac9c7d165886fd36d54afcb8157a1da864f80eab2627fd20be76d47feee0e5e5cf7e316773b7f7db011fe1a955629293e5642c57f22447b89ddda33fb133d1fa89cca6e64f2bdb89d7c903edffa758588b29dcc5be49ed32c212af75926f0e6958527627fb363af10078530fbdc2cffbda945ca49b9691d3d2e860260afa2b1aec545eedc5d8ce014e66df32a138a836e61fab4813f2c059cce6b5d8635e0f0c10133d7" 139 | in 140 | 141 | let public_key = Dsa.Public.{p; q; g; y} in 142 | Packet.Public_key. 143 | { version = 4 144 | ; public_key = Dsa public_key 145 | ; algo = Algo.Public.Dsa 146 | ; creation_time = 1626774824l 147 | ; validity_period = None } 148 | in 149 | let x = 150 | Z.of_string 151 | "0x57ee36b7fae30f8324ba17dce280ffbdc43a13cd8a01ef2d8805fce70a0cf3d4" 152 | in 153 | let packet = 154 | Packet.Secret_key. 155 | { public_key = expected_public2 156 | ; s2k = None 157 | ; initial_vector = None 158 | ; private_key = Some (Dsa x) 159 | ; checksum = Some "1261" 160 | ; hash = None } 161 | in 162 | Packet.Body.Secret_key packet 163 | 164 | let test_dsa_public = 165 | test_val ~decode ~expected:public_packet "dsa_public.pgp" 166 | 167 | let test_dsa_secret = 168 | test_val ~decode ~expected:secret_packet "dsa_private.pgp" 169 | 170 | let suite = ["Public" >:: test_dsa_public; "Secret" >:: test_dsa_secret] 171 | end 172 | 173 | module Elgamal = struct 174 | let public_packet = 175 | let expected_public = 176 | let p = 177 | Z.of_string 178 | "0xd56ae8fb6b6bc0fc32e663a7a961607331bd7b41641a048516bfbbb7add148f1b3bffe7ce7544e29cd33c87cafd86b37e49e6d70273e53dcb0f7f3af63655a0c70f11dc4a7d397fbcd70a8666cffc8b6be3506960dcf091881e4faacf6c6530185431a4f96ed10a3e0ef35d9ccd9564c75e68685bff8fc09cd6322f2ea215f6da74aaf7b638027f954414614e0e4f90e7b972cdb607dc40dfa06f6c8a9bf3a04425f825ff5294dea2ab7d9922dc99bf986a617d39c7a1930de47d3afd94a722ee11c30733c4e98fc3095e857b3090a80e92cb19b61dd4def872d53f1787cee1a9806308ee1a319b686915e5ab98216e49fd7f26c12823c4c99c7277fcf02b74f" 179 | in 180 | let g = Z.of_string "0x5" in 181 | let y = 182 | Z.of_string 183 | "0x6751a59d5145c098ac9f997fcdc0fe139ba11050ad3ce40a049facd92395f6d44774e195c8fbad5f12f6365c7b07920f1af4bd10c106d89381d3529490ca437d44d42f71b1494dddb2238506cae5deef6e51def109e1c0d5f65ed6abafda5d59f5fff76603b2b9715da3c05a89c58ab5c542d5c17198ac799c6abd9cb690daf215f380a866b7d172e2ad486cd200f67afa6f7a05b74c8211a4f45bac7ca64beab87ff24ae8b748f09f609645370b2f5da4148544f15938df4dbcee581c0cd1df168e6b0341a7f0d0a2353ac58ee556b721c0bb7b92aea9dc4d70b36bc430f19b177ce80768e0aa8146e535b0d1d191848bb68039537ac9452cdfcefcffe75342" 184 | in 185 | Elgamal.Public.{p; g; y} 186 | in 187 | let packet = 188 | Packet.Public_key. 189 | { version = 4 190 | ; public_key = Elgamal expected_public 191 | ; algo = Algo.Public.Elgamal_enc_only 192 | ; creation_time = 1627053473l 193 | ; validity_period = None } 194 | in 195 | Packet.Body.Public_subkey packet 196 | 197 | let test_public = 198 | test_val ~nth:3 ~decode ~expected:public_packet "elgamal_public.pgp" 199 | 200 | let suite = ["Public" >:: test_public] 201 | end 202 | 203 | let id_packet = Packet.Body.Id "Clement " 204 | let id_packet2 = Packet.Body.Id "Dimitri Torterat " 205 | 206 | module Test_errors = struct 207 | let test_rsa_tag0 ctxt = 208 | let file = fixture "rsa_tag0.pgp" in 209 | let res = decode file in 210 | let error = Result.get_error (List.hd res) in 211 | assert_equal ~ctxt error "Tag 0" 212 | 213 | let test_bad_algo ctxt = 214 | let file = fixture "bad_pub_algo.pgp" in 215 | let res = decode file in 216 | let error = Result.get_error (List.hd res) in 217 | assert_equal ~ctxt error "Unsupported algorithm: Unknown public algorithm" 218 | 219 | let test_bad_file ctxt = 220 | let file = fixture "bad_file.pgp" in 221 | let res = decode file in 222 | let error = Result.get_error (List.hd res) in 223 | assert_equal ~ctxt error "Bad header code" 224 | 225 | let test_bad_file_header ctxt = 226 | let file = fixture "bad_file_header.pgp" in 227 | let res = decode file in 228 | let error = Result.get_error (List.hd res) in 229 | assert_equal ~ctxt error 230 | "Bad packet header: length is greater than packet size" 231 | 232 | let suite = 233 | [ "Tag0" >:: test_rsa_tag0 234 | ; "Bad_algo" >:: test_bad_algo 235 | ; "Bad_file" >:: test_bad_file 236 | ; "Bad file header" >:: test_bad_file_header ] 237 | end 238 | 239 | module Signature = struct 240 | let signature 241 | ~tag 242 | ~id 243 | ?(version = 4) 244 | ?(revocation = []) 245 | ?(key_flags = []) 246 | validity_period 247 | signature_type = 248 | let subpackets = 249 | List.concat 250 | [ key_flags 251 | ; validity_period 252 | |> Option.to_list 253 | |> List.map (fun validity_period -> 254 | Packet.Signature.Subpacket.Key_expiration_time validity_period) 255 | ; revocation 256 | ; [Packet.Signature.Subpacket.Issuer_id id] ] 257 | in 258 | Packet.Body.Signature {tag; version; subpackets; signature_type} 259 | 260 | let test_no_validity_key = 261 | let signature_packet = 262 | signature ~tag:19 None User_certification ~id:"a03468a124471e7d" 263 | ~key_flags:[Uses [Certification; Sign_data]] 264 | in 265 | test_val ~nth:2 ~decode ~expected:signature_packet "dsa_public.pgp" 266 | 267 | let test_2_years_key = 268 | let signature_packet = 269 | signature ~tag:19 (Some 63072000l) User_certification 270 | ~id:"19568ea520a6efa1" 271 | ~key_flags:[Uses [Certification; Sign_data]] 272 | in 273 | test_val ~nth:2 ~decode ~expected:signature_packet "rsa_public.pgp" 274 | 275 | let test_2_years_subkey = 276 | let signature_packet = 277 | signature ~tag:24 (Some 63072000l) Subkey_binding ~id:"19568ea520a6efa1" 278 | ~key_flags:[Uses [Encrypt_communication; Encrypt_storage]] 279 | in 280 | test_val ~nth:4 ~decode ~expected:signature_packet "rsa_public.pgp" 281 | 282 | let test_revocation = 283 | let signature_packet = 284 | signature ~tag:40 None Revocation ~id:"87f30257ae1e0000" 285 | ~revocation: 286 | [ Revocation_reason 287 | (Key_superseded 288 | "Forgot the PIN to my smartcard on which these subkeys were \ 289 | stored.") ] 290 | in 291 | test_val ~nth:17 ~decode ~expected:signature_packet 292 | "revocation_signature.pgp" 293 | 294 | let suite = 295 | [ "No 2 years period key" >:: test_2_years_key 296 | ; "No 2 years period subkey" >:: test_2_years_subkey 297 | ; "No validity period key" >:: test_no_validity_key 298 | ; "Revocation" >:: test_revocation ] 299 | end 300 | 301 | module Id = struct 302 | let test_id = test_val ~nth:1 ~decode ~expected:id_packet "rsa_public.pgp" 303 | 304 | let test_id2 = 305 | test_val ~nth:6 ~decode ~expected:id_packet2 "revocation_signature.pgp" 306 | 307 | let suite = ["Id 1" >:: test_id; "Id 2" >:: test_id2] 308 | end 309 | 310 | let test_marker = 311 | test_val ~decode ~expected:Packet.Body.Marker "test_marker.pgp" 312 | 313 | let suite = 314 | [ "Rsa" >::: Rsa.suite 315 | ; "Dsa" >::: Dsa.suite 316 | ; "Id" >::: Id.suite 317 | ; "Signatures" >::: Signature.suite 318 | ; "Marker" >:: test_marker 319 | ; "Errors" >::: Test_errors.suite 320 | ; "Elgamal" >::: Elgamal.suite ] 321 | -------------------------------------------------------------------------------- /tests/test_util.ml: -------------------------------------------------------------------------------- 1 | open OUnit2 2 | 3 | let assert_ok r test = 4 | match r with 5 | | Result.Ok x -> test x 6 | | Result.Error s -> assert_failure s 7 | 8 | let assert_error r test = 9 | match r with 10 | | Result.Ok _ -> assert_failure "Expected error" 11 | | Result.Error s -> test s 12 | 13 | let equal_options ~(equal : 'a -> 'a -> bool) (a : 'a option) (b : 'a option) = 14 | match (a, b) with 15 | | (Some x, Some y) -> equal x y 16 | | (None, None) -> true 17 | | (_, _) -> false 18 | 19 | let cstruct_of_hex str = `Hex (String.lowercase_ascii str) |> Hex.to_cstruct 20 | --------------------------------------------------------------------------------