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

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

5
unikernel/duniverse/ocaml-x509/.gitignore vendored Normal file
View file

@ -0,0 +1,5 @@
_build/
*.install
.merlin
random/

354
unikernel/duniverse/ocaml-x509/CHANGES.md Normal file
View file

@ -0,0 +1,354 @@
## v1.0.6 (2025-04-15)
* Update tests to mirage-crypto-rng 1.2.0 API (@hannesm)
* Certificate.fold_pem_multiple: improve error message (#180 @hannesm)
## v1.0.5 (2024-10-28)
* Removed links to nqsb (we're no longer in charge of that domain)
(6398b0c2a24e1a09d494d93ac65423eca9d7de24)
## v1.0.4 (2024-09-29)
* **breaking change** Allow decoding of negative serial numbers (#177 @hannesm)
Now, `serial` returns the entire (integer) value as a string - previously the
potentially leading 0 byte was removed. So:
-serial d795 49bd 1a67 1751
+serial 00d7 9549 bd1a 6717 51
fixes in 38cc70a54d2d98526564733838769d82b10679fc and #179 (#178 @dinosaure)
* Add alternate SHA1RSA OID 1.3.14.3.2.29 (#176 @mefyl)
* Allow custom pretty printers for unknown X509 extensions (#175 @reynir)
* Minor code cleanups: remove unused algorithms, remove `def` and `def'`
(#177 @hannesm)
## v1.0.3 (2024-09-04)
* Use the opam package kdf instead of pbkdf (@hannesm #174)
## v1.0.2 (2024-08-25)
* Fix RSA public and private key encoding and decoding (@hannesm #172, reported
by @anmonteiro #171)
## v1.0.1 (2024-08-06)
* Speedup PEM decoding and encoding significantly (@hannesm #170)
## v1.0.0 (2024-07-20)
* **breaking change** Replace `Cstruct.t` by `string` (@dinosaure, @hannesm, #167)
* Remove P224 (@dinosaure, @hannes, #166) - which was removed in mirage-crypto-ec 1.0.0
* **breaking change** The serial number of certificates is a `string` and enforced to be a positive
integer of at most 20 bytes in length (@hannesm, #167)
* **breaking change** `Authenticator.server_key_fingerprint` and
`Authenticator.server_cert_fingerprint` are now known as
`Authenticator.key_fingerprint` and `Authenticator.cert_fingerprint`
respectively to better reflect that they do not check extended key usage is
"server" and may as well be used for authenticating clients (@reynir, #164)
* Add Certificate.fold_decode_pem_multiple to decode multiple pem encoded certificates and make the error handling explicit (ignore, log, fail on first error). Motivated by mirage/ca-certs#30 (@art-w #169)
## v0.16.5 (2023-07-03)
* Always embed local_key_id in PKCS12 bags (reported #163 by @NightBlues,
revised and implemented by @hannesm)
## v0.16.4 (2023-02-13)
* Adapt to mirage-crypto-rng 0.11.0 API changes (#162 @hannesm)
## v0.16.3 (2023-02-04)
* Validation: allow self-signed server certificate with BasicConstraints CA=true
(reported by @mbacarella in mirleft/ocaml-tls#446
(https://github.com/lightningnetwork/lnd/issues/5450), fix #161 by @hannesm)
## v0.16.2 (2022-10-05)
* Improve parse error message of Authenticator.of_string (mirage/ocaml-git#593
by @dinosaure, mirage/ocaml-git#582 by @reynir)
## v0.16.1 (2022-09-14)
* Support ECDSA signatures where the hash algorithm output length exceeds the
size of the elliptic curve (by truncating, and using the leftmost bits).
Reported as #158 by @torinnd, fixed in #159 by @hannesm
## v0.16.0 (2022-02-15)
* Provide X509.Authenticator.of_string to construct an Authenticator.t from
a string (@dinosaure #156, reviewed by @hannesm)
* Minor documentation fixes (#157 @hannesm)
## v0.15.2 (2021-11-22)
* Provide X509.Private_key.of_string (as used by awa and dns-certify). This
takes a b64 encoded raw private key or a seed. (@reynir @hannesm #155)
## v0.15.1 (2021-10-26)
* avoid usae of deprecated functions of fmt (@hannesm)
* remove rresult dependency (@hannesm)
## v0.15.0 (2021-09-27)
* FEATURE support validation of an IP address in the leaf certificate
(#152 #153 @reynir @hannesm)
* FEATURE provide Certificate.ips and Certificate.supports_ip
(#152 @reynir @hannesm)
* BREAKING revise certificate and public key fingerprint authenticators API:
now a single fingerprint is supported, previously a list of pairs of
hostname and fingerprint was used (#153 @hannesm)
* BREAKING The Authenticator.t type has been extended with ?ip:Ipaddr.t
(#153 @hannesm)
## v0.14.1 (2021-08-04)
* Use Cstruct.length instead of deprecated Cstruct.len, bump minimum cstruct
to 6.0.0 (#151 by @hannesm)
## v0.14.0 (2021-06-17)
* FEATURE support Online Certificate Status Protocol (OCSP, RFC 6960)
(#148 @NightBlues, #149 @hannesm)
## v0.13.0 (2021-04-22)
* FEATURE support for RFC 5915 "BEGIN EC PRIVATE KEY" pem encoded private keys
(#147 @hannesm, requested by @ulrikstrid)
* BREAKING remove EC_pub _ from Public_key.t and EC _ from Certificate.key_type
(#147 by @hannesm)
* BREAKING move Certificate.key_type to Key_type.t (#147 @hannesm)
* FEATURE some private key utilities (of_cstruct, generate, sign), and
Public_key.verify (#report #146, fix #147 @hannesm)
* BREAKING rename hash_whitelist to allowed_hashes (#147 @hannesm)
* BREAKING provide Key_type.signature_scheme and use across the API
(#147 @hannesm)
## v0.12.0 (2021-04-05)
* FEATURE PKCS12 support (#114 by @hannesm)
* FEATURE ECDSA and EDDSA support via mirage-crypto-ec (#145 by @hannesm)
This breaks some clients since the Private_key.t and Public_key.t variants
are extended (may result in partial pattern matches of users of this library).
* CRL.is_revoked has `crls` as last parameter to avoid warning 16
(4.12 compatibility) (#144 by @hannesm)
* Signing_request.sign: add optional labelled argument `~subject` to allow
changing the subject when signing a signing request (#139 by @reynir)
* BUGFIX Encoding of Distinguished_name components (adhere to specification)
DomainComponent and EMail are now serialised using a IA5String; Serialnumber,
CountryName and DnQualifier as PrintableString (reported in #69, fixed #140
by @NightBlues)
* BREAKING Remove `~sloppy` from Private_key.decode_{pem,der}. The seemingly
bad RSA keys were valid and should have been accepted by mirage-crypto.
(#142 by @psafont)
## v0.11.2 (2020-05-14)
* Private_key.decode_{pem,der} now has a `~sloppy` option to recover from
bad keys (where e.g. the private exponent d is wrong).
(#135 by @hannesm, reported by @mattjbray in mirage/mirage-crypto#62)
## v0.11.1 (2020-04-27)
* open variant for errors to make the composable (#133 by @dinosaure,
review by @hannesm)
* BUGFIX avoid fractional seconds in generalized_time: truncate on serialising,
validate them to be 0 on deserialising, as required in RFC 5280 4.1.2.5.2
(#134 by @hannesm, reported by @ansiwen)
## v0.11.0 (2020-04-07)
* BREAKING Validation.validate_raw_signature results in a
`(unit, signature_error) result` and logs (Logs.warn) if a weak (non-SHA2)
hash algorithm was used. This function is used for verifying signatures
on certificates, signing requests, and certificate revocation lists.
* The `` `CAInvalidSelfSignature `` constructor (Validation.ca_error) and
`` `ChainInvalidSignature `` constructor (Validation.chain_validation_error)
have been removed.
* BREAKING The polymorphic variant `Validation.chain_error` is now flat (the
tags `` `Chain `` and `` `Leaf `` have been removed)
* BREAKING Adapted return type of CRL.validate and CRL.verify
* The pretty-printer Public_key.pp is now provided
* All implemented by @hannesm in #132 based on private conversation with @cfcs
(who kindly reviewed the changes)
## v0.10.0 (2020-03-11)
* BREAKING #131 use mirage-crypto and mirage-crypto-pk instead of nocrypto
raise lower OCaml bound to 4.07.0, test 4.10.0 in CI
* BREAKING #131 Certificate.Host_set is now Host.Set, and has pretty-printers
* BREAKING #131 Authenticator.null was removed (fixes #130, suggested by @emillon)
* BREAKING #131 Authenticator.t now requires (non-optional) ~host and ~time
arguments which may return an option. This allows to more easily spot the
cases where None is provided. Also, time is (unit -> Ptime.t option) instead
of Ptime.t -- thus the timestamp at the time of certificate verification is
used instead of the time of Authenticator construction. Similar changes in
Validation for verify_chain, verify_chain_of_trust, trust_key_fingerprint,
trust_cert_fingerprint.
fixes #130, suggested by @emillon
## v0.9.0 (2020-01-22)
* BREAKING add a whitelist of hash algorithms used for signatures. The default
whitelist is the SHA-2 family (without SHA-224), Validation.valid_ca{,s} use
all algorithms as default
reported by @emillon in #123, fixed in #128
* BREAKING Certificate.hostnames and Signing_request.hostnames (new) return a
set of [`Wildcard|`Strict] * [`host] Domain_name.t (Certificate.Host_set.t)
reported by @mmaker in #88, fixed in #127
* BREAKING #127 Signing_request.sign returns a result type now, an error is
returned if the signing request was not properly signed
* BREAKING #127 Validation.{verify_chain_of_trust, trust_key_fingerprint,
trust_cert_fingerptint} and the type Authenticator.t changed, no longer use
of a Certificate.host, but instead a [`host] Domain_name.t (previously, it was
a pair)
* BUGFIX support AlgorithmIdentifier of RSA signature algorithms with parameter
not present
reported by @Ulrar in #108, fixed in #129
* BUGFIX #127 preserve a signed signing request (Country in a DN sometimes uses
a non-utf8 string encoding)
* remove deprecation from Validation.trust_cert_fingerprint and
Authenticator.server_cert_fingerprint
requested by @mben-romdhane in #125, fixed in #126
* Certificate.signature_algorithm, CRL.signature_algorithm, and
Signing_request.signature_algorithm are now provided, returning a
([`RSA|`ECDSA] * Nocrypto.Hash.hash) option
requested by @psafont in #123, fixed in #128
## v0.8.1 (2019-10-10)
* export Private_key.decode_der and encode_der
## v0.8.0 (2019-10-10)
* export X509.Distinguished_name.common_name : t -> string option, which
extracts the common name of a distinguished name
* Distinguished_name.t is now a Relative_distinguished_name.t list, a
Relative_distinguished_name is a Set.S with element type attribute, a variant.
It used to be an attribute (expressed as GADT) Gmap.t, but this representation
did not conform to RFC 5280, reported by @paurkedal (#117, fixed by #118)
* Now using Set.find_first_opt, which bumps lower OCaml bound to 4.05.0
* Improved pretty-printing for DNs including RFC 4514 conformance (@paurkedal, #119).
* Extension.pp now outputs extension key and its value (#120)
* rename Distinguished_name.SP constructor (stateOrProvince) to ST, as widely used (#121)
* support Street and UID in Distinguished_name to satisfy RFC 4514 demands (#121)
## v0.7.1 (2019-08-09)
* revert General_name.t (DNS and IP components) to string/Cstruct.t list
- NameConstraints uses DNSname with strings with leading dots (.example.com),
which are not valid RFC1034 domain names
- NameConstraints uses IP with IP/netmask, i.e. using 8 octets for an IPv4
address
- X509.Certificate.hostnames still return a Domain_name.Set.t
- reported by @reynir
* drop ipaddr dependency
## 0.7.0 (2019-07-24)
* major restructuring, it is unlikely any pre-0.7.0 users will work with 0.7.0+
* remove sexp de&encoders
* provide pretty-printers for validation errors (and types) instead of to_string functions
* use result type and Rresult instead of custom result types and control monad
* use a GADT map for certificate & csr extensions, distinguished names, general names (avoiding multiple extensions with the same OID, uses the gmap library)
* use domain-name library for hostname validation (instead of custom string matching)
* use ipaddr library for IPs in SubjectAlternativeName extension
* remove Encoding module, provide {en,de}code_{der,pem} in the respective modules (which decoders return (_, [> `Msg of string ]) result, no exceptions raised)
* fix DistributionPoint extension: the CRLissuer is a GeneralName, not a DistinguishedName
* remove Extension.reason_code (Extension.reason was there before, and is now used)
* remove bindings from toplevel, t is now Certificate.t, public_key is now Public_key.t
* use alcotest instead of oUnit
## 0.6.3 (2019-04-02)
* provide X509.Encoding.distinguished_name_of_cs -- similar to #87 which provided distinguished_name_to_cs
* provide X509.Encoding.{public_key_of_cstruct,public_key_to_cstruct}, as requested by @dinosaure
* support of cstruct 4.0.0, which split up the sexp de&encoders
* removes result dependency (now requires >= 4.04.2)
* upgrades opam file to version 2.0
* build system is now dune
## 0.6.2 (2018-08-24)
* compatibility with ppx_sexp_conv >v0.11.0 (#109), required for 4.07.0
## 0.6.1 (2017-12-21)
* provide X509.distinguished_name sexp converter (#103)
* drop non-exported X509_types module from distinguished_name (#102, @yomimono)
## 0.6.0 (2017-12-13)
* Certificate Revocation List (CRL) support (#99)
* track asn1-combinators 0.2.0 changes (#97)
* provide Extension.subject_alt_names (#95)
* compute length of certificate length, instead of hardcoding 4 (#95)
* enable safe-string (#89)
* use astring instead of custom String_ext.split (#89)
* use topkg instead of oasis (#88, #89)
* provide Encoding.cs_of_distinguished_name (#87 by @reynir)
## 0.5.3 (2016-09-13)
* provide Encoding.parse_signing_request and Encoding.cs_of_signing_request (#81)
* provide validity : t -> (Time.t * Time.t) (#86, fixes #85)
## 0.5.2 (2016-04-13)
* fix building of certificate paths
## 0.5.1 (2016-03-21)
* use ppx_sexp_conv instead of sexplib.syntax
* no more Stream syntax, use lists
## 0.5.0 (2015-12-04)
* avoid dependency on sexplib.syntax (#55)
* document how to combine extensions and a CSR into a certificate (@reynir, #63 #64)
* expose `fingerprint : t -> hash -> Cstruct.t`, the hash of the certificate (@cfcs, #66)
* trust_fingerprint / server_fingerprint are renamed to trust_cert_fingerprint / server_cert_fingerprint (now deprecated!)
* fingerprint public keys (rather than certificates): trust_key_fingerprint / server_key_fingerprint
* build certificate paths from the received set (RFC 4158) instead of requiring a strict chain (#74)
* the given trust anchors to `Authenticator.chain_of_trust` are not validated (to contain KeyUsage / BasicConstraint extensions) anymore, users can use `valid_ca` and `valid_cas` to filter CAs upfront
## 0.4.0 (2015-07-02)
* certificate signing request support (PKCS10)
* basic CA functionality (in CA module): create and sign certificate signing requests
* PEM encoding of X.509 certificates, RSA public and private keys, and certificate signing requests
* new module Extension contains X509v3 extensions as polymorphic variants
* expose distinguished_name as polymorphic variant
* type pubkey is now public_key
* function cert_pubkey is now public_key
* functions supports_usage, supports_extended_usage are now in Extension module
* types key_usage, extended_key_usage are now in Extension module
* Encoding.Pem.Cert has been renamed to Encoding.Pem.Certificate
* Encoding.Pem.PK has been renamed to Encoding.Pem.Private_key (now uses type private_key instead of Nocrypto.Rsa.priv)
## 0.3.1 (2015-05-02)
* PKCS8 private key info support (only unencrypted keys so far)
## 0.3.0 (2015-03-19)
* more detailed error messages (type certificate_failure modified)
* no longer Printf.printf debug messages
* error reporting: `Ok of certificate option | `Fail of certificate_failure
* fingerprint verification can work with None as host (useful for client authentication where host is not known upfront)
* API reshape: X509 is the only public module, X509.t is the abstract certificate
## 0.2.1 (2014-12-21)
* server_fingerprint authenticator which validates the server certificate based on a hash algorithm and (server_name * fingerprint) list instead of a set of trust anchors
* whitelist CAcert certificates (which do not include mandatory X.509v3 KeyUsage extension)
## 0.2.0 (2014-10-30)
* expose Certificate.cert_hostnames, wildcard_matches
* Certificate.verify_chain_of_trust and X509.authenticate both return now
[ `Ok of certificate | `Fail of certificate_failure ], where [certificate] is the trust anchor
## 0.1.0 (2014-07-08)
* initial beta release

23
unikernel/duniverse/ocaml-x509/LICENSE.md Normal file
View file

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

22
unikernel/duniverse/ocaml-x509/README.md Normal file
View file

@ -0,0 +1,22 @@
## X.509 - Public Key Infrastructure purely in OCaml
v1.0.6
X.509 is a public key infrastructure used mostly on the Internet. It consists
of certificates which include public keys and identifiers, signed by an
authority. Authorities must be exchanged over a second channel to establish the
trust relationship. This library implements most parts of
[RFC5280](https://tools.ietf.org/html/rfc5280) and
[RFC6125](https://tools.ietf.org/html/rfc6125). The
[Public Key Cryptography Standards (PKCS)](https://en.wikipedia.org/wiki/PKCS)
defines encoding and decoding in ASN.1 DER and PEM format, which is also
implemented by this library - namely PKCS 1, PKCS 7, PKCS 8, PKCS 9 and PKCS 10.
Read our [Usenix Security 2015 paper](https://www.usenix.org/conference/usenixsecurity15/technical-sessions/presentation/kaloper-mersinjak).
## Documentation
[API documentation](https://mirleft.github.io/ocaml-x509/doc)
## Installation
`opam install x509` will install this library.

3
unikernel/duniverse/ocaml-x509/dune-project Normal file
View file

@ -0,0 +1,3 @@
(lang dune 2.0)
(name x509)
(version v1.0.6)

385
unikernel/duniverse/ocaml-x509/lib/algorithm.ml Normal file
View file

@ -0,0 +1,385 @@
open Asn.S
open Asn_grammars
(* This type really conflates three things: the set of pk algos that describe
* the public key, the set of hashes, and the set of hash+pk algo combinations
* that describe digests. The three are conflated because they are generated by
* the same ASN grammar, AlgorithmIdentifier, to keep things close to the
* standards.
*
* It's expected that downstream code with pick a subset and add a catch-all
* that handles unsupported algos anyway.
*)
type ec_curve =
[ `SECP256R1 | `SECP384R1 | `SECP521R1 ]
let ec_curve_to_string = function
| `SECP256R1 -> "SECP256R1"
| `SECP384R1 -> "SECP384R1"
| `SECP521R1 -> "SECP521R1"
type t =
(* pk algos *)
(* any more? is the universe big enough? ramsey's theorem for pk cyphers? *)
| RSA
| EC_pub of ec_curve
(* sig algos *)
| MD5_RSA
| SHA1_RSA
| SHA256_RSA
| SHA384_RSA
| SHA512_RSA
| SHA224_RSA
| ECDSA_SHA1
| ECDSA_SHA224
| ECDSA_SHA256
| ECDSA_SHA384
| ECDSA_SHA512
| ED25519
(* digest algorithms *)
| MD5
| SHA1
| SHA256
| SHA384
| SHA512
| SHA224
(* HMAC algorithms *)
| HMAC_SHA1
| HMAC_SHA224
| HMAC_SHA256
| HMAC_SHA384
| HMAC_SHA512
(* symmetric block ciphers *)
| AES128_CBC of string
| AES192_CBC of string
| AES256_CBC of string
(* PBE encryption algorithms *)
| SHA_RC4_128 of string * int
| SHA_RC4_40 of string * int
| SHA_3DES_CBC of string * int
| SHA_2DES_CBC of string * int
| SHA_RC2_128_CBC of string * int
| SHA_RC2_40_CBC of string * int
| PBKDF2 of string * int * int option * t
| PBES2 of t * t
let to_string = function
| RSA -> "RSA"
| EC_pub curve -> ec_curve_to_string curve
| MD5_RSA -> "RSA MD5"
| SHA1_RSA -> "RSA SHA1"
| SHA256_RSA -> "RSA SHA256"
| SHA384_RSA -> "RSA SHA384"
| SHA512_RSA -> "RSA SHA512"
| SHA224_RSA -> "RSA SHA224"
| ECDSA_SHA1 -> "ECDSA SHA1"
| ECDSA_SHA224 -> "ECDSA SHA224"
| ECDSA_SHA256 -> "ECDSA SHA256"
| ECDSA_SHA384 -> "ECDSA SHA384"
| ECDSA_SHA512 -> "ECDSA SHA512"
| ED25519 -> "Ed25519"
| MD5 -> "MD5"
| SHA1 -> "SHA1"
| SHA256 -> "SHA256"
| SHA384 -> "SHA384"
| SHA512 -> "SHA512"
| SHA224 -> "SHA224"
| HMAC_SHA1 -> "HMAC SHA1"
| HMAC_SHA224 -> "HMAC SHA224"
| HMAC_SHA256 -> "HMAC SHA256"
| HMAC_SHA384 -> "HMAC SHA384"
| HMAC_SHA512 -> "HMAC SHA512"
| AES128_CBC _ -> "AES128 CBC"
| AES192_CBC _ -> "AES192 CBC"
| AES256_CBC _ -> "AES256 CBC"
| SHA_RC4_128 (_, _) -> "PBES: SHA RC4 128"
| SHA_RC4_40 (_, _) -> "PBES: SHA RC4 40"
| SHA_3DES_CBC (_, _) -> "PBES: SHA 3DES CBC"
| SHA_2DES_CBC (_, _) -> "PBES: SHA 2DES CBC"
| SHA_RC2_128_CBC (_, _) -> "PBES: SHA RC2 128"
| SHA_RC2_40_CBC (_, _) -> "PBES: SHA RC2 40"
| PBKDF2 (_, _, _, _) -> "PBKDF2"
| PBES2 (_, _) -> "PBES2"
let to_hash = function
| MD5 -> Some `MD5
| SHA1 -> Some `SHA1
| SHA224 -> Some `SHA224
| SHA256 -> Some `SHA256
| SHA384 -> Some `SHA384
| SHA512 -> Some `SHA512
| _ -> None
and of_hash = function
| `MD5 -> MD5
| `SHA1 -> SHA1
| `SHA224 -> SHA224
| `SHA256 -> SHA256
| `SHA384 -> SHA384
| `SHA512 -> SHA512
and to_hmac = function
| HMAC_SHA1 -> Some `SHA1
| HMAC_SHA224 -> Some `SHA224
| HMAC_SHA256 -> Some `SHA256
| HMAC_SHA384 -> Some `SHA384
| HMAC_SHA512 -> Some `SHA512
| _ -> None
and of_hmac = function
| `SHA1 -> HMAC_SHA1
| `SHA224 -> HMAC_SHA224
| `SHA256 -> HMAC_SHA256
| `SHA384 -> HMAC_SHA384
| `SHA512 -> HMAC_SHA512
and to_key_type = function
| RSA -> Some `RSA
| EC_pub curve -> Some (`EC curve)
| ED25519 -> Some `ED25519
| _ -> None
and of_key_type = function
| `RSA -> RSA
| `EC curve -> EC_pub curve
| `ED25519 -> ED25519
and to_signature_algorithm = function
| MD5_RSA -> Some (`RSA_PKCS1, `MD5)
| SHA1_RSA -> Some (`RSA_PKCS1, `SHA1)
| SHA256_RSA -> Some (`RSA_PKCS1, `SHA256)
| SHA384_RSA -> Some (`RSA_PKCS1, `SHA384)
| SHA512_RSA -> Some (`RSA_PKCS1, `SHA512)
| SHA224_RSA -> Some (`RSA_PKCS1, `SHA224)
| ECDSA_SHA1 -> Some (`ECDSA, `SHA1)
| ECDSA_SHA224 -> Some (`ECDSA, `SHA224)
| ECDSA_SHA256 -> Some (`ECDSA, `SHA256)
| ECDSA_SHA384 -> Some (`ECDSA, `SHA384)
| ECDSA_SHA512 -> Some (`ECDSA, `SHA512)
| ED25519 -> Some (`ED25519, `SHA512)
| _ -> None
and of_signature_algorithm public_key_algorithm digest =
match public_key_algorithm, digest with
| (`RSA_PKCS1, `MD5) -> MD5_RSA
| (`RSA_PKCS1, `SHA1) -> SHA1_RSA
| (`RSA_PKCS1, `SHA256) -> SHA256_RSA
| (`RSA_PKCS1, `SHA384) -> SHA384_RSA
| (`RSA_PKCS1, `SHA512) -> SHA512_RSA
| (`RSA_PKCS1, `SHA224) -> SHA224_RSA
| (`ECDSA, `SHA1) -> ECDSA_SHA1
| (`ECDSA, `SHA224) -> ECDSA_SHA224
| (`ECDSA, `SHA256) -> ECDSA_SHA256
| (`ECDSA, `SHA384) -> ECDSA_SHA384
| (`ECDSA, `SHA512) -> ECDSA_SHA512
| (`ED25519, _) -> ED25519
| _ -> failwith "unsupported signature scheme and hash"
(* XXX
*
* PKCS1/RFC5280 allows params to be `ANY', depending on the algorithm. I don't
* know of one that uses anything other than NULL and OID, however, so we accept
* only that.
RFC 3279 Section 2.2.1 defines for RSA Signature Algorithms SHALL have null
as parameter, but certificates in the wild don't contain the parameter field
at all (it is optional). We accept both, and output a null paramter.
Section 2.2.2 specifies DSA to have a null parameter,
Section 2.2.3 specifies ECDSA to have a null parameter,
Section 2.3.1 specifies rsaEncryption (for RSA public keys) requires null.
*)
let curve_of_oid, curve_to_oid =
let open Registry.ANSI_X9_62 in
(let default oid = Asn.(S.parse_error "Unknown algorithm %a" OID.pp oid) in
case_of_oid ~default [
(secp256r1, `SECP256R1) ;
(secp384r1, `SECP384R1) ;
(secp521r1, `SECP521R1) ;
]),
(function
| `SECP256R1 -> secp256r1
| `SECP384R1 -> secp384r1
| `SECP521R1 -> secp521r1)
let identifier =
let open Registry in
let f =
let none x = function
| None -> x
| _ -> parse_error "Algorithm: expected no parameters"
and null x = function
| Some (`C1 ()) -> x
| _ -> parse_error "Algorithm: expected null parameters"
and null_or_none x = function
| None | Some (`C1 ()) -> x
| _ -> parse_error "Algorithm: expected null or none parameter"
and oid f = function
| Some (`C2 id) -> f id
| _ -> parse_error "Algorithm: expected parameter OID"
and pbe f = function
| Some (`C3 `PBE pbe) -> f pbe
| _ -> parse_error "Algorithm: expected parameter PBE"
and pbkdf2 f = function
| Some (`C3 `PBKDF2 params) -> f params
| _ -> parse_error "Algorithm: expected parameter PBKDF2"
and pbes2 f = function
| Some (`C3 `PBES2 params) -> f params
| _ -> parse_error "Algorithm: expected parameter PBES2"
and octets f = function
| Some (`C4 salt) -> f salt
| _ -> parse_error "Algorithm: expected parameter octet_string"
and default oid = Asn.(S.parse_error "Unknown algorithm %a" OID.pp oid)
in
case_of_oid_f ~default [
(ANSI_X9_62.ec_pub_key, oid (fun id -> EC_pub (curve_of_oid id))) ;
(PKCS1.rsa_encryption , null RSA ) ;
(PKCS1.md5_rsa_encryption , null_or_none MD5_RSA ) ;
(PKCS1.sha1_rsa_encryption , null_or_none SHA1_RSA ) ;
(sha1_rsa_encryption , null_or_none SHA1_RSA ) ;
(PKCS1.sha256_rsa_encryption , null_or_none SHA256_RSA ) ;
(PKCS1.sha384_rsa_encryption , null_or_none SHA384_RSA ) ;
(PKCS1.sha512_rsa_encryption , null_or_none SHA512_RSA ) ;
(PKCS1.sha224_rsa_encryption , null_or_none SHA224_RSA ) ;
(ANSI_X9_62.ecdsa_sha1 , none ECDSA_SHA1 ) ;
(ANSI_X9_62.ecdsa_sha224 , none ECDSA_SHA224 ) ;
(ANSI_X9_62.ecdsa_sha256 , none ECDSA_SHA256 ) ;
(ANSI_X9_62.ecdsa_sha384 , none ECDSA_SHA384 ) ;
(ANSI_X9_62.ecdsa_sha512 , none ECDSA_SHA512 ) ;
(RFC8410.ed25519 , none ED25519 ) ;
(md5 , null MD5 ) ;
(sha1 , null SHA1 ) ;
(sha256 , null SHA256 ) ;
(sha384 , null SHA384 ) ;
(sha512 , null SHA512 ) ;
(sha224 , null SHA224 ) ;
(PKCS2.hmac_sha1 , null HMAC_SHA1 );
(PKCS2.hmac_sha224 , null HMAC_SHA224 );
(PKCS2.hmac_sha256 , null HMAC_SHA256 );
(PKCS2.hmac_sha384 , null HMAC_SHA384 );
(PKCS2.hmac_sha512 , null HMAC_SHA512 );
(PKCS5.aes128_cbc , octets (fun iv -> AES128_CBC iv));
(PKCS5.aes192_cbc , octets (fun iv -> AES192_CBC iv));
(PKCS5.aes256_cbc , octets (fun iv -> AES256_CBC iv));
(PKCS12.pbe_with_SHA_and_128Bit_RC4, pbe (fun (s, i) -> SHA_RC4_128 (s, i))) ;
(PKCS12.pbe_with_SHA_and_40Bit_RC4, pbe (fun (s, i) -> SHA_RC4_40 (s, i))) ;
(PKCS12.pbe_with_SHA_and_3_KeyTripleDES_CBC, pbe (fun (s, i) -> SHA_3DES_CBC (s, i))) ;
(PKCS12.pbe_with_SHA_and_2_KeyTripleDES_CBC, pbe (fun (s, i) -> SHA_2DES_CBC (s, i))) ;
(PKCS12.pbe_with_SHA_and_128Bit_RC2_CBC, pbe (fun (s, i) -> SHA_RC2_128_CBC (s, i))) ;
(PKCS12.pbe_with_SHA_and_40Bit_RC2_CBC, pbe (fun (s, i) -> SHA_RC2_40_CBC (s, i))) ;
(PKCS5.pbkdf2, pbkdf2 (fun (s, i, l, m) -> PBKDF2 (s, i, l, m))) ;
(PKCS5.pbes2, pbes2 (fun (oid, oid') -> PBES2 (oid, oid')))
]
and g =
let none = None
and null = Some (`C1 ())
and oid id = Some (`C2 id)
and pbe (s, i) = Some (`C3 (`PBE (s, i)))
and pbkdf2 (s, i, k, m) = Some (`C3 (`PBKDF2 (s, i, k, m)))
and pbes2 (oid, oid') = Some (`C3 (`PBES2 (oid, oid')))
and octets data = Some (`C4 data)
in
function
| EC_pub id -> (ANSI_X9_62.ec_pub_key , oid (curve_to_oid id))
| RSA -> (PKCS1.rsa_encryption , null)
| MD5_RSA -> (PKCS1.md5_rsa_encryption , null)
| SHA1_RSA -> (PKCS1.sha1_rsa_encryption , null)
| SHA256_RSA -> (PKCS1.sha256_rsa_encryption , null)
| SHA384_RSA -> (PKCS1.sha384_rsa_encryption , null)
| SHA512_RSA -> (PKCS1.sha512_rsa_encryption , null)
| SHA224_RSA -> (PKCS1.sha224_rsa_encryption , null)
| ECDSA_SHA1 -> (ANSI_X9_62.ecdsa_sha1 , none)
| ECDSA_SHA224 -> (ANSI_X9_62.ecdsa_sha224 , none)
| ECDSA_SHA256 -> (ANSI_X9_62.ecdsa_sha256 , none)
| ECDSA_SHA384 -> (ANSI_X9_62.ecdsa_sha384 , none)
| ECDSA_SHA512 -> (ANSI_X9_62.ecdsa_sha512 , none)
| ED25519 -> (RFC8410.ed25519 , none)
| MD5 -> (md5 , null)
| SHA1 -> (sha1 , null)
| SHA256 -> (sha256 , null)
| SHA384 -> (sha384 , null)
| SHA512 -> (sha512 , null)
| SHA224 -> (sha224 , null)
| HMAC_SHA1 -> (PKCS2.hmac_sha1 , null)
| HMAC_SHA224 -> (PKCS2.hmac_sha224 , null)
| HMAC_SHA256 -> (PKCS2.hmac_sha256 , null)
| HMAC_SHA384 -> (PKCS2.hmac_sha384 , null)
| HMAC_SHA512 -> (PKCS2.hmac_sha512 , null)
| AES128_CBC iv -> (PKCS5.aes128_cbc , octets iv)
| AES192_CBC iv -> (PKCS5.aes192_cbc , octets iv)
| AES256_CBC iv -> (PKCS5.aes256_cbc , octets iv)
| SHA_RC4_128 (s, i) -> (PKCS12.pbe_with_SHA_and_128Bit_RC4, pbe (s, i))
| SHA_RC4_40 (s, i) -> (PKCS12.pbe_with_SHA_and_40Bit_RC4, pbe (s, i))
| SHA_3DES_CBC (s, i) -> (PKCS12.pbe_with_SHA_and_3_KeyTripleDES_CBC, pbe (s, i))
| SHA_2DES_CBC (s, i) -> (PKCS12.pbe_with_SHA_and_2_KeyTripleDES_CBC, pbe (s, i))
| SHA_RC2_128_CBC (s, i) -> (PKCS12.pbe_with_SHA_and_128Bit_RC2_CBC, pbe (s, i))
| SHA_RC2_40_CBC (s, i) -> (PKCS12.pbe_with_SHA_and_40Bit_RC2_CBC, pbe (s, i))
| PBKDF2 (s, i, k, m) -> (PKCS5.pbkdf2, pbkdf2 (s, i, k, m))
| PBES2 (oid, oid') -> (PKCS5.pbes2, pbes2 (oid, oid'))
in
fix (fun id ->
let pbkdf2_or_pbe_or_pbes2_params =
(* TODO PBKDF2 should support `C2 oid (saltSources) *)
let f (salt, count, (* key_len, *) prf) =
match salt, count, (* key_len, *) prf with
| `C1 salt, Some count, (* None, *) None -> `PBE (salt, count)
| `C1 salt, Some count, (* x, *) Some prf -> `PBKDF2 (salt, count, None, prf)
| `C2 oid, None, (* None, *) Some oid' -> `PBES2 (oid, oid')
| _ -> parse_error "bad parameters"
and g = function
| `PBE (salt, count) -> (`C1 salt, Some count, (* None, *) None)
| `PBKDF2 (salt, count, _key_len, prf) -> (`C1 salt, Some count, (* key_len, *) Some prf)
| `PBES2 (oid, oid') -> (`C2 oid, None, (* None, *) Some oid')
in
map f g @@
sequence3
(required ~label:"salt" (choice2 octet_string id))
(optional ~label:"iteration count" int) (* modified - required for pbkdf2/pbes *)
(* (optional ~label:"key length" int) (* should be there and optional *) *)
(optional ~label:"prf" id) (* only present in pbkdf2 / pbes2 *)
in
map f g @@
sequence2
(required ~label:"algorithm" oid)
(optional ~label:"params"
(choice4 null oid pbkdf2_or_pbe_or_pbes2_params octet_string)))
let ecdsa_sig =
sequence2
(required ~label:"r" unsigned_integer)
(required ~label:"s" unsigned_integer)
let ecdsa_sig_of_octets, ecdsa_sig_to_octets =
projections_of Asn.der ecdsa_sig
let pp fmt x = Fmt.string fmt (to_string x)

74
unikernel/duniverse/ocaml-x509/lib/asn_grammars.ml Normal file
View file

@ -0,0 +1,74 @@
let src = Logs.Src.create "x509.decoding" ~doc:"X509 decoding"
module Log = (val Logs.src_log src : Logs.LOG)
let ( let* ) = Result.bind
let decode codec cs =
let* a, cs = Asn.decode codec cs in
if String.length cs = 0 then Ok a else Error (`Parse "Leftover")
let projections_of encoding asn =
let c = Asn.codec encoding asn in (decode c, Asn.encode c)
module Hashtbl(T : Hashtbl.HashedType) = struct
include Hashtbl.Make (T)
let of_assoc xs =
let ht = create 16 in List.iter (fun (a, b) -> add ht a b) xs; ht
end
module OID_H = Hashtbl (struct
type t = Asn.oid let (equal, hash) = Asn.OID.(equal, hash)
end)
let case_of_oid ~default xs =
let ht = OID_H.of_assoc xs in fun a ->
try OID_H.find ht a with Not_found -> default a
let case_of_oid_f ~default xs =
let ht = OID_H.of_assoc xs in fun (a, b) ->
(try OID_H.find ht a with Not_found -> default a) b
(*
* A way to parse by propagating (and contributing to) exceptions, so those can
* be handles up in a single place. Meant for parsing embedded structures.
*
* XXX Would be nicer if combinators could handle embedded structures.
*)
let project_exn asn =
let c = Asn.(codec der) asn in
let dec cs = match decode c cs with
| Ok a -> a
| Error err -> Asn.S.error err in
(dec, Asn.encode c)
let err_to_msg f = Result.map_error (function `Parse msg -> `Msg msg) f
(* specified in RFC 5280 4.1.2.5.2 - "MUST NOT include fractional seconds" *)
let generalized_time_no_frac_s =
Asn.S.(map
(fun x ->
if Ptime.Span.(equal zero (Ptime.frac_s x)) then
x
else
parse_error "generalized time has fractional seconds")
(fun y -> Ptime.truncate ~frac_s:0 y)
generalized_time)
(* serial number, as defined in RFC 5280 4.1.2.2: must be > 0 and not be longer
than 20 octets. we accept 0.
we also accept < 0, but when encoding mandate >= 0!
*)
let serial =
Asn.S.(map
(fun x ->
if String.length x > 20 then parse_error "serial exceeds 20 octets";
if String.length x > 0 && String.get_uint8 x 0 > 0x7F then
Log.warn (fun m -> m "negative serial number %a" Ohex.pp x);
x)
(fun y ->
if String.length y > 20 then failwith "serial exceeds 20 octets";
if String.length y > 0 && String.get_uint8 y 0 > 0x7F then
"\x00" ^ y
else
y)
integer)

83
unikernel/duniverse/ocaml-x509/lib/authenticator.ml Normal file
View file

@ -0,0 +1,83 @@
let ( let* ) = Result.bind
type t = ?ip:Ipaddr.t -> host:[`host] Domain_name.t option ->
Certificate.t list -> Validation.r
(* XXX
* Authenticator just hands off a list of certs. Should be indexed.
* *)
let chain_of_trust ~time ?crls ?(allowed_hashes = Validation.sha2) cas =
let revoked = match crls with
| None -> None
| Some crls -> Some (Crl.is_revoked crls ~allowed_hashes)
in
fun ?ip ~host certificates ->
Validation.verify_chain_of_trust ?ip ~host ~time ?revoked ~allowed_hashes
~anchors:cas certificates
let key_fingerprint ~time ~hash ~fingerprint =
fun ?ip ~host certificates ->
Validation.trust_key_fingerprint ?ip ~host ~time ~hash ~fingerprint certificates
let cert_fingerprint ~time ~hash ~fingerprint =
fun ?ip ~host certificates ->
Validation.trust_cert_fingerprint ?ip ~host ~time ~hash ~fingerprint certificates
let hash_of_string = function
| "sha224" -> Ok `SHA224
| "sha256" -> Ok `SHA256
| "sha384" -> Ok `SHA384
| "sha512" -> Ok `SHA512
| hash -> Error (`Msg (Fmt.str "Unknown hash algorithm %S" hash))
let fingerprint_of_string s =
let* d =
Result.map_error
(function `Msg m ->
`Msg (Fmt.str "Invalid base64 encoding in fingerprint (%s): %S" m s))
(Base64.decode ~pad:false s)
in
Ok d
let format =
{|
The format of an authenticator is:
- [none]: no authentication
- [key-fp(:<hash>?):<base64-encoded fingerprint>]: to authenticate a peer via
its key fingerprintf (hash is optional and defaults to SHA256)
- [cert-fp(:<hash>?):<base64-encoded fingerprint>]: to authenticate a peer via
its certificate fingerprint (hash is optional and defaults to SHA256)
- [trust-anchor(:<base64-encoded DER certificate>)+] to authenticate a peer from
a list of certificates (certificate must be in PEM format witthout header and
footer (----BEGIN CERTIFICATE----) and without newlines).
|}
let of_string str =
begin match String.split_on_char ':' str with
| [ "key-fp" ; hash ; tls_key_fingerprint ] ->
let* hash = hash_of_string (String.lowercase_ascii hash) in
let* fingerprint = fingerprint_of_string tls_key_fingerprint in
Ok (fun time -> key_fingerprint ~time ~hash ~fingerprint)
| [ "key-fp" ; tls_key_fingerprint ] ->
let* fingerprint = fingerprint_of_string tls_key_fingerprint in
Ok (fun time -> key_fingerprint ~time ~hash:`SHA256 ~fingerprint)
| [ "cert-fp" ; hash ; tls_cert_fingerprint ] ->
let* hash = hash_of_string (String.lowercase_ascii hash) in
let* fingerprint = fingerprint_of_string tls_cert_fingerprint in
Ok (fun time -> cert_fingerprint ~time ~hash ~fingerprint)
| [ "cert-fp" ; tls_cert_fingerprint ] ->
let* fingerprint = fingerprint_of_string tls_cert_fingerprint in
Ok (fun time -> cert_fingerprint ~time ~hash:`SHA256 ~fingerprint)
| "trust-anchor" :: certs ->
let* anchors =
List.fold_left (fun acc s ->
let* acc = acc in
let* der = Base64.decode ~pad:false s in
let* cert = Certificate.decode_der der in
Ok (cert :: acc))
(Ok []) certs
in
Ok (fun time -> chain_of_trust ~time (List.rev anchors))
| [ "none" ] -> Ok (fun _ ?ip:_ ~host:_ _ -> Ok None)
| _ -> Error (`Msg (Fmt.str "Invalid TLS authenticator: %S" str))
end |> Result.map_error (function `Msg e -> `Msg (e ^ format))

264
unikernel/duniverse/ocaml-x509/lib/certificate.ml Normal file
View file

@ -0,0 +1,264 @@
(*
* X509 certs
*)
type tBSCertificate = {
version : [ `V1 | `V2 | `V3 ] ;
serial : string ;
signature : Algorithm.t ;
issuer : Distinguished_name.t ;
validity : Ptime.t * Ptime.t ;
subject : Distinguished_name.t ;
pk_info : Public_key.t ;
issuer_id : string option ;
subject_id : string option ;
extensions : Extension.t
}
type certificate = {
tbs_cert : tBSCertificate ;
signature_algo : Algorithm.t ;
signature_val : string
}
(*
* There are two reasons to carry octets around:
* - we still need to hack on the octets to get bytes to hash
* ( this needs to go )
* - we need a cs to send to the peer
* It's a bit ugly to have two levels, and both are better solved by extending
* the asn parser and writer respectively, but until then there needs to be one
* place that hides the existence of this pair.
*)
type t = {
asn : certificate ;
raw : string
}
module Asn = struct
open Asn.S
open Asn_grammars
let version =
map (function 2 -> `V3 | 1 -> `V2 | 0 -> `V1 | _ -> parse_error "unknown version")
(function `V3 -> 2 | `V2 -> 1 | `V1 -> 0)
int
let time =
let f = function `C1 t -> t | `C2 t -> t
and g t =
let (y, _, _) = Ptime.to_date t in
if y < 2050 then `C1 t else `C2 t in
map f g (choice2 utc_time generalized_time_no_frac_s)
let validity =
sequence2
(required ~label:"not before" time)
(required ~label:"not after" time)
let unique_identifier = bit_string_octets
let tBSCertificate =
let f = fun (a, (b, (c, (d, (e, (f, (g, (h, (i, j))))))))) ->
let extn = match j with None -> Extension.empty | Some xs -> xs in
{ version = Option.value ~default:`V1 a ; serial = b ;
signature = c ; issuer = d ;
validity = e ; subject = f ;
pk_info = g ; issuer_id = h ;
subject_id = i ; extensions = extn }
and g = fun
{ version = a ; serial = b ;
signature = c ; issuer = d ;
validity = e ; subject = f ;
pk_info = g ; issuer_id = h ;
subject_id = i ; extensions = j } ->
let extn = if Extension.is_empty j then None else Some j in
((if a = `V1 then None else Some a),
(b, (c, (d, (e, (f, (g, (h, (i, extn)))))))))
in
map f g @@
sequence @@
(optional ~label:"version" @@ explicit 0 version) (* default v1 *)
@ (required ~label:"serialNumber" @@ serial)
@ (required ~label:"signature" @@ Algorithm.identifier)
@ (required ~label:"issuer" @@ Distinguished_name.Asn.name)
@ (required ~label:"validity" @@ validity)
@ (required ~label:"subject" @@ Distinguished_name.Asn.name)
@ (required ~label:"subjectPKInfo" @@ Public_key.Asn.pk_info_der)
(* if present, version is v2 or v3 *)
@ (optional ~label:"issuerUID" @@ implicit 1 unique_identifier)
(* if present, version is v2 or v3 *)
@ (optional ~label:"subjectUID" @@ implicit 2 unique_identifier)
(* v3 if present *)
-@ (optional ~label:"extensions" @@ explicit 3 Extension.Asn.extensions_der)
let (tbs_certificate_of_octets, tbs_certificate_to_octets) =
projections_of Asn.der tBSCertificate
let certificate =
let f (a, b, c) =
if a.signature <> b then
parse_error "signatureAlgorithm != tbsCertificate.signature"
else
{ tbs_cert = a; signature_algo = b; signature_val = c }
and g { tbs_cert = a; signature_algo = b; signature_val = c } = (a, b, c) in
map f g @@
sequence3
(required ~label:"tbsCertificate" tBSCertificate)
(required ~label:"signatureAlgorithm" Algorithm.identifier)
(required ~label:"signatureValue" bit_string_octets)
let (certificate_of_octets, certificate_to_octets) =
projections_of Asn.der certificate
let pkcs1_digest_info =
let open Algorithm in
let f (algo, cs) =
match to_hash algo with
| Some h -> (h, cs)
| None -> parse_error "pkcs1 digest info: unknown hash"
and g (h, cs) = (of_hash h, cs)
in
map f g @@
sequence2
(required ~label:"digestAlgorithm" Algorithm.identifier)
(required ~label:"digest" octet_string)
let (pkcs1_digest_info_of_octets, pkcs1_digest_info_to_octets) =
projections_of Asn.der pkcs1_digest_info
end
let decode_pkcs1_digest_info cs =
Asn_grammars.err_to_msg (Asn.pkcs1_digest_info_of_octets cs)
let encode_pkcs1_digest_info = Asn.pkcs1_digest_info_to_octets
let ( let* ) = Result.bind
let decode_der cs =
let* asn = Asn_grammars.err_to_msg (Asn.certificate_of_octets cs) in
Ok { asn ; raw = cs }
let encode_der { raw ; _ } = raw
let decode_pem_multiple cs =
let* data = Pem.parse cs in
let certs =
List.filter (fun (t, _) -> String.equal "CERTIFICATE" t) data
in
Pem.foldM (fun (_, cs) -> decode_der cs) certs
let fold_decode_pem_multiple fn acc cs =
List.fold_left
(fun acc data ->
let data = match data with
| Ok ("CERTIFICATE", cs) -> decode_der cs
| Ok (hdr, _) -> Error (`Msg ("ignore non certificate (" ^ hdr ^ ")"))
| Error e -> Error e
in
fn acc data)
acc
(Pem.parse_with_errors cs)
let decode_pem cs =
let* certs = decode_pem_multiple cs in
Pem.exactly_one ~what:"certificate" certs
let encode_pem v =
Pem.unparse ~tag:"CERTIFICATE" (encode_der v)
let encode_pem_multiple cs =
String.concat "" (List.map encode_pem cs)
let pp_version ppf v =
Fmt.string ppf (match v with `V1 -> "1" | `V2 -> "2" | `V3 -> "3")
let pp_hash ppf hash =
Fmt.string ppf (match hash with
| `MD5 -> "MD5" | `SHA1 -> "SHA1" | `SHA224 -> "SHA224"
| `SHA256 -> "SHA256" | `SHA384 -> "SHA384" | `SHA512 -> "SHA512")
let pp_sigalg ppf (asym, hash) =
Fmt.pf ppf "%a-%a" Key_type.pp_signature_scheme asym pp_hash hash
let pp' pp_custom_extensions ppf { asn ; _ } =
let tbs = asn.tbs_cert in
let sigalg = Algorithm.to_signature_algorithm tbs.signature in
Fmt.pf ppf "X.509 certificate@.version %a@.serial %a@.algorithm %a@.issuer %a@.valid from %a until %a@.subject %a@.extensions %a"
pp_version tbs.version Ohex.pp tbs.serial
Fmt.(option ~none:(any "NONE") pp_sigalg) sigalg
Distinguished_name.pp tbs.issuer
(Ptime.pp_human ~tz_offset_s:0 ()) (fst tbs.validity)
(Ptime.pp_human ~tz_offset_s:0 ()) (snd tbs.validity)
Distinguished_name.pp tbs.subject
(Extension.pp' pp_custom_extensions) tbs.extensions
let pp = pp' Extension.default_pp_custom_extension
let fingerprint hash cert =
let module Hash = (val (Digestif.module_of_hash' hash)) in
Hash.(to_raw_string (digest_string cert.raw))
let issuer { asn ; _ } = asn.tbs_cert.issuer
let subject { asn ; _ } = asn.tbs_cert.subject
let serial { asn ; _ } = asn.tbs_cert.serial
let validity { asn ; _ } = asn.tbs_cert.validity
let signature_algorithm { asn ; _ } =
Algorithm.to_signature_algorithm asn.signature_algo
let public_key { asn = cert ; _ } = cert.tbs_cert.pk_info
let supports_keytype c t =
match public_key c, t with
| (`RSA _), `RSA -> true
| _ -> false
let extensions { asn = cert ; _ } = cert.tbs_cert.extensions
(* RFC 6125, 6.4.4:
Therefore, if and only if the presented identifiers do not include a
DNS-ID, SRV-ID, URI-ID, or any application-specific identifier types
supported by the client, then the client MAY as a last resort check
for a string whose form matches that of a fully qualified DNS domain
name in a Common Name field of the subject field (i.e., a CN-ID). If
the client chooses to compare a reference identifier of type CN-ID
against that string, it MUST follow the comparison rules for the DNS
domain name portion of an identifier of type DNS-ID, SRV-ID, or
URI-ID, as described under Section 6.4.1, Section 6.4.2, and
Section 6.4.3. *)
let hostnames { asn = cert ; _ } =
let subj =
match Distinguished_name.common_name cert.tbs_cert.subject with
| None -> Host.Set.empty
| Some x ->
match Host.host x with
| Some (wild, d) -> Host.Set.singleton (wild, d)
| None -> Host.Set.empty
in
match Extension.hostnames cert.tbs_cert.extensions with
| Some names -> names
| None -> subj
let supports_hostname cert name =
let names = hostnames cert in
let wc_name_opt =
match Domain_name.drop_label name with
| Error _ -> None
| Ok name -> match Domain_name.host name with
| Ok hostname -> Some hostname
| Error _ -> None
in
Host.Set.mem (`Strict, name) names
|| (match wc_name_opt with
| None -> false
| Some wc_name -> Host.Set.mem (`Wildcard, wc_name) names)
let ips { asn = cert ; _ } =
match Extension.ips cert.tbs_cert.extensions with
| None -> Ipaddr.Set.empty
| Some ips -> ips
let supports_ip cert ip = Ipaddr.Set.mem ip (ips cert)

251
unikernel/duniverse/ocaml-x509/lib/crl.ml Normal file
View file

@ -0,0 +1,251 @@
type revoked_cert = {
serial : string ;
date : Ptime.t ;
extensions : Extension.t
}
type tBS_CRL = {
version : [ `V1 | `V2 ] ;
signature : Algorithm.t ;
issuer : Distinguished_name.t ;
this_update : Ptime.t ;
next_update : Ptime.t option ;
revoked_certs : revoked_cert list ;
extensions : Extension.t
}
type crl = {
tbs_crl : tBS_CRL ;
signature_algo : Algorithm.t ;
signature_val : string
}
module Asn = struct
open Asn.S
open Asn_grammars
let revokedCertificate =
let f (serial, date, e) =
let extensions = match e with None -> Extension.empty | Some xs -> xs in
{ serial ; date ; extensions }
and g { serial ; date ; extensions } =
let e = if Extension.is_empty extensions then None else Some extensions in
(serial, date, e)
in
map f g @@
sequence3
(required ~label:"userCertificate" @@ serial)
(required ~label:"revocationDate" @@ Certificate.Asn.time)
(optional ~label:"crlEntryExtensions" @@ Extension.Asn.extensions_der)
let version =
map
(function 0 -> `V1 | 1 -> `V2 | _ -> parse_error "unknown version")
(function `V2 -> 1 | `V1 -> 0)
int
let tBSCertList =
let f (a, (b, (c, (d, (e, (f, g)))))) =
{ version = Option.value ~default:`V1 a ; signature = b ; issuer = c ;
this_update = d ; next_update = e ;
revoked_certs = (match f with None -> [] | Some xs -> xs) ;
extensions = (match g with None -> Extension.empty | Some xs -> xs) }
and g { version = a ; signature = b ; issuer = c ;
this_update = d ; next_update = e ; revoked_certs = f ;
extensions = g } =
let f = match f with [] -> None | xs -> Some xs
and g = if Extension.is_empty g then None else Some g
in
((if a = `V1 then None else Some a), (b, (c, (d, (e, (f, g))))))
in
map f g @@
sequence @@
(optional ~label:"version" @@ version)
@ (required ~label:"signature" @@ Algorithm.identifier)
@ (required ~label:"issuer" @@ Distinguished_name.Asn.name)
@ (required ~label:"thisUpdate" @@ Certificate.Asn.time)
@ (optional ~label:"nextUpdate" @@ Certificate.Asn.time)
@ (optional ~label:"revokedCertificates" @@ sequence_of revokedCertificate)
-@ (optional ~label:"crlExtensions" @@ explicit 0 Extension.Asn.extensions_der)
let certificateList =
let f (cl, sa, sv) =
if cl.signature <> sa then
parse_error "signatureAlgorithm != tbsCertList.signature"
else
{ tbs_crl = cl ; signature_algo = sa ; signature_val = sv }
and g { tbs_crl ; signature_algo ; signature_val } =
(tbs_crl, signature_algo, signature_val)
in
map f g @@
sequence3
(required ~label:"tbsCertList" @@ tBSCertList)
(required ~label:"signatureAlgorithm" @@ Algorithm.identifier)
(required ~label:"signatureValue" @@ bit_string_octets)
let (crl_of_octets, crl_to_octets) =
projections_of Asn.der certificateList
let (tbs_CRL_of_octets, tbs_CRL_to_octets) =
projections_of Asn.der tBSCertList
end
type t = {
raw : string ;
asn : crl ;
}
let guard p e = if p then Ok () else Error e
let ( let* ) = Result.bind
let decode_der raw =
let* asn = Asn_grammars.err_to_msg (Asn.crl_of_octets raw) in
Ok { raw ; asn }
let encode_der { raw ; _ } = raw
let issuer { asn ; _ } = asn.tbs_crl.issuer
let this_update { asn ; _ } = asn.tbs_crl.this_update
let next_update { asn ; _ } = asn.tbs_crl.next_update
let extensions { asn ; _ } = asn.tbs_crl.extensions
let revoked_certificates { asn ; _ } = asn.tbs_crl.revoked_certs
let crl_number { asn ; _ } =
match Extension.(find CRL_number asn.tbs_crl.extensions) with
| None -> None
| Some (_, x) -> Some x
let signature_algorithm { asn ; _ } =
Algorithm.to_signature_algorithm asn.signature_algo
let validate { raw ; asn } ?(allowed_hashes = Validation.sha2) pub =
let tbs_raw = Validation.raw_cert_hack raw in
Validation.validate_raw_signature asn.tbs_crl.issuer allowed_hashes
tbs_raw asn.signature_algo asn.signature_val pub
type verification_error = [
| Validation.signature_error
| `Issuer_subject_mismatch of Distinguished_name.t * Distinguished_name.t
| `Not_yet_valid of Distinguished_name.t * Ptime.t * Ptime.t
| `Next_update_scheduled of Distinguished_name.t * Ptime.t * Ptime.t
]
let pp_verification_error ppf = function
| #Validation.signature_error as e -> Validation.pp_signature_error ppf e
| `Issuer_subject_mismatch (issuer, subj) ->
Fmt.pf ppf "issuer %a does not match subject %a"
Distinguished_name.pp issuer Distinguished_name.pp subj
| `Not_yet_valid (issuer, now, created) ->
Fmt.pf ppf "CRL %a not yet valid, valid from %a, now %a"
Distinguished_name.pp issuer
(Ptime.pp_human ~tz_offset_s:0 ()) created
(Ptime.pp_human ~tz_offset_s:0 ()) now
| `Next_update_scheduled (issuer, now, scheduled) ->
Fmt.pf ppf "CRL %a next update already scheduled at %a, now %a"
Distinguished_name.pp issuer
(Ptime.pp_human ~tz_offset_s:0 ()) scheduled
(Ptime.pp_human ~tz_offset_s:0 ()) now
let verify ({ asn ; _ } as crl) ?allowed_hashes ?time cert =
let subj = Certificate.subject cert in
let* () =
guard
(Distinguished_name.equal asn.tbs_crl.issuer subj)
(`Issuer_subject_mismatch (asn.tbs_crl.issuer, subj))
in
let* () =
match time with
| None -> Ok ()
| Some x ->
let* () =
guard (Ptime.is_later ~than:asn.tbs_crl.this_update x)
(`Not_yet_valid (subj, x, asn.tbs_crl.this_update))
in
match asn.tbs_crl.next_update with
| None -> Ok ()
| Some y -> guard (Ptime.is_earlier ~than:y x)
(`Next_update_scheduled (subj, x, y))
in
validate ?allowed_hashes crl (Certificate.public_key cert)
let reason (revoked : revoked_cert) =
match Extension.(find Reason revoked.extensions) with
| Some (_, x) -> Some x
| None -> None
let is_revoked ?allowed_hashes ~issuer:super ~cert (crls : t list) =
List.exists (fun crl ->
if
Distinguished_name.equal (Certificate.subject super) (issuer crl)
then
match validate ?allowed_hashes crl (Certificate.public_key super) with
| Ok () ->
begin try
let entry = List.find
(fun r -> String.equal (Certificate.serial cert) r.serial)
(revoked_certificates crl)
in
match reason entry with
| None -> true
| Some `Remove_from_CRL -> false
| Some _ -> true
with Not_found -> false
end
| Error _ -> false
else
false)
crls
let sign_tbs (tbs : tBS_CRL) key =
let tbs_raw = Asn.tbs_CRL_to_octets tbs in
match Algorithm.to_signature_algorithm tbs.signature with
| None -> Error (`Msg "couldn't parse signature algorithm")
| Some (_, hash) ->
let scheme = Key_type.x509_default_scheme (Private_key.key_type key) in
let* signature_val = Private_key.sign hash ~scheme key (`Message tbs_raw) in
let asn = { tbs_crl = tbs ; signature_algo = tbs.signature ; signature_val } in
let raw = Asn.crl_to_octets asn in
Ok { asn ; raw }
let revoke
?digest
~issuer
~this_update ?next_update
?(extensions = Extension.empty)
revoked_certs
key =
let digest = Signing_request.default_digest digest key in
let signature =
let scheme = Key_type.x509_default_scheme (Private_key.key_type key) in
Algorithm.of_signature_algorithm scheme digest
in
let tbs_crl = {
version = `V2 ;
signature ;
issuer ;
this_update ; next_update ;
revoked_certs ;
extensions
}
in
sign_tbs tbs_crl key
let revoke_certificates (revoked : revoked_cert list) ~this_update ?next_update ({ asn ; _ } as crl) key =
let tbs = asn.tbs_crl in
let count = match crl_number crl with None -> 0 | Some x -> succ x in
let extensions = Extension.(add CRL_number (false, count) tbs.extensions) in
let tbs = {
tbs with revoked_certs = tbs.revoked_certs @ revoked ;
this_update ; next_update ;
extensions
}
in
sign_tbs tbs key
let revoke_certificate revoked ~this_update ?next_update crl key =
revoke_certificates [revoked] ~this_update ?next_update crl key

255
unikernel/duniverse/ocaml-x509/lib/distinguished_name.ml Normal file
View file

@ -0,0 +1,255 @@
type attribute =
| CN of string
| Serialnumber of string
| C of string
| L of string
| ST of string
| O of string
| OU of string
| T of string
| DNQ of string
| Mail of string
| DC of string
| Given_name of string
| Surname of string
| Initials of string
| Pseudonym of string
| Generation of string
| Street of string
| Userid of string
| Other of Asn.oid * string
(* Escaping is described in RFC4514. Escaing '=' is optional, otherwise the
* following is minimal, using the character instead of hex where possible. *)
let pp_attribute_value ?(osf = false) () ppf s =
let n = String.length s in
for i = 0 to n - 1 do
match s.[i] with
| '#' when i = 0 -> Fmt.string ppf "\\#"
| ' ' when i = 0 || i = n - 1 -> Fmt.string ppf "\\ "
| ',' when not osf -> Fmt.string ppf "\\,"
| ';' when not osf -> Fmt.string ppf "\\;"
| '/' when osf -> Fmt.string ppf "\\/"
| '"' | '+' | '<' | '=' | '>' | '\\' as c -> Fmt.pf ppf "\\%c" c
| '\x00' -> Fmt.string ppf "\\00"
| c -> Fmt.char ppf c
done
let pp_string_hex ppf s =
for i = 0 to String.length s - 1 do
Fmt.pf ppf "%02x" (Char.code s.[i])
done
let pp_attribute ?osf ?(ava_equal = Fmt.any "=") () ppf attr =
let aux a v =
Fmt.pf ppf "%s%a%a" a ava_equal () (pp_attribute_value ?osf ()) v in
match attr with
| CN s -> aux "CN" s
| Serialnumber s -> aux "Serialnumber" s
| C s -> aux "C" s
| L s -> aux "L" s
| ST s -> aux "ST" s
| O s -> aux "O" s
| OU s -> aux "OU" s
| T s -> aux "T" s
| DNQ s -> aux "DNQ" s
| Mail s -> aux "Mail" s
| DC s -> aux "DC" s
| Given_name s -> aux "Given_name" s
| Surname s -> aux "Surname" s
| Initials s -> aux "Initials" s
| Pseudonym s -> aux "Pseudonym" s
| Generation s -> aux "Generation" s
| Street s -> aux "Street" s
| Userid s -> aux "UID" s
| Other (oid, s) ->
Fmt.pf ppf "%a%a#%a" Asn.OID.pp oid ava_equal () pp_string_hex s
module K = struct
type t = attribute
let compare t t' =
match t, t' with
| CN a, CN b -> String.compare a b
| CN _, _ -> -1 | _, CN _ -> 1
| Serialnumber a, Serialnumber b -> String.compare a b
| Serialnumber _, _ -> -1 | _, Serialnumber _ -> 1
| C a, C b -> String.compare a b
| C _, _ -> -1 | _, C _ -> 1
| L a, L b -> String.compare a b
| L _, _ -> -1 | _, L _ -> 1
| ST a, ST b -> String.compare a b
| ST _, _ -> -1 | _, ST _ -> 1
| O a, O b -> String.compare a b
| O _, _ -> -1 | _, O _ -> 1
| OU a, OU b -> String.compare a b
| OU _, _ -> -1 | _, OU _ -> 1
| T a, T b -> String.compare a b
| T _, _ -> -1 | _, T _ -> 1
| DNQ a, DNQ b -> String.compare a b
| DNQ _, _ -> -1 | _, DNQ _ -> 1
| Mail a, Mail b -> String.compare a b
| Mail _, _ -> -1 | _, Mail _ -> 1
| DC a, DC b -> String.compare a b
| DC _, _ -> -1 | _, DC _ -> 1
| Given_name a, Given_name b -> String.compare a b
| Given_name _, _ -> -1 | _, Given_name _ -> 1
| Surname a, Surname b -> String.compare a b
| Surname _, _ -> -1 | _, Surname _ -> 1
| Initials a, Initials b -> String.compare a b
| Initials _, _ -> -1 | _, Initials _ -> 1
| Pseudonym a, Pseudonym b -> String.compare a b
| Pseudonym _, _ -> -1 | _, Pseudonym _ -> 1
| Generation a, Generation b -> String.compare a b
| Generation _, _ -> -1 | _, Generation _ -> 1
| Street a, Street b -> String.compare a b
| Street _, _ -> -1 | _, Street _ -> 1
| Userid a, Userid b -> String.compare a b
| Userid _, _ -> -1 | _, Userid _ -> 1
| Other (oid_a, v_a), Other (oid_b, v_b) ->
match Asn.OID.compare oid_a oid_b with
| 0 -> String.compare v_a v_b
| x when x < 0 -> -1
| _ -> 1
end
module Relative_distinguished_name = Set.Make(K)
(* TODO:
- each RDN should be a non-empty set
- nothing prevents a user from putting Other (base 2 5 <| 4 <| 3, "foo")
and Common_name "foo" into the same RDN -- which are identical (i.e. Other
should filter the other named constructors) *)
type t = Relative_distinguished_name.t list
let equal a b =
List.length a = List.length b &&
List.for_all2 Relative_distinguished_name.equal a b
let make_pp_rdn ?osf ?(spacing = `Tight) () =
let ava_sep, ava_equal =
match spacing with
| `Tight -> Fmt.(any "+" ++ cut, any "=")
| `Medium -> Fmt.(any " +" ++ sp, any "=")
| `Loose -> Fmt.(any " +" ++ sp, any " = ")
in
let pp_ava = pp_attribute ?osf ~ava_equal () in
Fmt.(using Relative_distinguished_name.elements @@ list ~sep:ava_sep pp_ava)
let make_pp ~format ?spacing () =
match format, spacing with
| `RFC4514, (None | Some `Tight) ->
Fmt.(using List.rev @@ list ~sep:(any "," ++ cut) (make_pp_rdn ()))
| `RFC4514, Some (`Medium | `Loose as spacing) ->
Fmt.(using List.rev @@ list ~sep:comma (make_pp_rdn ~spacing ()))
| `OpenSSL, (None | Some `Loose) ->
Fmt.(list ~sep:comma (make_pp_rdn ~spacing:`Loose ()))
| `OpenSSL, Some (`Tight | `Medium as spacing) ->
Fmt.(list ~sep:(any "," ++ cut) (make_pp_rdn ~spacing ()))
| `OSF, _ ->
Fmt.(any "/" ++ list ~sep:(any "/") (make_pp_rdn ~osf:true ()))
let pp = Fmt.hbox (make_pp ~format:`OSF ())
let common_name t =
let is_cn = function CN _ -> true | _ -> false
in
List.fold_left (fun acc dn ->
match Relative_distinguished_name.find_first_opt is_cn dn with
| Some CN x -> Some x | _ -> acc)
None t
module Asn = struct
open Asn.S
open Asn_grammars
(* ASN `Name' fragmet appears all over. *)
(* rfc5280 section 4.1.2.4 - name components we "must" handle. *)
(* A list of abbreviations: http://pic.dhe.ibm.com/infocenter/wmqv7/v7r1/index.jsp?topic=%2Fcom.ibm.mq.doc%2Fsy10570_.htm *)
(* Also rfc4519. *)
(* See rfc5280 section 4.1.2.4. *)
let directory_name =
choice6
utf8_string printable_string
ia5_string universal_string teletex_string bmp_string
(* We flatten the sequence-of-set-of-tuple here into a single list.
* This means that we can't write non-singleton sets back.
* Does anyone need that, ever?
*)
let name =
let open Registry in
let of_c = function
| `C1 x | `C2 x | `C3 x | `C4 x | `C5 x | `C6 x -> x in
let a_f = case_of_oid_f [
(domain_component , fun x -> DC (of_c x)) ;
(X520.common_name , fun x -> CN (of_c x)) ;
(X520.serial_number , fun x -> Serialnumber (of_c x)) ;
(X520.country_name , fun x -> C (of_c x)) ;
(X520.locality_name , fun x -> L (of_c x)) ;
(X520.state_or_province_name , fun x -> ST (of_c x)) ;
(X520.organization_name , fun x -> O (of_c x)) ;
(X520.organizational_unit_name , fun x -> OU (of_c x)) ;
(X520.title , fun x -> T (of_c x)) ;
(X520.dn_qualifier , fun x -> DNQ (of_c x)) ;
(PKCS9.email , fun x -> Mail (of_c x)) ;
(X520.given_name , fun x -> Given_name (of_c x)) ;
(X520.surname , fun x -> Surname (of_c x)) ;
(X520.initials , fun x -> Initials (of_c x)) ;
(X520.pseudonym , fun x -> Pseudonym (of_c x)) ;
(X520.generation_qualifier , fun x -> Generation (of_c x)) ;
(X520.street_address , fun x -> Street (of_c x)) ;
(userid , fun x -> Userid (of_c x))]
~default:(fun oid x -> Other (oid, of_c x))
and a_g = function
| DC x -> (domain_component, `C3 x )
| CN x -> (X520.common_name, `C1 x )
| Serialnumber x -> (X520.serial_number, `C2 x )
| C x -> (X520.country_name, `C2 x )
| L x -> (X520.locality_name, `C1 x )
| ST x -> (X520.state_or_province_name, `C1 x )
| O x -> (X520.organization_name, `C1 x )
| OU x -> (X520.organizational_unit_name, `C1 x )
| T x -> (X520.title, `C1 x )
| DNQ x -> (X520.dn_qualifier, `C2 x )
| Mail x -> (PKCS9.email, `C3 x )
| Given_name x -> (X520.given_name, `C1 x )
| Surname x -> (X520.surname, `C1 x )
| Initials x -> (X520.initials, `C1 x )
| Pseudonym x -> (X520.pseudonym, `C1 x )
| Generation x -> (X520.generation_qualifier, `C1 x )
| Street x -> (X520.street_address, `C1 x )
| Userid x -> (userid, `C1 x )
| Other (oid, x) -> (oid, `C1 x )
in
let attribute_tv =
map a_f a_g @@
sequence2
(required ~label:"attr type" oid)
(* This is ANY according to rfc5280. *)
(required ~label:"attr value" directory_name)
in
let rd_name =
let f exts =
List.fold_left
(fun set attr -> Relative_distinguished_name.add attr set)
Relative_distinguished_name.empty exts
and g map = Relative_distinguished_name.elements map
in
map f g @@ set_of attribute_tv
in
sequence_of rd_name (* A vacuous choice, in the standard. *)
let (name_of_octets, name_to_octets) =
projections_of Asn.der name
end
let decode_der cs = Asn_grammars.err_to_msg (Asn.name_of_octets cs)
let encode_der = Asn.name_to_octets

10
unikernel/duniverse/ocaml-x509/lib/dune Normal file
View file

@ -0,0 +1,10 @@
(library
(name x509)
(public_name x509)
(private_modules asn_grammars registry authenticator certificate validation
public_key private_key crl distinguished_name algorithm
extension pem signing_request general_name host rc2 p12
key_type)
(libraries asn1-combinators fmt ptime mirage-crypto mirage-crypto-pk
gmap domain-name base64 logs mirage-crypto-ec kdf.pbkdf
mirage-crypto-rng ipaddr ohex))

695
unikernel/duniverse/ocaml-x509/lib/extension.ml Normal file
View file

@ -0,0 +1,695 @@
type key_usage = [
| `Digital_signature
| `Content_commitment
| `Key_encipherment
| `Data_encipherment
| `Key_agreement
| `Key_cert_sign
| `CRL_sign
| `Encipher_only
| `Decipher_only
]
let pp_key_usage ppf ku =
Fmt.string ppf
(match ku with
| `Digital_signature -> "digital signature"
| `Content_commitment -> "content commitment"
| `Key_encipherment -> "key encipherment"
| `Data_encipherment -> "data encipherment"
| `Key_agreement -> "key agreement"
| `Key_cert_sign -> "key cert sign"
| `CRL_sign -> "CRL sign"
| `Encipher_only -> "encipher only"
| `Decipher_only -> "decipher only")
type extended_key_usage = [
| `Any
| `Server_auth
| `Client_auth
| `Code_signing
| `Email_protection
| `Ipsec_end
| `Ipsec_tunnel
| `Ipsec_user
| `Time_stamping
| `Ocsp_signing
| `Other of Asn.oid
]
let pp_extended_key_usage ppf = function
| `Any -> Fmt.string ppf "any"
| `Server_auth -> Fmt.string ppf "server authentication"
| `Client_auth -> Fmt.string ppf "client authentication"
| `Code_signing -> Fmt.string ppf "code signing"
| `Email_protection -> Fmt.string ppf "email protection"
| `Ipsec_end -> Fmt.string ppf "ipsec end"
| `Ipsec_tunnel -> Fmt.string ppf "ipsec tunnel"
| `Ipsec_user -> Fmt.string ppf "ipsec user"
| `Time_stamping -> Fmt.string ppf "time stamping"
| `Ocsp_signing -> Fmt.string ppf "ocsp signing"
| `Other oid -> Asn.OID.pp ppf oid
type authority_key_id = string option * General_name.t * string option
let pp_authority_key_id ppf (id, issuer, serial) =
Fmt.pf ppf "identifier %a@ issuer %a@ serial %a@ "
Fmt.(option ~none:(any "none") Ohex.pp) id
General_name.pp issuer
Fmt.(option ~none:(any "none") Ohex.pp) serial
type priv_key_usage_period = [
| `Interval of Ptime.t * Ptime.t
| `Not_after of Ptime.t
| `Not_before of Ptime.t
]
let pp_priv_key_usage_period ppf =
let pp_ptime = Ptime.pp_human ~tz_offset_s:0 () in
function
| `Interval (start, stop) ->
Fmt.pf ppf "from %a till %a" pp_ptime start pp_ptime stop
| `Not_after after -> Fmt.pf ppf "not after %a" pp_ptime after
| `Not_before before -> Fmt.pf ppf "not before %a" pp_ptime before
type name_constraint = (General_name.b * int * int option) list
let pp_name_constraints ppf (permitted, excluded) =
let pp_one ppf (General_name.B (k, base), min, max) =
Fmt.pf ppf "base %a min %u max %a"
(General_name.pp_k k) base min Fmt.(option ~none:(any "none") int) max
in
Fmt.pf ppf "permitted %a@ excluded %a"
Fmt.(list ~sep:(any ", ") pp_one) permitted
Fmt.(list ~sep:(any ", ") pp_one) excluded
type policy = [ `Any | `Something of Asn.oid ]
let pp_policy ppf = function
| `Any -> Fmt.string ppf "any"
| `Something oid -> Fmt.pf ppf "some oid %a" Asn.OID.pp oid
type reason = [
| `Unspecified
| `Key_compromise
| `CA_compromise
| `Affiliation_changed
| `Superseded
| `Cessation_of_operation
| `Certificate_hold
| `Remove_from_CRL
| `Privilege_withdrawn
| `AA_compromise
]
let reason_to_int = function
| `Unspecified -> 0
| `Key_compromise -> 1
| `CA_compromise -> 2
| `Affiliation_changed -> 3
| `Superseded -> 4
| `Cessation_of_operation -> 5
| `Certificate_hold -> 6
(* 7 is not used *)
| `Remove_from_CRL -> 8
| `Privilege_withdrawn -> 9
| `AA_compromise -> 10
let reason_of_int = function
| 0 -> `Unspecified
| 1 -> `Key_compromise
| 2 -> `CA_compromise
| 3 -> `Affiliation_changed
| 4 -> `Superseded
| 5 -> `Cessation_of_operation
| 6 -> `Certificate_hold
(* 7 is not used *)
| 8 -> `Remove_from_CRL
| 9 -> `Privilege_withdrawn
| 10 -> `AA_compromise
| x -> Asn.S.parse_error "Unknown reason %d" x
let pp_reason ppf r =
Fmt.string ppf (match r with
| `Unspecified -> "unspecified"
| `Key_compromise -> "key compromise"
| `CA_compromise -> "CA compromise"
| `Affiliation_changed -> "affiliation changed"
| `Superseded -> "superseded"
| `Cessation_of_operation -> "cessation of operation"
| `Certificate_hold -> "certificate hold"
| `Remove_from_CRL -> "remove from CRL"
| `Privilege_withdrawn -> "privilege withdrawn"
| `AA_compromise -> "AA compromise")
type distribution_point_name =
[ `Full of General_name.t
| `Relative of Distinguished_name.t ]
let pp_distribution_point_name ppf = function
| `Full name -> Fmt.pf ppf "full %a" General_name.pp name
| `Relative name -> Fmt.pf ppf "relative %a" Distinguished_name.pp name
type distribution_point =
distribution_point_name option *
reason list option *
General_name.t option
let pp_distribution_point ppf (name, reasons, issuer) =
Fmt.pf ppf "name %a reason %a issuer %a"
Fmt.(option ~none:(any "none") pp_distribution_point_name) name
Fmt.(option ~none:(any "none") (list ~sep:(any ", ") pp_reason)) reasons
Fmt.(option ~none:(any "none") General_name.pp) issuer
let pp_issuing_distribution_point ppf (name, onlyuser, onlyca, onlysome, indirectcrl, onlyattributes) =
Fmt.pf ppf "name %a only user certs %B only CA certs %B only reasons %a indirectcrl %B only attribute certs %B"
Fmt.(option ~none:(any "none") pp_distribution_point_name) name
onlyuser onlyca
Fmt.(option ~none:(any "no") (list ~sep:(any ", ") pp_reason)) onlysome
indirectcrl onlyattributes
type 'a extension = bool * 'a
type _ k =
| Unsupported : Asn.oid -> string extension k
| Subject_alt_name : General_name.t extension k
| Authority_key_id : authority_key_id extension k
| Subject_key_id : string extension k
| Issuer_alt_name : General_name.t extension k
| Key_usage : key_usage list extension k
| Ext_key_usage : extended_key_usage list extension k
| Basic_constraints : (bool * int option) extension k
| CRL_number : int extension k
| Delta_CRL_indicator : int extension k
| Priv_key_period : priv_key_usage_period extension k
| Name_constraints : (name_constraint * name_constraint) extension k
| CRL_distribution_points : distribution_point list extension k
| Issuing_distribution_point : (distribution_point_name option * bool * bool * reason list option * bool * bool) extension k
| Freshest_CRL : distribution_point list extension k
| Reason : reason extension k
| Invalidity_date : Ptime.t extension k
| Certificate_issuer : General_name.t extension k
| Policies : policy list extension k
let pp_one' : type a. (Format.formatter -> Asn.oid * string -> unit) -> a k -> Format.formatter -> a -> unit = fun custom k ppf v ->
let c_to_str b = if b then "critical " else "" in
match k, v with
| Subject_alt_name, (crit, alt) ->
Fmt.pf ppf "%ssubjectAlternativeName %a" (c_to_str crit)
General_name.pp alt
| Authority_key_id, (crit, kid) ->
Fmt.pf ppf "%sauthorityKeyIdentifier %a" (c_to_str crit)
pp_authority_key_id kid
| Subject_key_id, (crit, kid) ->
Fmt.pf ppf "%ssubjectKeyIdentifier %a" (c_to_str crit)
Ohex.pp kid
| Issuer_alt_name, (crit, alt) ->
Fmt.pf ppf "%sissuerAlternativeNames %a" (c_to_str crit)
General_name.pp alt
| Key_usage, (crit, ku) ->
Fmt.pf ppf "%skeyUsage %a" (c_to_str crit)
Fmt.(list ~sep:(any ", ") pp_key_usage) ku
| Ext_key_usage, (crit, eku) ->
Fmt.pf ppf "%sextendedKeyUsage %a" (c_to_str crit)
Fmt.(list ~sep:(any ", ") pp_extended_key_usage) eku
| Basic_constraints, (crit, (ca, depth)) ->
Fmt.pf ppf "%sbasicConstraints CA %B depth %a" (c_to_str crit) ca
Fmt.(option ~none:(any "none") int) depth
| CRL_number, (crit, i) ->
Fmt.pf ppf "%scRLNumber %u" (c_to_str crit) i
| Delta_CRL_indicator, (crit, indicator) ->
Fmt.pf ppf "%sdeltaCRLIndicator %u" (c_to_str crit) indicator
| Priv_key_period, (crit, period) ->
Fmt.pf ppf "%sprivateKeyUsagePeriod %a" (c_to_str crit)
pp_priv_key_usage_period period
| Name_constraints, (crit, ncs) ->
Fmt.pf ppf "%snameConstraints %a" (c_to_str crit) pp_name_constraints ncs
| CRL_distribution_points, (crit, points) ->
Fmt.pf ppf "%scRLDistributionPoints %a" (c_to_str crit)
Fmt.(list ~sep:(any "; ") pp_distribution_point) points
| Issuing_distribution_point, (crit, point) ->
Fmt.pf ppf "%sissuingDistributionPoint %a" (c_to_str crit)
pp_issuing_distribution_point point
| Freshest_CRL, (crit, points) ->
Fmt.pf ppf "%sfreshestCRL %a" (c_to_str crit)
Fmt.(list ~sep:(any "; ") pp_distribution_point) points
| Reason, (crit, reason) ->
Fmt.pf ppf "%sreason %a" (c_to_str crit) pp_reason reason
| Invalidity_date, (crit, date) ->
Fmt.pf ppf "%sinvalidityDate %a" (c_to_str crit)
(Ptime.pp_human ~tz_offset_s:0 ()) date
| Certificate_issuer, (crit, name) ->
Fmt.pf ppf "%scertificateIssuer %a" (c_to_str crit) General_name.pp name
| Policies, (crit, pols) ->
Fmt.pf ppf "%spolicies %a" (c_to_str crit)
Fmt.(list ~sep:(any "; ") pp_policy) pols
| Unsupported oid, (crit, str) ->
Fmt.pf ppf "%s%a" (c_to_str crit) custom (oid, str)
let default_pp_custom_extension ppf (oid, str) =
Fmt.pf ppf "unsupported %a: %a" Asn.OID.pp oid Ohex.pp str
let pp_one k fmt =
pp_one' default_pp_custom_extension k fmt
module ID = Registry.Cert_extn
let to_oid : type a. a k -> Asn.oid = function
| Unsupported oid -> oid
| Subject_alt_name -> ID.subject_alternative_name
| Authority_key_id -> ID.authority_key_identifier
| Subject_key_id -> ID.subject_key_identifier
| Issuer_alt_name -> ID.issuer_alternative_name
| Key_usage -> ID.key_usage
| Ext_key_usage -> ID.extended_key_usage
| Basic_constraints -> ID.basic_constraints
| CRL_number -> ID.crl_number
| Delta_CRL_indicator -> ID.delta_crl_indicator
| Priv_key_period -> ID.private_key_usage_period
| Name_constraints -> ID.name_constraints
| CRL_distribution_points -> ID.crl_distribution_points
| Issuing_distribution_point -> ID.issuing_distribution_point
| Freshest_CRL -> ID.freshest_crl
| Reason -> ID.reason_code
| Invalidity_date -> ID.invalidity_date
| Certificate_issuer -> ID.certificate_issuer
| Policies -> ID.certificate_policies_2
let critical : type a. a k -> a -> bool = fun k v ->
match k, v with
| Unsupported _, (b, _) -> b
| Subject_alt_name, (b, _) -> b
| Authority_key_id, (b, _) -> b
| Subject_key_id, (b, _) -> b
| Issuer_alt_name, (b, _) -> b
| Key_usage, (b, _) -> b
| Ext_key_usage, (b, _) -> b
| Basic_constraints, (b, _) -> b
| CRL_number, (b, _) -> b
| Delta_CRL_indicator, (b, _) -> b
| Priv_key_period, (b, _) -> b
| Name_constraints, (b, _) -> b
| CRL_distribution_points, (b, _) -> b
| Issuing_distribution_point, (b, _) -> b
| Freshest_CRL, (b, _) -> b
| Reason, (b, _) -> b
| Invalidity_date, (b, _) -> b
| Certificate_issuer, (b, _) -> b
| Policies, (b, _) -> b
module K = struct
type 'a t = 'a k
let compare : type a b. a t -> b t -> (a, b) Gmap.Order.t = fun t t' ->
let open Gmap.Order in
match t, t' with
| Subject_alt_name, Subject_alt_name -> Eq
| Authority_key_id, Authority_key_id -> Eq
| Subject_key_id, Subject_key_id -> Eq
| Issuer_alt_name, Issuer_alt_name -> Eq
| Key_usage, Key_usage -> Eq
| Ext_key_usage, Ext_key_usage -> Eq
| Basic_constraints, Basic_constraints -> Eq
| CRL_number, CRL_number -> Eq
| Delta_CRL_indicator, Delta_CRL_indicator -> Eq
| Priv_key_period, Priv_key_period -> Eq
| Name_constraints, Name_constraints -> Eq
| CRL_distribution_points, CRL_distribution_points -> Eq
| Issuing_distribution_point, Issuing_distribution_point -> Eq
| Freshest_CRL, Freshest_CRL -> Eq
| Reason, Reason -> Eq
| Invalidity_date, Invalidity_date -> Eq
| Certificate_issuer, Certificate_issuer -> Eq
| Policies, Policies -> Eq
| Unsupported oid, Unsupported oid' when Asn.OID.equal oid oid' -> Eq
| a, b ->
let r = Asn.OID.compare (to_oid a) (to_oid b) in
if r = 0 then assert false else if r < 0 then Lt else Gt
end
include Gmap.Make(K)
let pp' custom ppf m =
iter (fun (B (k, v)) -> pp_one' custom k ppf v ; Fmt.sp ppf ()) m
let pp = pp' default_pp_custom_extension
let hostnames exts =
match find Subject_alt_name exts with
| None -> None
| Some (_, names) ->
match General_name.find DNS names with
| None -> None
| Some xs ->
let names =
List.fold_left (fun acc s ->
match Host.host s with
| Some (typ, hostname) -> Host.Set.add (typ, hostname) acc
| None -> acc)
Host.Set.empty xs
in
if Host.Set.is_empty names then None else Some names
let ips exts =
match find Subject_alt_name exts with
| None -> None
| Some (_, names) ->
match General_name.find IP names with
| None -> None
| Some xs ->
let ips =
List.fold_left (fun acc ip ->
match
match String.length ip with
| 4 -> Result.map (fun ip -> Ipaddr.V4 ip) (Ipaddr.V4.of_octets ip)
| 16 -> Result.map (fun ip -> Ipaddr.V6 ip) (Ipaddr.V6.of_octets ip)
| _ -> Error (`Msg "unknown IP address kind")
with
| Ok ip -> Ipaddr.Set.add ip acc
| Error _ -> acc)
Ipaddr.Set.empty xs
in
if Ipaddr.Set.is_empty ips then None else Some ips
module Asn = struct
open Asn.S
open Asn_grammars
let display_text =
map (function `C1 s -> s | `C2 s -> s | `C3 s -> s | `C4 s -> s)
(fun s -> `C4 s)
@@
choice4 ia5_string visible_string bmp_string utf8_string
module ID = Registry.Cert_extn
let key_usage : key_usage list Asn.t = bit_string_flags [
0, `Digital_signature
; 1, `Content_commitment
; 2, `Key_encipherment
; 3, `Data_encipherment
; 4, `Key_agreement
; 5, `Key_cert_sign
; 6, `CRL_sign
; 7, `Encipher_only
; 8, `Decipher_only
]
let ext_key_usage =
let open ID.Extended_usage in
let f = case_of_oid [
(any , `Any ) ;
(server_auth , `Server_auth ) ;
(client_auth , `Client_auth ) ;
(code_signing , `Code_signing ) ;
(email_protection , `Email_protection) ;
(ipsec_end_system , `Ipsec_end ) ;
(ipsec_tunnel , `Ipsec_tunnel ) ;
(ipsec_user , `Ipsec_user ) ;
(time_stamping , `Time_stamping ) ;
(ocsp_signing , `Ocsp_signing ) ]
~default:(fun oid -> `Other oid)
and g = function
| `Any -> any
| `Server_auth -> server_auth
| `Client_auth -> client_auth
| `Code_signing -> code_signing
| `Email_protection -> email_protection
| `Ipsec_end -> ipsec_end_system
| `Ipsec_tunnel -> ipsec_tunnel
| `Ipsec_user -> ipsec_user
| `Time_stamping -> time_stamping
| `Ocsp_signing -> ocsp_signing
| `Other oid -> oid
in
map (List.map f) (List.map g) @@ sequence_of oid
let basic_constraints =
map (fun (a, b) -> (Option.value ~default:false a, b))
(fun (a, b) -> ((if a = false then None else Some a), b))
@@
sequence2
(optional ~label:"cA" bool)
(optional ~label:"pathLen" int)
let authority_key_id =
map (fun (a, b, c) ->
(a, Option.value ~default:General_name.empty b, c))
(fun (a, b, c) ->
(a, (if General_name.is_empty b then None else Some b), c))
@@
sequence3
(optional ~label:"keyIdentifier" @@ implicit 0 octet_string)
(optional ~label:"authCertIssuer" @@ implicit 1 General_name.Asn.gen_names)
(optional ~label:"authCertSN" @@ implicit 2 serial)
let priv_key_usage_period =
let f = function
| (Some t1, Some t2) -> `Interval (t1, t2)
| (Some t1, None ) -> `Not_before t1
| (None , Some t2) -> `Not_after t2
| _ -> parse_error "empty PrivateKeyUsagePeriod"
and g = function
| `Interval (t1, t2) -> (Some t1, Some t2)
| `Not_before t1 -> (Some t1, None )
| `Not_after t2 -> (None , Some t2) in
map f g @@
sequence2
(optional ~label:"notBefore" @@ implicit 0 generalized_time_no_frac_s)
(optional ~label:"notAfter" @@ implicit 1 generalized_time_no_frac_s)
let name_constraints =
let subtree =
map
(fun (base, min, max) -> (base, Option.value ~default:0 min, max))
(fun (base, min, max) -> (base, (if min = 0 then None else Some min), max))
@@
sequence3
(required ~label:"base" General_name.Asn.general_name)
(optional ~label:"minimum" @@ implicit 0 int)
(optional ~label:"maximum" @@ implicit 1 int)
in
map
(fun (a, b) -> (Option.value ~default:[] a, Option.value ~default:[] b))
(fun (a, b) -> ((if a = [] then None else Some a),
(if b = [] then None else Some b)))
@@
sequence2
(optional ~label:"permittedSubtrees" @@ implicit 0 (sequence_of subtree))
(optional ~label:"excludedSubtrees" @@ implicit 1 (sequence_of subtree))
let cert_policies =
let open ID.Cert_policy in
let qualifier_info =
map (function | (oid, `C1 s) when oid = cps -> s
| (oid, `C2 s) when oid = unotice -> s
| _ -> parse_error "bad policy qualifier")
(function s -> (cps, `C1 s))
@@
sequence2
(required ~label:"qualifierId" oid)
(required ~label:"qualifier"
(choice2
ia5_string
@@
map (function (_, Some s) -> s | _ -> "#(BLAH BLAH)")
(fun s -> (None, Some s))
(sequence2
(optional ~label:"noticeRef"
(sequence2
(required ~label:"organization" display_text)
(required ~label:"numbers" (sequence_of integer))))
(optional ~label:"explicitText" display_text))))
in
(* "Optional qualifiers, which MAY be present, are not expected to change
* the definition of the policy."
* Hence, we just drop them. *)
sequence_of @@
map (function | (oid, _) when oid = any_policy -> `Any
| (oid, _) -> `Something oid)
(function | `Any -> (any_policy, None)
| `Something oid -> (oid, None))
@@
sequence2
(required ~label:"policyIdentifier" oid)
(optional ~label:"policyQualifiers" (sequence_of qualifier_info))
let reason : reason list Asn.t = bit_string_flags [
0, `Unspecified
; 1, `Key_compromise
; 2, `CA_compromise
; 3, `Affiliation_changed
; 4, `Superseded
; 5, `Cessation_of_operation
; 6, `Certificate_hold
; 7, `Privilege_withdrawn
; 8, `AA_compromise
]
let reason_enumerated : reason Asn.t =
enumerated reason_of_int reason_to_int
let distribution_point_name =
map (function | `C1 s -> `Full s | `C2 s -> `Relative s)
(function | `Full s -> `C1 s | `Relative s -> `C2 s)
@@
choice2
(implicit 0 General_name.Asn.gen_names)
(implicit 1 Distinguished_name.Asn.name)
let distribution_point =
sequence3
(optional ~label:"distributionPoint" @@ explicit 0 distribution_point_name)
(optional ~label:"reasons" @@ implicit 1 reason)
(optional ~label:"cRLIssuer" @@ implicit 2 General_name.Asn.gen_names)
let crl_distribution_points = sequence_of distribution_point
let issuing_distribution_point =
map
(fun (a, b, c, d, e, f) ->
(a,
Option.value ~default:false b,
Option.value ~default:false c,
d,
Option.value ~default:false e,
Option.value ~default:false f))
(fun (a, b, c, d, e, f) ->
(a,
(if b = false then None else Some b),
(if c = false then None else Some c),
d,
(if e = false then None else Some e),
(if f = false then None else Some f)))
@@
sequence6
(optional ~label:"distributionPoint" @@ explicit 0 distribution_point_name)
(optional ~label:"onlyContainsUserCerts" @@ implicit 1 bool)
(optional ~label:"onlyContainsCACerts" @@ implicit 2 bool)
(optional ~label:"onlySomeReasons" @@ implicit 3 reason)
(optional ~label:"indirectCRL" @@ implicit 4 bool)
(optional ~label:"onlyContainsAttributeCerts" @@ implicit 5 bool)
let crl_reason : reason Asn.t =
let alist = [
0, `Unspecified
; 1, `Key_compromise
; 2, `CA_compromise
; 3, `Affiliation_changed
; 4, `Superseded
; 5, `Cessation_of_operation
; 6, `Certificate_hold
; 8, `Remove_from_CRL
; 9, `Privilege_withdrawn
; 10, `AA_compromise
]
in
let rev = List.map (fun (k, v) -> (v, k)) alist in
enumerated (fun i -> List.assoc i alist) (fun k -> List.assoc k rev)
let gen_names_of_str, gen_names_to_str = project_exn General_name.Asn.gen_names
and auth_key_id_of_str, auth_key_id_to_str = project_exn authority_key_id
and subj_key_id_of_str, subj_key_id_to_str = project_exn octet_string
and key_usage_of_str, key_usage_to_str = project_exn key_usage
and e_key_usage_of_str, e_key_usage_to_str = project_exn ext_key_usage
and basic_constr_of_str, basic_constr_to_str = project_exn basic_constraints
and pr_key_peri_of_str, pr_key_peri_to_str = project_exn priv_key_usage_period
and name_con_of_str, name_con_to_str = project_exn name_constraints
and crl_distrib_of_str, crl_distrib_to_str = project_exn crl_distribution_points
and cert_pol_of_str, cert_pol_to_str = project_exn cert_policies
and int_of_str, int_to_str = project_exn int
and issuing_dp_of_str, issuing_dp_to_str = project_exn issuing_distribution_point
and crl_reason_of_str, crl_reason_to_str = project_exn crl_reason
and time_of_str, time_to_str = project_exn generalized_time_no_frac_s
(* XXX 4.2.1.4. - cert policies! ( and other x509 extensions ) *)
let reparse_extension_exn crit = case_of_oid_f [
(ID.subject_alternative_name,
fun cs -> B (Subject_alt_name, (crit, gen_names_of_str cs))) ;
(ID.issuer_alternative_name,
fun cs -> B (Issuer_alt_name, (crit, gen_names_of_str cs))) ;
(ID.authority_key_identifier,
fun cs -> B (Authority_key_id, (crit, auth_key_id_of_str cs))) ;
(ID.subject_key_identifier,
fun cs -> B (Subject_key_id, (crit, subj_key_id_of_str cs))) ;
(ID.key_usage,
fun cs -> B (Key_usage, (crit, key_usage_of_str cs))) ;
(ID.basic_constraints,
fun cs -> B (Basic_constraints, (crit, basic_constr_of_str cs))) ;
(ID.crl_number,
fun cs -> B (CRL_number, (crit, int_of_str cs))) ;
(ID.delta_crl_indicator,
fun cs -> B (Delta_CRL_indicator, (crit, int_of_str cs))) ;
(ID.extended_key_usage,
fun cs -> B (Ext_key_usage, (crit, e_key_usage_of_str cs))) ;
(ID.private_key_usage_period,
fun cs -> B (Priv_key_period, (crit, pr_key_peri_of_str cs))) ;
(ID.name_constraints,
fun cs -> B (Name_constraints, (crit, name_con_of_str cs))) ;
(ID.crl_distribution_points,
fun cs -> B (CRL_distribution_points, (crit, crl_distrib_of_str cs))) ;
(ID.issuing_distribution_point,
fun cs -> B (Issuing_distribution_point, (crit, issuing_dp_of_str cs))) ;
(ID.freshest_crl,
fun cs -> B (Freshest_CRL, (crit, crl_distrib_of_str cs))) ;
(ID.reason_code,
fun cs -> B (Reason, (crit, crl_reason_of_str cs))) ;
(ID.invalidity_date,
fun cs -> B (Invalidity_date, (crit, time_of_str cs))) ;
(ID.certificate_issuer,
fun cs -> B (Certificate_issuer, (crit, gen_names_of_str cs))) ;
(ID.certificate_policies_2,
fun cs -> B (Policies, (crit, cert_pol_of_str cs)))
]
~default:(fun oid -> fun cs -> B (Unsupported oid, (crit, cs)))
let unparse_extension (B (k, v)) =
let v' = match k, v with
| Subject_alt_name, (_, x) -> gen_names_to_str x
| Issuer_alt_name, (_, x) -> gen_names_to_str x
| Authority_key_id, (_, x) -> auth_key_id_to_str x
| Subject_key_id, (_, x) -> subj_key_id_to_str x
| Key_usage, (_, x) -> key_usage_to_str x
| Basic_constraints, (_, x) -> basic_constr_to_str x
| CRL_number, (_, x) -> int_to_str x
| Delta_CRL_indicator, (_, x) -> int_to_str x
| Ext_key_usage, (_, x) -> e_key_usage_to_str x
| Priv_key_period, (_, x) -> pr_key_peri_to_str x
| Name_constraints, (_, x) -> name_con_to_str x
| CRL_distribution_points, (_, x) -> crl_distrib_to_str x
| Issuing_distribution_point, (_, x) -> issuing_dp_to_str x
| Freshest_CRL, (_, x) -> crl_distrib_to_str x
| Reason, (_, x) -> crl_reason_to_str x
| Invalidity_date, (_, x) -> time_to_str x
| Certificate_issuer, (_, x) -> gen_names_to_str x
| Policies, (_, x) -> cert_pol_to_str x
| Unsupported _, (_, x) -> x
in
to_oid k, critical k v, v'
let extensions_der =
let extension =
let f (oid, crit, cs) =
reparse_extension_exn (Option.value ~default:false crit) (oid, cs)
and g b =
let oid, crit, cs = unparse_extension b in
(oid, (if crit = false then None else Some crit), cs)
in
map f g @@
sequence3
(required ~label:"id" oid)
(optional ~label:"critical" bool) (* default false *)
(required ~label:"value" octet_string)
in
let f exts =
List.fold_left (fun map (B (k, v)) ->
match add_unless_bound k v map with
| None -> parse_error "%a already bound" (pp_one k) v
| Some b -> b)
empty exts
and g map = bindings map
in
map f g @@ sequence_of extension
end

170
unikernel/duniverse/ocaml-x509/lib/general_name.ml Normal file
View file

@ -0,0 +1,170 @@
type _ k =
| Other : Asn.oid -> string list k
| Rfc_822 : string list k
| DNS : string list k
| X400_address : unit k
| Directory : Distinguished_name.t list k
| EDI_party : (string option * string) list k
| URI : string list k
| IP : string list k
| Registered_id : Asn.oid list k
module K = struct
type 'a t = 'a k
let compare : type a b. a t -> b t -> (a, b) Gmap.Order.t = fun t t' ->
let open Gmap.Order in
match t, t' with
| Rfc_822, Rfc_822 -> Eq | Rfc_822, _ -> Lt | _, Rfc_822 -> Gt
| DNS, DNS -> Eq | DNS, _ -> Lt | _, DNS -> Gt
| X400_address, X400_address -> Eq | X400_address, _ -> Lt | _, X400_address -> Gt
| Directory, Directory -> Eq | Directory, _ -> Lt | _, Directory -> Gt
| EDI_party, EDI_party -> Eq | EDI_party, _ -> Lt | _, EDI_party -> Gt
| URI, URI -> Eq | URI, _ -> Lt | _, URI -> Gt
| IP, IP -> Eq | IP, _ -> Lt | _, IP -> Gt
| Registered_id, Registered_id -> Eq | Registered_id, _ -> Lt | _, Registered_id -> Gt
| Other a, Other b -> match Asn.OID.compare a b with
| 0 -> Eq
| x when x < 0 -> Lt
| _ -> Gt
end
include Gmap.Make(K)
let pp_k : type a. a k -> Format.formatter -> a -> unit = fun k ppf v ->
let pp_strs = Fmt.(list ~sep:(any "; ") string) in
match k, v with
| Rfc_822, x -> Fmt.pf ppf "rfc822 %a" pp_strs x
| DNS, x ->
Fmt.pf ppf "dns %a" Fmt.(list ~sep:(any "; ") string) x
| X400_address, () -> Fmt.string ppf "x400 address"
| Directory, x ->
Fmt.pf ppf "directory %a"
Fmt.(list ~sep:(any "; ") Distinguished_name.pp) x
| EDI_party, xs ->
Fmt.pf ppf "edi party %a"
Fmt.(list ~sep:(any "; ")
(pair ~sep:(any ", ")
(option ~none:(any "") string) string)) xs
| URI, x -> Fmt.pf ppf "uri %a" pp_strs x
| IP, x -> Fmt.pf ppf "ip %a" Fmt.(list ~sep:(any ";") (fmt "%S")) x
| Registered_id, x ->
Fmt.pf ppf "registered id %a"
Fmt.(list ~sep:(any ";") Asn.OID.pp) x
| Other oid, x -> Fmt.pf ppf "other %a: %a" Asn.OID.pp oid pp_strs x
let pp ppf m = iter (fun (B (k, v)) -> pp_k k ppf v ; Fmt.sp ppf ()) m
let merge_values : type a. a k -> a -> a -> a = fun k v v' ->
match k, v, v' with
| Other _, a, b -> a @ b
| Registered_id, a, b -> a @ b
| IP, a, b -> a @ b
| URI, a, b -> a @ b
| EDI_party, a, b -> a @ b
| Directory, a, b -> a @ b
| X400_address, (), () -> ()
| DNS, a, b -> a @ b
| Rfc_822, a, b -> a @ b
module Asn = struct
open Asn.S
(* GeneralName is also pretty pervasive. *)
(* OID x ANY. Hunt down the alternatives.... *)
(* XXX
* Cross-check. NSS seems to accept *all* oids here and just assumes UTF8.
* *)
let another_name =
let open Registry in
let f = function
| (oid, `C1 n) -> (oid, n)
| (oid, `C2 n) -> (oid, n)
| (oid, `C3 _) -> (oid, "")
and g = function
| (oid, "") -> (oid, `C3 ())
| (oid, n ) when Name_extn.is_utf8_id oid -> (oid, `C1 n)
| (oid, n ) -> (oid, `C2 n) in
map f g @@
sequence2
(required ~label:"type-id" oid)
(required ~label:"value" @@
explicit 0
(choice3 utf8_string ia5_string null))
and or_address = null (* Horrible crap, need to fill it. *)
let dir_name =
let f = function | `C1 s -> s | `C2 s -> s | `C3 s -> s
| `C4 s -> s | `C5 s -> s | `C6 s -> s
and g s = `C1 s
in
Asn.S.map f g Distinguished_name.Asn.directory_name
let edi_party_name =
sequence2
(optional ~label:"nameAssigner" @@ implicit 0 dir_name)
(required ~label:"partyName" @@ implicit 1 dir_name)
let general_name =
let f = function
| `C1 (`C1 (oid, x)) -> B (Other oid, [ x ])
| `C1 (`C2 x) -> B (Rfc_822, [ x ])
| `C1 (`C3 x) -> B (DNS, [ x ])
| `C1 (`C4 _x) -> B (X400_address, ())
| `C1 (`C5 x) -> B (Directory, [ x ])
| `C1 (`C6 x) -> B (EDI_party, [ x ])
| `C2 (`C1 x) -> B (URI, [ x ])
| `C2 (`C2 x) -> B (IP, [ x ])
| `C2 (`C3 x) -> B (Registered_id, [ x ])
and g (B (k, v)) = match k, v with
| Other oid, [ x ] -> `C1 (`C1 (oid, x))
| Rfc_822, [ x ] -> `C1 (`C2 x)
| DNS, [ x ] -> `C1 (`C3 x)
| X400_address, () -> `C1 (`C4 ())
| Directory, [ x ] -> `C1 (`C5 x)
| EDI_party, [ x ] -> `C1 (`C6 x)
| URI, [ x ] -> `C2 (`C1 x)
| IP, [ x ] -> `C2 (`C2 x)
| Registered_id, [ x ] -> `C2 (`C3 x)
| _ -> Asn.S.error (`Parse "bad general name")
in
map f g @@
choice2
(choice6
(implicit 0 another_name)
(implicit 1 ia5_string)
(implicit 2 ia5_string)
(implicit 3 or_address)
(* Everybody uses this as explicit, contrary to x509 (?) *)
(explicit 4 Distinguished_name.Asn.name)
(implicit 5 edi_party_name))
(choice3
(implicit 6 ia5_string)
(implicit 7 octet_string)
(implicit 8 oid))
let gen_names =
let f exts =
List.fold_left (fun map (B (k, v)) ->
match find k map with
| None -> add k v map
| Some b -> add k (merge_values k b v) map)
empty exts
and g map =
List.flatten (List.map (fun (B (k, v)) ->
match k, v with
| Other oid, xs -> List.map (fun d -> B (Other oid, [ d ])) xs
| Registered_id, xs -> List.map (fun d -> B (Registered_id, [ d ])) xs
| IP, xs -> List.map (fun d -> B (IP, [ d ])) xs
| URI, xs -> List.map (fun d -> B (URI, [ d ])) xs
| EDI_party, xs -> List.map (fun d -> B (EDI_party, [ d ])) xs
| Directory, xs -> List.map (fun d -> B (Directory, [ d ])) xs
| X400_address, () -> [ B (X400_address, ()) ]
| DNS, xs -> List.map (fun d -> B (DNS, [ d ])) xs
| Rfc_822, xs -> List.map (fun d -> B (Rfc_822, [ d ])) xs)
(bindings map))
in
map f g @@ sequence_of general_name
end

40
unikernel/duniverse/ocaml-x509/lib/host.ml Normal file
View file

@ -0,0 +1,40 @@
type t = [ `Strict | `Wildcard ] * [ `host ] Domain_name.t
let pp_typ ppf = function
| `Strict -> Fmt.nop ppf ()
| `Wildcard -> Fmt.string ppf "*."
let pp ppf (typ, nam) =
Fmt.pf ppf "%a%a" pp_typ typ Domain_name.pp nam
module Set = struct
include Set.Make(struct
type nonrec t = t
let compare a b = match a, b with
| (`Strict, a), (`Strict, b)
| (`Wildcard, a), (`Wildcard, b) -> Domain_name.compare a b
| (`Strict, _), (`Wildcard, _) -> -1
| (`Wildcard, _), (`Strict, _) -> 1
end)
let pp ppf s =
Fmt.(list ~sep:(any ", ") pp) ppf (elements s)
end
let is_wildcard name =
match Domain_name.get_label name 0 with
| Ok "*" -> Some (Domain_name.drop_label_exn name)
| _ -> None
let host name =
match Domain_name.of_string name with
| Error _ -> None
| Ok dn ->
let wild, name = match is_wildcard dn with
| None -> `Strict, dn
| Some dn' -> `Wildcard, dn'
in
match Domain_name.host name with
| Error _ -> None
| Ok hostname -> Some (wild, hostname)

47
unikernel/duniverse/ocaml-x509/lib/key_type.ml Normal file
View file

@ -0,0 +1,47 @@
type t = [ `RSA | `ED25519 | `P256 | `P384 | `P521 ]
let strings =
[ ("rsa", `RSA) ; ("ed25519", `ED25519) ;
("p256", `P256) ; ("p384", `P384) ; ("p521", `P521) ]
let to_string kt = fst (List.find (fun (_, k) -> kt = k) strings)
let of_string s =
match List.assoc_opt (String.lowercase_ascii s) strings with
| Some kt -> Ok kt
| None ->
Error (`Msg (Fmt.str "unkown key type %s, supported are %a"
s Fmt.(list ~sep:(any ", ") string) (List.map fst strings)))
let pp ppf t = Fmt.string ppf (to_string t)
type signature_scheme = [ `RSA_PSS | `RSA_PKCS1 | `ECDSA | `ED25519 ]
let signature_scheme_to_string = function
| `RSA_PSS -> "RSA-PSS"
| `RSA_PKCS1 -> "RSA-PKCS1"
| `ECDSA -> "ECDSA"
| `ED25519 -> "ED25519"
let pp_signature_scheme ppf s = Fmt.string ppf (signature_scheme_to_string s)
let supports_signature_scheme key_typ scheme =
match key_typ, scheme with
| `RSA, (`RSA_PSS | `RSA_PKCS1) -> true
| `ED25519, `ED25519 -> true
| (`P256 | `P384 | `P521), `ECDSA -> true
| _ -> false
let opt_signature_scheme ?scheme kt =
match scheme with
| Some x -> x
| None -> match kt with
| `RSA -> `RSA_PSS
| `ED25519 -> `ED25519
| `P256 | `P384 | `P521 -> `ECDSA
(* the default of RSA keys should be PSS, but most deployed certificates still
use PKCS1 (and this library uses pkcs1 by default as well) *)
let x509_default_scheme = function
| `RSA -> `RSA_PKCS1
| x -> opt_signature_scheme x

704
unikernel/duniverse/ocaml-x509/lib/ocsp.ml Normal file
View file

@ -0,0 +1,704 @@
(* https://tools.ietf.org/html/rfc6960 *)
let version_v1 = 0
(*
CertID ::= SEQUENCE {
hashAlgorithm AlgorithmIdentifier,
issuerNameHash OCTET STRING, -- Hash of issuer's DN
issuerKeyHash OCTET STRING, -- Hash of issuer's public key
serialNumber CertificateSerialNumber }
*)
type cert_id = {
hashAlgorithm: Algorithm.t;
issuerNameHash: string;
issuerKeyHash: string;
serialNumber: string;
}
let create_cert_id ?(hash=`SHA1) issuer serialNumber =
let hashAlgorithm = Algorithm.of_hash hash in
let module Hash = (val (Digestif.module_of_hash' (hash :> Digestif.hash'))) in
let issuerNameHash =
Certificate.subject issuer
|> Distinguished_name.encode_der
|> Hash.(fun x -> to_raw_string (digest_string x))
in
let issuerKeyHash =
Public_key.fingerprint ~hash (Certificate.public_key issuer)
in
{hashAlgorithm;issuerNameHash;issuerKeyHash;serialNumber}
let cert_id_serial {serialNumber;_} = serialNumber
let pp_cert_id ppf {hashAlgorithm;issuerNameHash;issuerKeyHash;serialNumber} =
Fmt.pf ppf "CertID @[<1>{@ algo=%a;@ issuerNameHash=%a;@ issuerKeyHash=%a;@ serialNumber=%a@ }@]"
Algorithm.pp hashAlgorithm
Ohex.pp issuerNameHash
Ohex.pp issuerKeyHash
Ohex.pp serialNumber
module Asn_common = struct
open Asn.S
let cert_id =
let f (hashAlgorithm, issuerNameHash, issuerKeyHash, serialNumber) =
{hashAlgorithm; issuerNameHash; issuerKeyHash; serialNumber;}
in
let g {hashAlgorithm;issuerNameHash;issuerKeyHash;serialNumber;} =
(hashAlgorithm, issuerNameHash, issuerKeyHash, serialNumber)
in
map f g @@
sequence4
(required ~label:"hashAlgorithm" Algorithm.identifier)
(required ~label:"issuerNameHash" octet_string)
(required ~label:"issuerKeyHash" octet_string)
(required ~label:"serialNumber" Asn_grammars.serial)
end
let ( let* ) = Result.bind
module Request = struct
(*
Request ::= SEQUENCE {
reqCert CertID,
singleRequestExtensions [0] EXPLICIT Extensions OPTIONAL }
*)
type request = {
reqCert: cert_id;
singleRequestExtensions: Extension.t option;
}
let create_request ?singleRequestExtensions reqCert =
{reqCert;singleRequestExtensions}
let pp_request ppf {reqCert;singleRequestExtensions;} =
Fmt.pf ppf "Request @[<1>{@ reqCert=%a;@ singleRequestExtensions=%a;@ }@]"
pp_cert_id reqCert
(Fmt.option ~none:(Fmt.any "None") Extension.pp) singleRequestExtensions
(*
TBSRequest ::= SEQUENCE {
version [0] EXPLICIT Version DEFAULT v1,
requestorName [1] EXPLICIT GeneralName OPTIONAL,
requestList SEQUENCE OF Request,
requestExtensions [2] EXPLICIT Extensions OPTIONAL }
*)
type tbs_request = {
requestorName: General_name.b option;
requestList: request list;
requestExtensions: Extension.t option;
}
let create_tbs_request ?requestorName ?requestExtensions requests =
{ requestorName ; requestList=requests ; requestExtensions }
let pp_tbs_request ppf { requestorName ; requestList ; requestExtensions } =
let pp_general_name ppf x =
let open General_name in
match x with
| B (k, v) -> General_name.pp_k k ppf v
in
Fmt.pf ppf "TBSRequest @[<1>{@ requestorName=%a;@ requestList=[@ %a@ ];@ requestExtensions=%a@ }@]"
(Fmt.option ~none:(Fmt.any "None") pp_general_name) requestorName
(Fmt.list ~sep:Fmt.semi pp_request) requestList
(Fmt.option ~none:(Fmt.any "None") Extension.pp) requestExtensions
(*
Signature ::= SEQUENCE {
signatureAlgorithm AlgorithmIdentifier,
signature BIT STRING,
certs [0] EXPLICIT SEQUENCE OF Certificate
OPTIONAL}
*)
type signature = {
signatureAlgorithm: Algorithm.t;
signature: string;
certs: Certificate.t list option;
}
let pp_signature ppf {signatureAlgorithm;signature;certs;} =
Fmt.pf ppf "Signature @[<1>{@ signatureAlgorithm=%a;@ signature=%a;@ certs=%a}@]"
Algorithm.pp signatureAlgorithm
Ohex.pp signature
(Fmt.option ~none:(Fmt.any "None") @@
Fmt.brackets @@
Fmt.list ~sep:Fmt.semi Certificate.pp) certs
(*
OCSPRequest ::= SEQUENCE {
tbsRequest TBSRequest,
optionalSignature [0] EXPLICIT Signature OPTIONAL }
*)
type req = {
tbsRequest: tbs_request;
optionalSignature: signature option;
}
type t = {
raw : string ;
asn : req ;
}
let pp ppf { asn = { tbsRequest ; optionalSignature } ; _ } =
Fmt.pf ppf "OCSPRequest @[<1>{@ tbsRequest=%a;@ optionalSignature=%a@ }@]"
pp_tbs_request tbsRequest
(Fmt.option ~none:(Fmt.any "None") pp_signature) optionalSignature
let cert_ids { asn = { tbsRequest = { requestList ; _ } ; _ } ; _ } =
let cert_ids = List.map (fun {reqCert;_} -> reqCert) requestList in
cert_ids
let requestor_name { asn = { tbsRequest = { requestorName ; _ } ; _ } ; _ } =
requestorName
module Asn_ = Asn
module Asn = struct
open Asn_grammars
open Asn.S
let request =
let f (reqCert, singleRequestExtensions) =
{reqCert; singleRequestExtensions}
in
let g {reqCert; singleRequestExtensions} =
(reqCert, singleRequestExtensions)
in
map f g @@
sequence2
(required ~label:"reqCert" Asn_common.cert_id)
(optional ~label:"singleRequestExtensions" @@ explicit 0
Extension.Asn.extensions_der)
let tbs_request =
let f (version, requestorName, requestList, requestExtensions) =
match version with
| Some v when v <> version_v1 ->
Asn.S.parse_error "unsupported version %d" v
| _ ->
{ requestorName ; requestList ; requestExtensions }
in
let g { requestorName ; requestList ; requestExtensions } =
(None, requestorName, requestList, requestExtensions)
in
map f g @@
sequence4
(optional ~label:"version" @@ explicit 0 int)
(optional ~label:"requestorName" @@
explicit 1 General_name.Asn.general_name)
(required ~label:"requestList" @@ sequence_of request)
(optional ~label:"requestExtensions" @@ Extension.Asn.extensions_der)
let tbs_request_of_str,tbs_request_to_str =
projections_of Asn.der tbs_request
let signature =
let f (signatureAlgorithm,signature,certs) =
let certs = match certs with
| None -> None
| Some certs ->
let encode cert =
let raw = Certificate.Asn.certificate_to_octets cert in
Certificate.{raw; asn=cert}
in
Some (List.map encode certs)
in
{signatureAlgorithm;signature;certs}
in
let g {signatureAlgorithm;signature;certs} =
let certs = match certs with
| None -> None
| Some certs ->
Some (List.map (fun Certificate.{asn;_} -> asn) certs)
in
(signatureAlgorithm,signature,certs)
in
map f g @@
sequence3
(required ~label:"signatureAlgorithm" Algorithm.identifier)
(required ~label:"signature" bit_string_octets)
(optional ~label:"certs" @@ explicit 0 @@
sequence_of Certificate.Asn.certificate)
let ocsp_request =
let f (tbsRequest,optionalSignature) =
{tbsRequest;optionalSignature;}
in
let g {tbsRequest;optionalSignature;} =
(tbsRequest,optionalSignature)
in
map f g @@
sequence2
(required ~label:"tbsRequest" tbs_request)
(optional ~label:"optionalSignature" signature)
let (ocsp_request_of_octets, ocsp_request_to_octets) =
projections_of Asn.der ocsp_request
end
let decode_der raw =
let* asn = Asn.ocsp_request_of_octets raw in
Ok { asn ; raw }
let encode_der { raw ; _ } = raw
let create ?certs ?digest ?requestor_name:requestorName ?key cert_ids =
let requestList = List.map create_request cert_ids in
let tbsRequest = {
requestorName;
requestList;
requestExtensions=None;
}
in
let* optionalSignature =
match key with
| None -> Ok None
| Some key ->
let digest = Signing_request.default_digest digest key in
let scheme = Key_type.x509_default_scheme (Private_key.key_type key) in
let signatureAlgorithm = Algorithm.of_signature_algorithm scheme digest in
let tbs_der = Asn.tbs_request_to_str tbsRequest in
let* signature = Private_key.sign digest ~scheme key (`Message tbs_der) in
Ok (Some { signature ; signatureAlgorithm ; certs; })
in
let asn = { tbsRequest ; optionalSignature } in
let raw = Asn.ocsp_request_to_octets asn in
Ok { raw ; asn }
let validate { asn ; raw } ?(allowed_hashes = Validation.sha2) pub =
match asn.optionalSignature with
| None -> Error `No_signature
| Some sign ->
let tbs_raw = Validation.raw_cert_hack raw in
let dn =
let cn = "OCSP" in
[ Distinguished_name.(Relative_distinguished_name.singleton (CN cn)) ]
in
Validation.validate_raw_signature dn allowed_hashes tbs_raw
sign.signatureAlgorithm sign.signature pub
end
module Response = struct
(* OCSPResponseStatus ::= ENUMERATED {
* successful (0), -- Response has valid confirmations
* malformedRequest (1), -- Illegal confirmation request
* internalError (2), -- Internal error in issuer
* tryLater (3), -- Try again later
* -- (4) is not used
* sigRequired (5), -- Must sign the request
* unauthorized (6) -- Request unauthorized
* } *)
type status = [
| `Successful
| `MalformedRequest
| `InternalError
| `TryLater
| `SigRequired
| `Unauthorized
]
let status_to_int = function
| `Successful -> 0
| `MalformedRequest -> 1
| `InternalError -> 2
| `TryLater -> 3
| `SigRequired -> 5
| `Unauthorized -> 6
let status_of_int = function
| 0 -> `Successful
| 1 -> `MalformedRequest
| 2 -> `InternalError
| 3 -> `TryLater
| 5 -> `SigRequired
| 6 -> `Unauthorized
| x -> Asn.S.parse_error "Unknown status %d" x
let pp_status ppf = function
| `Successful -> Fmt.string ppf "Successful"
| `MalformedRequest -> Fmt.string ppf "MalformedRequest"
| `InternalError -> Fmt.string ppf "InternalError"
| `TryLater -> Fmt.string ppf "TryLater"
| `SigRequired -> Fmt.string ppf "SigRequired"
| `Unauthorized -> Fmt.string ppf "Unauthorized"
(* RevokedInfo ::= SEQUENCE {
* revocationTime GeneralizedTime,
* revocationReason [0] EXPLICIT CRLReason OPTIONAL } *)
type revoked_info = Ptime.t * Extension.reason option
let pp_revoked_info ppf (revocationTime,revocationReason) =
Fmt.pf ppf "RevokedInfo @[<1>{@ revocationTime=%a;@ revocationReason=%a;@ }@]"
Ptime.pp revocationTime
(Fmt.option ~none:(Fmt.any "None") @@ Extension.pp_reason)
revocationReason
(* CertStatus ::= CHOICE {
* good [0] IMPLICIT NULL,
* revoked [1] IMPLICIT RevokedInfo,
* unknown [2] IMPLICIT UnknownInfo } *)
type cert_status = [
| `Good
| `Revoked of revoked_info
| `Unknown
]
let pp_cert_status ppf = function
| `Good -> Fmt.pf ppf "Good"
| `Revoked info -> Fmt.pf ppf "Revoked of %a" pp_revoked_info info
| `Unknown -> Fmt.pf ppf "Unknown"
(* SingleResponse ::= SEQUENCE {
* certID CertID,
* certStatus CertStatus,
* thisUpdate GeneralizedTime,
* nextUpdate [0] EXPLICIT GeneralizedTime OPTIONAL,
* singleExtensions [1] EXPLICIT Extensions OPTIONAL } *)
type single_response = {
certID: cert_id;
certStatus: cert_status;
thisUpdate: Ptime.t;
nextUpdate: Ptime.t option;
singleExtensions: Extension.t option;
}
let create_single_response ?next_update:nextUpdate
?single_extensions:singleExtensions
certID certStatus thisUpdate =
{certID;certStatus;thisUpdate;nextUpdate;singleExtensions;}
let pp_single_response ppf {certID;certStatus;thisUpdate;nextUpdate;singleExtensions;} =
Fmt.pf ppf "SingleResponse @[<1>{@ certID=%a;@ certStatus=%a;@ thisUpdate=%a;@ nextUpdate=%a;@ singleExtensions=%a;@ }@]"
pp_cert_id certID
pp_cert_status certStatus
Ptime.pp thisUpdate
(Fmt.option ~none:(Fmt.any "None") @@ Ptime.pp) nextUpdate
(Fmt.option ~none:(Fmt.any "None") @@ Extension.pp) singleExtensions
let single_response_cert_id {certID;_} = certID
let single_response_status {certStatus;_} = certStatus
(* ResponderID ::= CHOICE {
* byName [1] Name,
* byKey [2] KeyHash }
* KeyHash ::= OCTET STRING -- SHA-1 hash of responder's public key
(excluding the tag and length fields)
*)
type responder_id = [
| `ByName of Distinguished_name.t
| `ByKey of string
]
let create_responder_id pubkey =
let pubkey_fp = Public_key.fingerprint ~hash:`SHA1 pubkey in
`ByKey pubkey_fp
let pp_responder_id ppf = function
| `ByName dn -> Fmt.pf ppf "ByName %a" Distinguished_name.pp dn
| `ByKey hash -> Fmt.pf ppf "ByKey %a" Ohex.pp hash
(* ResponseData ::= SEQUENCE {
* version [0] EXPLICIT Version DEFAULT v1,
* responderID ResponderID,
* producedAt GeneralizedTime,
* responses SEQUENCE OF SingleResponse,
* responseExtensions [1] EXPLICIT Extensions OPTIONAL } *)
type response_data = {
responderID: responder_id;
producedAt: Ptime.t;
responses: single_response list;
responseExtensions: Extension.t option;
}
let pp_response_data ppf { responderID ; producedAt ; responses ; responseExtensions } =
Fmt.pf ppf "ResponseData @[<1>{@ responderID=%a;@ producedAt=%a;@ responses=%a;@ responseExtensions=%a@ }@]"
pp_responder_id responderID
Ptime.pp producedAt
(Fmt.list ~sep:Fmt.semi @@ pp_single_response) responses
(Fmt.option ~none:(Fmt.any "None") @@ Extension.pp) responseExtensions
(* BasicOCSPResponse ::= SEQUENCE {
* tbsResponseData ResponseData,
* signatureAlgorithm AlgorithmIdentifier,
* signature BIT STRING,
* certs [0] EXPLICIT SEQUENCE OF Certificate OPTIONAL } *)
type basic_ocsp_response = {
tbsResponseData: response_data;
signatureAlgorithm: Algorithm.t;
signature: string;
certs: Certificate.t list option;
}
let pp_basic_ocsp_response ppf {tbsResponseData;signatureAlgorithm;signature;certs;} =
Fmt.pf ppf "BasicOCSPResponse @[<1>{@ tbsResponseData=%a;@ signatureAlgorithm=%a;@ signature=%a;@ certs=%a@ }@]"
pp_response_data tbsResponseData
Algorithm.pp signatureAlgorithm
Ohex.pp signature
(Fmt.option ~none:(Fmt.any "None") @@
Fmt.list ~sep:Fmt.semi @@ Certificate.pp) certs
(* ResponseBytes ::= SEQUENCE {
* responseType OBJECT IDENTIFIER,
* response OCTET STRING } *)
(* OCSPResponse ::= SEQUENCE {
* responseStatus OCSPResponseStatus,
* responseBytes [0] EXPLICIT ResponseBytes OPTIONAL } *)
type t = {
responseStatus: status;
responseBytes: (Asn.oid * basic_ocsp_response * string) option;
}
let pp ppf {responseStatus;responseBytes;} =
Fmt.pf ppf "OCSPResponse @[<1>{@ responseStatus=%a;@ responseBytes=%a@ }@]"
pp_status responseStatus
(Fmt.option ~none:(Fmt.any "None") @@
Fmt.pair ~sep:Fmt.comma Asn.OID.pp pp_basic_ocsp_response)
(match responseBytes with None -> None | Some (a, b, _) -> Some (a, b))
let status {responseStatus;_} = responseStatus
let responder_id = function
| {responseBytes=Some (_, {tbsResponseData={responderID;_};_}, _);_} ->
Ok responderID
| _ -> Error (`Msg "this response has no responseBytes")
let responses = function
| {responseBytes=Some (_, {tbsResponseData={responses;_};_}, _);_} ->
Ok responses
| _ -> Error (`Msg "this response has no responseBytes")
module Asn = struct
open Asn_grammars
open Asn.S
open Registry
let status : status Asn.t =
enumerated status_of_int status_to_int
let revoked_info =
sequence2
(required ~label:"revocationTime" generalized_time_no_frac_s)
(optional ~label:"revocationReason" @@ explicit 0 @@
Extension.Asn.reason_enumerated)
let cert_status : cert_status Asn.t =
let f = function
| `C1 () -> `Good
| `C2 ri -> `Revoked ri
| `C3 () -> `Unknown
in
let g = function
| `Good -> `C1 ()
| `Revoked ri -> `C2 ri
| `Unknown -> `C3 ()
in
map f g @@
choice3
(implicit 0 @@ null)
(implicit 1 @@ revoked_info)
(implicit 2 @@ null)
let single_response =
let f (certID,certStatus,thisUpdate,nextUpdate,singleExtensions) =
{certID;certStatus;thisUpdate;nextUpdate;singleExtensions;}
in
let g {certID;certStatus;thisUpdate;nextUpdate;singleExtensions;} =
(certID,certStatus,thisUpdate,nextUpdate,singleExtensions)
in
map f g @@
sequence5
(required ~label:"certID" @@ Asn_common.cert_id)
(required ~label:"certStatus" @@ cert_status)
(required ~label:"thisUpdate" @@ generalized_time_no_frac_s)
(optional ~label:"nextUpdate" @@ explicit 0 @@
generalized_time_no_frac_s)
(optional ~label:"singleExtensions" @@ explicit 1 @@
Extension.Asn.extensions_der)
let responder_id : responder_id Asn.t =
let f = function
| `C1 dn -> `ByName dn
| `C2 hash -> `ByKey hash
in
let g = function
| `ByName dn -> `C1 dn
| `ByKey hash -> `C2 hash
in
map f g @@
choice2 (explicit 1 Distinguished_name.Asn.name) (explicit 2 octet_string)
let response_data =
let f (version, responderID, producedAt, responses, responseExtensions) =
match version with
| Some v when v <> version_v1 ->
Asn.S.parse_error "unsupported version %d" v
| _ -> { responderID ; producedAt ; responses ; responseExtensions }
in
let g { responderID ; producedAt ; responses ; responseExtensions } =
(None, responderID, producedAt, responses, responseExtensions)
in
map f g @@
sequence5
(optional ~label:"version" @@ explicit 0 @@ int)
(required ~label:"responderID" responder_id)
(required ~label:"producedAt" generalized_time_no_frac_s)
(required ~label:"responses" @@ sequence_of single_response)
(optional ~label:"responseExtensions" @@ explicit 1 @@
Extension.Asn.extensions_der)
let response_data_of_str, response_data_to_str =
projections_of Asn.der response_data
let basic_ocsp_response =
let f (tbsResponseData,signatureAlgorithm,signature,certs) =
let certs = match certs with
| None -> None
| Some certs ->
let encode cert =
let raw = Certificate.Asn.certificate_to_octets cert in
Certificate.{raw; asn=cert}
in
Some (List.map encode certs)
in
{tbsResponseData;signatureAlgorithm;signature;certs}
in
let g {tbsResponseData;signatureAlgorithm;signature;certs} =
let certs = match certs with
| None -> None
| Some certs ->
Some (List.map (fun Certificate.{asn;_} -> asn) certs)
in
(tbsResponseData,signatureAlgorithm,signature,certs)
in
map f g @@
sequence4
(required ~label:"tbsResponseData" response_data)
(required ~label:"signatureAlgorithm" Algorithm.identifier)
(required ~label:"signature" bit_string_octets)
(optional ~label:"certs" @@ explicit 0 @@
sequence_of Certificate.Asn.certificate)
let basic_ocsp_response_of_str,basic_ocsp_response_to_str =
projections_of Asn.der basic_ocsp_response
let ocsp_basic_oid = Cert_extn.Private_internet_extensions.ad_ocsp_basic
let ocsp_response =
let f = function
| `Successful, None ->
parse_error "Successful status requires responseBytes"
| `Successful, Some (oid, response) ->
if Asn.OID.equal ocsp_basic_oid oid then
match basic_ocsp_response_of_str response with
| Error e -> error e
| Ok basic_response ->
{responseStatus=`Successful;
responseBytes=Some (oid, basic_response, response)}
else
parse_error "expected OID ad_ocsp_basic"
| (`InternalError
| `MalformedRequest
| `SigRequired
| `TryLater
|`Unauthorized) as s, None ->
{responseStatus=s;responseBytes=None}
| _, Some _ -> parse_error "Only Successful status supports non empty responseBytes"
in
let g {responseStatus;responseBytes} =
let responseBytes = match responseBytes with
| Some (oid, _basic_response, response) -> Some (oid, response)
| None -> None
in
(responseStatus,responseBytes)
in
map f g @@
sequence2
(required ~label:"responseStatus" status)
(optional ~label:"responseBytes" @@ explicit 0 @@
sequence2
(required ~label:"responseType" oid)
(required ~label:"response" octet_string))
let ocsp_response_of_str, ocsp_response_to_str =
projections_of Asn.der ocsp_response
end
let decode_der = Asn.ocsp_response_of_str
let encode_der = Asn.ocsp_response_to_str
let create_basic_ocsp_response ?digest ?certs
?response_extensions:responseExtensions key responderID producedAt
responses =
let digest = Signing_request.default_digest digest key in
let scheme = Key_type.x509_default_scheme (Private_key.key_type key) in
let signatureAlgorithm = Algorithm.of_signature_algorithm scheme digest in
let tbsResponseData = {
responderID;
producedAt;
responses;
responseExtensions;
} in
let resp_der = Asn.response_data_to_str tbsResponseData in
let* signature = Private_key.sign digest ~scheme key (`Message resp_der) in
Ok { tbsResponseData ; signatureAlgorithm ; signature;certs }
let create_success ?digest ?certs ?response_extensions
private_key responderID producedAt responses =
let* response =
create_basic_ocsp_response
?digest ?certs ?response_extensions private_key
responderID producedAt responses
in
let raw_resp = Asn.basic_ocsp_response_to_str response in
let responseBytes = Some (Asn.ocsp_basic_oid, response, raw_resp) in
Ok { responseStatus = `Successful ; responseBytes }
let create status =
let status = match status with
| `MalformedRequest -> `MalformedRequest
| `InternalError -> `InternalError
| `TryLater -> `TryLater
| `SigRequired -> `SigRequired
| `Unauthorized -> `Unauthorized
in
{responseStatus=status;responseBytes=None}
let validate t ?(allowed_hashes = Validation.sha2) ?now pub =
match t.responseBytes with
| None -> Error `No_signature
| Some (_oid, response, raw_resp) ->
let resp_der = Validation.raw_cert_hack raw_resp in
let dn =
let cn = "OCSP" in
[ Distinguished_name.(Relative_distinguished_name.singleton (CN cn)) ]
in
let* () =
Validation.validate_raw_signature dn allowed_hashes resp_der
response.signatureAlgorithm response.signature pub
in
match now with
| None -> Ok ()
| Some now ->
if
List.for_all (fun single_resp ->
Ptime.is_later ~than:single_resp.thisUpdate now &&
match single_resp.nextUpdate with
| None -> true
| Some until -> Ptime.is_earlier ~than:until now)
response.tbsResponseData.responses
then
Ok ()
else
Error `Time_invalid
end

468
unikernel/duniverse/ocaml-x509/lib/p12.ml Normal file
View file

@ -0,0 +1,468 @@
(* partial PKCS12 implementation, as defined in RFC 7292
- no public/private key mode, only password privacy and integrity
- algorithmidentifier those I need for openssl interop (looking at the p12 I have on my disk)
- require version being 3
some definitions from PKCS7 (RFC 2315) are implemented as well, as needed
*)
type content_info = Asn.oid * string
type digest_info = Algorithm.t * string
type mac_data = digest_info * string * int
type t = string * mac_data
module Asn = struct
open Asn_grammars
open Asn.S
open Registry
let encrypted_content_info =
let f (oid, algo, content) =
if Asn.OID.equal PKCS7.data oid then
(algo, content)
else
parse_error "expected OID PKCS7 data"
and g (algo, content) =
(PKCS7.data, algo, content)
in
Asn.S.map f g @@
sequence3
(required ~label:"content type" oid) (* here we assume data!? *)
(required ~label:"content encryption algorithm" Algorithm.identifier)
(optional ~label:"encrypted content" (implicit 0 octet_string))
let encrypted_data =
let f (v, eci) =
if v = 0 then eci else parse_error "unknown encrypted data version"
and g eci = 0, eci
in
map f g @@
sequence2
(required ~label:"version" int)
(required ~label:"encrypted content info" encrypted_content_info)
let content_info =
let f (oid, data) =
match data with
| None -> parse_error "found no value for content info"
| Some `C1 data when Asn.OID.equal PKCS7.data oid -> `Data data
| Some `C2 eci when Asn.OID.equal PKCS7.encrypted_data oid -> `Encrypted eci
| _ -> parse_error "couldn't match PKCS7 oid with choice"
and g = function
| `Data data -> PKCS7.data, Some (`C1 data)
| `Encrypted eci -> PKCS7.encrypted_data, Some (`C2 eci)
in
map f g @@
sequence2
(required ~label:"content type" oid)
(optional ~label:"content" (explicit 0
(choice2 octet_string encrypted_data)))
let digest_info =
sequence2
(required ~label:"digest algorithm" Algorithm.identifier)
(required ~label:"digest" octet_string)
let mac_data =
sequence3
(required ~label:"mac" digest_info)
(required ~label:"mac salt" octet_string)
(required ~label:"iterations" int)
let pfx =
let f (version, content_info, mac_data) =
if version = 3 then
match content_info, mac_data with
| `Data data, Some md -> data, md
| _, None -> parse_error "missing mac_data"
| _, _ -> parse_error "unsupported content_info"
else
parse_error "unsupported pfx version"
and g (content, mac_data) =
(3, `Data content, Some mac_data)
in
map f g @@
sequence3
(required ~label:"version" int)
(required ~label:"auth safe" content_info)
(* contentType is signedData in public-key integrity mode and data in
password integrity mode *)
(optional ~label:"mac data" mac_data) (* not present if public keys used *)
let pfx_of_cs, pfx_to_cs = projections_of Asn.der pfx
(* payload is a sequence of content_info *)
let authenticated_safe = sequence_of content_info
let auth_safe_of_cs, auth_safe_to_cs =
projections_of Asn.der authenticated_safe
let pkcs12_attribute =
sequence2
(required ~label:"attribute id" oid)
(required ~label:"attribute value" (set_of octet_string))
(* here:
key_bag = PKCS8 private key
pkcs8_shrouded_key_bag = encrypted private key info ==
sequence2 Algorithm octet_string
cert_bag =
sequence2
cert_id (PKCS9 cert_types <| 1 (X509) or 2 (SDSI))
expl 0 cert_value (DER-encoded certificate)
crl_bag = sequence2 crl_id (PKCS9 crl_types <| 1) (expl 0 crl (DER-encoded))
^^^---^^^ those we plan to support
secret_bag = sequence2 secret_type (expl 0 secret_value)
safe_contents_bag = (any of the above) safe_contents (recursive!)
*)
(* since asn1 does not yet support ANY defined BY, we develop a rather
complex grammar covering all supported bags *)
let safe_bag =
let cert_oid, crl_oid =
Asn.OID.(PKCS9.cert_types <| 1, PKCS9.crl_types <| 1)
in
let f (oid, (a, algo, data), attrs) =
match a, algo, data with
| `C1 v, Some a, `C1 data when Asn.OID.equal oid PKCS12.key_bag ->
let key = Private_key.Asn.reparse_private (v, a, data) in
`Private_key key, attrs
| `C2 id, None, `C2 data ->
if Asn.OID.equal oid PKCS12.cert_bag && Asn.OID.equal id cert_oid then
match Certificate.decode_der data with
| Error (`Msg e) -> error (`Parse e)
| Ok cert -> `Certificate cert, attrs
else if Asn.OID.equal oid PKCS12.crl_bag && Asn.OID.equal id crl_oid then
match Crl.decode_der data with
| Error (`Msg e) -> error (`Parse e)
| Ok crl -> `Crl crl, attrs
else
parse_error "crl bag with non-standard crl"
| `C3 algo, None, `C1 data when Asn.OID.equal oid PKCS12.pkcs8_shrouded_key_bag ->
`Encrypted_private_key (algo, data), attrs
| _ -> parse_error "safe bag OID not supported"
and g (v, attrs) =
let oid, d = match v with
| `Encrypted_private_key (algo, data) ->
PKCS12.pkcs8_shrouded_key_bag, (`C3 algo, None, `C1 data)
| `Private_key pk ->
let v, algo, data = Private_key.Asn.unparse_private pk in
PKCS12.key_bag, (`C1 v, Some algo, `C1 data)
| `Certificate cert -> PKCS12.cert_bag, (`C2 cert_oid, None, `C2 (Certificate.encode_der cert))
| `Crl crl -> PKCS12.crl_bag, (`C2 crl_oid, None, `C2 (Crl.encode_der crl))
in
(oid, d, attrs)
in
map f g @@
sequence3
(required ~label:"bag id" oid)
(required ~label:"bag value"
(explicit 0
(sequence3
(required ~label:"fst" (choice3 int oid Algorithm.identifier))
(optional ~label:"algorithm" Algorithm.identifier)
(required ~label:"data" (choice2 octet_string (explicit 0 octet_string))))))
(* (explicit 0 (* encrypted private key *)
(sequence2
(required ~label:"encryption algorithm" Algorithm.identifier)
(required ~label:"encrypted data" octet_string))) *)
(* (explicit 0 (* private key ] *)
(sequence3
(required ~label:"version" int)
(required ~label:"privateKeyAlgorithm" Algorithm.identifier)
(required ~label:"privateKey" octet_string))) *)
(* (explicit 0 (* cert / crl *)
(sequence2
(required ~label:"oid" oid)
(required ~label:"data" (explicit 0 octet_string)))) *)
(optional ~label:"bag attributes" (set_of pkcs12_attribute))
let safe_contents = sequence_of safe_bag
let safe_contents_of_cs, safe_contents_to_cs =
projections_of Asn.der safe_contents
end
let prepare_pw str =
let l = String.length str in
let cs = Bytes.make ((succ l) * 2) '\000' in
for i = 0 to pred l do
Bytes.set cs (succ (i * 2)) (String.get str i)
done;
Bytes.unsafe_to_string cs
let id len purpose =
let id = match purpose with
| `Encryption -> 1
| `Iv -> 2
| `Hmac -> 3
in
String.make len (Char.unsafe_chr id)
let v = function
| `MD5 | `SHA1 | `SHA224 | `SHA256 -> 512 / 8
| `SHA384 | `SHA512 -> 1024 / 8
let fill ~data ~out =
let len = Bytes.length out
and l = String.length data
in
let rec c off =
if off < len then begin
Bytes.blit_string data 0 out off (min (len - off) l);
c (off + l)
end
in
c 0
let fill_or_empty size data =
let l = String.length data in
if l = 0 then data
else
let len = size * ((l + size - 1) / size) in
let buf = Bytes.make len '\000' in
fill ~data ~out:buf;
Bytes.unsafe_to_string buf
let pbes algorithm purpose password salt iterations n =
let module Hash = (val (Digestif.module_of_hash' (algorithm :> Digestif.hash'))) in
let pw = prepare_pw password
and v = v algorithm
and u = Hash.digest_size
in
let diversifier = id v purpose in
let salt = fill_or_empty v salt in
let pass = fill_or_empty v pw in
let out = Bytes.make n '\000' in
let rec one off i =
let ai = ref Hash.(to_raw_string (digest_string (diversifier ^ i))) in
for _j = 1 to pred iterations do
ai := Hash.(to_raw_string (digest_string !ai));
done;
Bytes.blit_string !ai 0 out off (min (n - off) u);
if u >= n - off then () else
(* 6B *)
let b = Bytes.make v '\000' in
fill ~data:!ai ~out:b;
(* 6C *)
let i' = Bytes.create (String.length i) in
for j = 0 to pred (String.length i / v) do
let c = ref 1 in
for k = pred v downto 0 do
let idx = j * v + k in
c := (!c + String.get_uint8 i idx + Bytes.get_uint8 b k) land 0xFFFF;
Bytes.set_uint8 i' idx (!c land 0xFF);
c := !c lsr 8;
done;
done;
one (off + u) (Bytes.to_string i')
in
let i = salt ^ pass in
one 0 i;
Bytes.unsafe_to_string out
let split str off =
String.sub str 0 off,
String.sub str off (String.length str - off)
(* TODO PKCS5/7 padding is "k - (l mod k)" i.e. always > 0!
(and rc4 being a stream cipher has no padding!) *)
let unpad x =
(* TODO can there be bad padding in this scheme? *)
let l = String.length x in
if l > 0 then
let amount = String.get_uint8 x (pred l) in
let split_point = if l > amount then l - amount else l in
let data, pad = split x split_point in
let good = ref true in
for i = 0 to pred amount do
if String.get_uint8 pad i <> amount then good := false
done;
if !good then data else x
else
x
let pad bs x =
let l = String.length x in
let to_pad = bs - (l mod bs) in
let amount = String.make to_pad (Char.unsafe_chr to_pad) in
x ^ amount
let ( let* ) = Result.bind
(* there are 3 possibilities to encrypt / decrypt things:
- PKCS12 KDF (see above), with RC2/RC4/DES
- PKCS5 v1 (PBES, PBKDF1) -- not (yet?) supported
- PKCS5 v2 (PBES2, PBKDF2)
*)
let pkcs12_decrypt algo password data =
let open Algorithm in
let hash = `SHA1 in
let* salt, count, key_len, iv_len =
match algo with
| SHA_RC4_128 (s, i) -> Ok (s, i, 16, 0)
| SHA_RC4_40 (s, i) -> Ok (s, i, 5, 0)
| SHA_3DES_CBC (s, i) -> Ok (s, i, 24, 8)
| SHA_2DES_CBC (s, i) -> Ok (s, i, 16, 8) (* TODO 2des -> 3des keys (if relevant)*)
| SHA_RC2_128_CBC (s, i) -> Ok (s, i, 16, 8)
| SHA_RC2_40_CBC (s, i) -> Ok (s, i, 5, 8)
| _ -> Error (`Msg "unsupported algorithm")
in
let key = pbes hash `Encryption password salt count key_len
and iv = pbes hash `Iv password salt count iv_len
in
let open Mirage_crypto in
let* data =
match algo with
| SHA_RC2_40_CBC _ | SHA_RC2_128_CBC _ ->
Ok (Rc2.decrypt_cbc ~effective:(key_len * 8) ~key ~iv data)
| SHA_RC4_40 _ | SHA_RC4_128 _ ->
let key = ARC4.of_secret key in
let { ARC4.message ; _ } = ARC4.decrypt ~key data in
Ok message
| SHA_3DES_CBC _ ->
let key = DES.CBC.of_secret key in
Ok (DES.CBC.decrypt ~key ~iv data)
| _ -> Error (`Msg "encryption algorithm not supported")
in
Ok (unpad data)
let pkcs5_2_decrypt kdf enc password data =
let* dk_len, iv =
match enc with
| Algorithm.AES128_CBC iv -> Ok (16l, iv)
| Algorithm.AES192_CBC iv -> Ok (24l, iv)
| Algorithm.AES256_CBC iv -> Ok (32l, iv)
| _ -> Error (`Msg "unsupported encryption algorithm")
in
let* salt, count, prf =
match kdf with
| Algorithm.PBKDF2 (salt, iterations, _ (* todo handle keylength *), prf) ->
let* prf =
match Algorithm.to_hmac prf with
| Some prf -> Ok prf
| None -> Error (`Msg "unsupported PRF")
in
Ok (salt, iterations, prf)
| _ -> Error (`Msg "expected kdf being pbkdf2")
in
let key = Pbkdf.pbkdf2 ~prf ~password ~salt ~count ~dk_len in
let key = Mirage_crypto.AES.CBC.of_secret key in
let msg = Mirage_crypto.AES.CBC.decrypt ~key ~iv data in
Ok (unpad msg)
let pkcs5_2_encrypt (mac : [ `SHA1 | `SHA224 | `SHA256 | `SHA384 | `SHA512 ]) count algo password data =
let module Hash = (val (Digestif.module_of_hash' (mac :> Digestif.hash'))) in
let bs = Mirage_crypto.AES.CBC.block_size in
let iv = Mirage_crypto_rng.generate bs in
let enc, dk_len =
match algo with
| `AES128_CBC -> Algorithm.AES128_CBC iv, 16l
| `AES192_CBC -> Algorithm.AES192_CBC iv, 24l
| `AES256_CBC -> Algorithm.AES256_CBC iv, 32l
in
let salt = Mirage_crypto_rng.generate Hash.digest_size in
let key = Pbkdf.pbkdf2 ~prf:(mac :> Digestif.hash') ~password ~salt ~count ~dk_len in
let key = Mirage_crypto.AES.CBC.of_secret key in
let padded_data = pad bs data in
let enc_data =
Mirage_crypto.AES.CBC.encrypt ~key ~iv padded_data
in
let kdf = Algorithm.PBKDF2 (salt, count, None, Algorithm.of_hmac mac) in
Algorithm.PBES2 (kdf, enc), enc_data
let decrypt algo password data =
let open Algorithm in
match algo with
| SHA_RC4_128 _ | SHA_RC4_40 _
| SHA_3DES_CBC _ | SHA_2DES_CBC _
| SHA_RC2_128_CBC _ | SHA_RC2_40_CBC _ -> pkcs12_decrypt algo password data
| PBES2 (kdf, enc) -> pkcs5_2_decrypt kdf enc password data
| _ -> Error (`Msg "unsupported encryption algorithm")
let password_decrypt password (algo, data) =
match data with
| None -> Error (`Msg "no data to decrypt")
| Some data -> decrypt algo password data
let verify password (data, ((algorithm, digest), salt, iterations)) =
let* hash =
Option.to_result
~none:(`Msg "unsupported hash algorithm")
(Algorithm.to_hash algorithm)
in
let module Hash = (val (Digestif.module_of_hash' (hash :> Digestif.hash'))) in
let key =
pbes hash `Hmac password salt iterations Hash.digest_size
in
let computed = Hash.(to_raw_string (hmac_string ~key data)) in
if String.equal computed digest then begin
let* content = Asn_grammars.err_to_msg (Asn.auth_safe_of_cs data) in
let* safe_contents =
List.fold_left (fun acc c ->
let* acc = acc in
match c with
| `Data data -> Ok (data :: acc)
| `Encrypted data ->
let* data = password_decrypt password data in
Ok (data :: acc))
(Ok []) content
in
List.fold_left (fun acc cs ->
let* acc = acc in
let* bags = Asn_grammars.err_to_msg (Asn.safe_contents_of_cs cs) in
List.fold_left (fun acc bag ->
let* acc = acc in
match bag with
| `Certificate c, _ -> Ok (`Certificate c :: acc)
| `Crl c, _ -> Ok (`Crl c :: acc)
| `Private_key p, _ -> Ok (`Private_key p :: acc)
| `Encrypted_private_key (algo, enc_data), _ ->
let* data = decrypt algo password enc_data in
let* p =
Asn_grammars.err_to_msg (Private_key.Asn.private_of_octets data)
in
Ok (`Decrypted_private_key p :: acc))
(Ok acc) bags)
(Ok []) safe_contents
end else
Error (`Msg "invalid signature")
let create ?(mac = `SHA256) ?(algorithm = `AES256_CBC) ?(iterations = 2048) password certificates private_key =
let key_fp pub = Public_key.fingerprint pub in
let priv_fp = key_fp (Private_key.public private_key) in
let attributes = [ Registry.PKCS9.local_key_id, [ priv_fp ]] in
let maybe_attr c =
if String.equal priv_fp (key_fp (Certificate.public_key c)) then
Some attributes
else
None
in
let cert_sc =
Asn.safe_contents_to_cs (List.map (fun c -> `Certificate c, maybe_attr c) certificates)
and priv_sc =
let data = Private_key.Asn.private_to_octets private_key in
let algo, data = pkcs5_2_encrypt mac iterations algorithm password data in
Asn.safe_contents_to_cs [ `Encrypted_private_key (algo, data), Some attributes ]
in
let cert_sc_enc =
let algo, data = pkcs5_2_encrypt mac iterations algorithm password cert_sc in
algo, Some data
in
let auth_data =
Asn.auth_safe_to_cs [ `Encrypted cert_sc_enc ; `Data priv_sc ]
in
let module Hash = (val (Digestif.module_of_hash' (mac :> Digestif.hash'))) in
let mac_size = Hash.digest_size in
let salt = Mirage_crypto_rng.generate mac_size in
let key = pbes mac `Hmac password salt iterations mac_size in
let digest = Hash.(to_raw_string (hmac_string ~key auth_data)) in
auth_data, ((Algorithm.of_hash mac, digest), salt, iterations)
let decode_der cs = Asn_grammars.err_to_msg (Asn.pfx_of_cs cs)
let encode_der = Asn.pfx_to_cs

108
unikernel/duniverse/ocaml-x509/lib/pem.ml Normal file
View file

@ -0,0 +1,108 @@
let ( let* ) = Result.bind
module Cs = struct
open String
let null cs = length cs = 0
let open_begin = "-----BEGIN "
and open_end = "-----END "
and close = "-----"
let tok_of_line cs =
if null cs then
`Empty
else if get cs 0 = '#' then
`Empty
else if starts_with ~prefix:open_begin cs && ends_with ~suffix:close cs then
`Begin (sub cs 11 (length cs - 16))
else if starts_with ~prefix:open_end cs && ends_with ~suffix:close cs then
`End (sub cs 9 (length cs - 14))
else
`Data cs
let lines data =
List.map tok_of_line
(List.map
(fun line ->
let ll = length line in
if ll > 0 && get line (ll - 1) = '\r' then sub line 0 (ll - 1) else line)
(String.split_on_char '\n' data))
let combine ilines =
let rec accumulate t acc = function
| `Empty :: tail -> accumulate t acc tail
| `Data cs :: tail -> accumulate t (cs :: acc) tail
| `End t' :: tail ->
if String.equal t t' then
let data = match Base64.decode (concat "" (List.rev acc)) with
| Ok data -> Ok (t, data)
| Error e -> Error e
in
data, tail
else
Error (`Msg ("invalid end, expected " ^ t ^ ", found " ^ t')), tail
| _ :: tail -> Error (`Msg "invalid line, expected data or end"), tail
| [] -> Error (`Msg "end of input"), []
in
let rec block acc = function
| `Begin t :: tail ->
let body, tail = accumulate t [] tail in
block (body :: acc) tail
| _ :: xs -> block acc xs
| [] -> List.rev acc
in
block [] ilines
let parse_with_errors data = combine (lines data)
let unparse ~tag value =
let split_at_64 data =
let dlen = length data in
let rec go acc off =
if dlen - off <= 64 then
List.rev (sub data off (dlen - off) :: acc)
else
let chunk = sub data off 64 in
go (chunk :: acc) (off + 64)
in
go [] 0
in
let raw = Base64.encode_string value in
let pieces = split_at_64 raw in
let nl = "\n" in
let lines = List.flatten (List.map (fun x -> [ x ; nl ]) pieces)
in
let first = [ open_begin ; tag ; close ; nl ]
and last = [ open_end ; tag ; close ; nl ]
in
concat "" (first @ lines @ last)
end
let parse_with_errors, unparse = Cs.(parse_with_errors, unparse)
let parse data =
let entries, errors =
List.partition_map
(function Ok v -> Either.Left v | Error e -> Either.Right e)
(parse_with_errors data)
in
match errors with
| [] -> Ok entries
| first_error :: _ -> Error first_error
let exactly_one ~what = function
| [] -> Error (`Msg ("No " ^ what))
| [x] -> Ok x
| _ -> Error (`Msg ("Multiple " ^ what ^ "s"))
let foldM f data =
let wrap acc data =
let* datas' = acc in
let* data = f data in
Ok (data :: datas')
in
let* res = List.fold_left wrap (Ok []) data in
Ok (List.rev res)

289
unikernel/duniverse/ocaml-x509/lib/private_key.ml Normal file
View file

@ -0,0 +1,289 @@
let ( let* ) = Result.bind
type ecdsa = [
| `P256 of Mirage_crypto_ec.P256.Dsa.priv
| `P384 of Mirage_crypto_ec.P384.Dsa.priv
| `P521 of Mirage_crypto_ec.P521.Dsa.priv
]
type t = [
ecdsa
| `RSA of Mirage_crypto_pk.Rsa.priv
| `ED25519 of Mirage_crypto_ec.Ed25519.priv
]
let key_type = function
| `RSA _ -> `RSA
| `ED25519 _ -> `ED25519
| `P256 _ -> `P256
| `P384 _ -> `P384
| `P521 _ -> `P521
let generate ?seed ?(bits = 4096) typ =
let g = match seed with
| None -> None
| Some seed -> Some Mirage_crypto_rng.(create ~seed (module Fortuna))
in
match typ with
| `RSA -> `RSA (Mirage_crypto_pk.Rsa.generate ?g ~bits ())
| `ED25519 -> `ED25519 (fst (Mirage_crypto_ec.Ed25519.generate ?g ()))
| `P256 -> `P256 (fst (Mirage_crypto_ec.P256.Dsa.generate ?g ()))
| `P384 -> `P384 (fst (Mirage_crypto_ec.P384.Dsa.generate ?g ()))
| `P521 -> `P521 (fst (Mirage_crypto_ec.P521.Dsa.generate ?g ()))
let of_octets data =
let open Mirage_crypto_ec in
let ec_err e =
Result.map_error
(fun e -> `Msg (Fmt.to_to_string Mirage_crypto_ec.pp_error e))
e
in
function
| `RSA -> Error (`Msg "cannot decode an RSA key")
| `ED25519 ->
let* k = ec_err (Ed25519.priv_of_octets data) in
Ok (`ED25519 k)
| `P256 ->
let* k = ec_err (P256.Dsa.priv_of_octets data) in
Ok (`P256 k)
| `P384 ->
let* k = ec_err (P384.Dsa.priv_of_octets data) in
Ok (`P384 k)
| `P521 ->
let* k = ec_err (P521.Dsa.priv_of_octets data) in
Ok (`P521 k)
let of_string ?seed_or_data ?bits typ data =
match seed_or_data with
| None ->
begin match typ with
| `RSA -> Ok (generate ~seed:data ?bits `RSA)
| _ ->
let* data = Base64.decode data in
of_octets data typ
end
| Some `Seed ->
Ok (generate ~seed:data ?bits typ)
| Some `Data ->
let* data = Base64.decode data in
of_octets data typ
let public = function
| `RSA priv -> `RSA (Mirage_crypto_pk.Rsa.pub_of_priv priv)
| `ED25519 priv -> `ED25519 (Mirage_crypto_ec.Ed25519.pub_of_priv priv)
| `P256 priv -> `P256 (Mirage_crypto_ec.P256.Dsa.pub_of_priv priv)
| `P384 priv -> `P384 (Mirage_crypto_ec.P384.Dsa.pub_of_priv priv)
| `P521 priv -> `P521 (Mirage_crypto_ec.P521.Dsa.pub_of_priv priv)
let sign hash ?scheme key data =
let open Mirage_crypto_ec in
let hashed () = Public_key.hashed hash data
and ecdsa_to_str s = Algorithm.ecdsa_sig_to_octets s
in
let scheme = Key_type.opt_signature_scheme ?scheme (key_type key) in
try
match key, scheme with
| `RSA key, `RSA_PSS ->
let module H = (val (Digestif.module_of_hash' hash)) in
let module PSS = Mirage_crypto_pk.Rsa.PSS(H) in
let* d = hashed () in
Ok (PSS.sign ~key (`Digest d))
| `RSA key, `RSA_PKCS1 ->
let* d = hashed () in
Ok (Mirage_crypto_pk.Rsa.PKCS1.sign ~key ~hash (`Digest d))
| `ED25519 key, `ED25519 ->
begin match data with
| `Message m -> Ok (Ed25519.sign ~key m)
| `Digest _ -> Error (`Msg "Ed25519 only suitable with raw message")
end
| #ecdsa as key, `ECDSA ->
let* d = hashed () in
Ok (ecdsa_to_str (match key with
| `P256 key -> P256.Dsa.(sign ~key (Public_key.trunc byte_length d))
| `P384 key -> P384.Dsa.(sign ~key (Public_key.trunc byte_length d))
| `P521 key -> P521.Dsa.(sign ~key (Public_key.trunc byte_length d))))
| _ -> Error (`Msg "invalid key and signature scheme combination")
with
| Mirage_crypto_pk.Rsa.Insufficient_key ->
Error (`Msg "RSA key of insufficient length")
| Message_too_long -> Error (`Msg "message too long")
module Asn = struct
open Asn.S
open Mirage_crypto_pk
(* RSA *)
let other_prime_infos =
sequence_of @@
(sequence3
(required ~label:"prime" unsigned_integer)
(required ~label:"exponent" unsigned_integer)
(required ~label:"coefficient" unsigned_integer))
let rsa_private_key =
let integer = map Z_extra.of_octets_be Z_extra.to_octets_be unsigned_integer in
let f (v, (n, (e, (d, (p, (q, (dp, (dq, (q', other))))))))) =
match (v, other) with
| (0, None) ->
begin match Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' with
| Ok p -> p
| Error (`Msg m) -> parse_error "bad RSA private key %s" m
end
| _ -> parse_error "multi-prime RSA keys not supported"
and g { Rsa.e; d; n; p; q; dp; dq; q' } =
(0, (n, (e, (d, (p, (q, (dp, (dq, (q', None))))))))) in
map f g @@
sequence @@
(required ~label:"version" int)
@ (required ~label:"modulus" integer) (* n *)
@ (required ~label:"publicExponent" integer) (* e *)
@ (required ~label:"privateExponent" integer) (* d *)
@ (required ~label:"prime1" integer) (* p *)
@ (required ~label:"prime2" integer) (* q *)
@ (required ~label:"exponent1" integer) (* dp *)
@ (required ~label:"exponent2" integer) (* dq *)
@ (required ~label:"coefficient" integer) (* qinv *)
-@ (optional ~label:"otherPrimeInfos" other_prime_infos)
(* For outside uses. *)
let (rsa_private_of_octets, rsa_private_to_octets) =
Asn_grammars.projections_of Asn.der rsa_private_key
(* PKCS8 *)
let (rsa_priv_of_str, rsa_priv_to_str) =
Asn_grammars.project_exn rsa_private_key
let ec_to_err = function
| Ok x -> x
| Error e -> parse_error "%a" Mirage_crypto_ec.pp_error e
let ed25519_of_str, ed25519_to_str =
Asn_grammars.project_exn octet_string
let ec_private_key =
let f (v, pk, nc, pub) =
if v <> 1 then
parse_error "bad version for ec Private key"
else
let curve = match nc with
| Some c -> Some (Algorithm.curve_of_oid c)
| None -> None
in
pk, curve, pub
and g (pk, curve, pub) =
let nc = match curve with
| None -> None | Some c -> Some (Algorithm.curve_to_oid c)
in
(1, pk, nc, pub)
in
Asn.S.map f g @@
sequence4
(required ~label:"version" int) (* ecPrivkeyVer1(1) *)
(required ~label:"privateKey" octet_string)
(* from rfc5480: choice3, but only namedCurve is allowed in PKIX *)
(optional ~label:"namedCurve" (explicit 0 oid))
(optional ~label:"publicKey" (explicit 1 bit_string))
let ec_of_str, ec_to_str =
Asn_grammars.project_exn ec_private_key
let reparse_ec_private curve priv =
let open Mirage_crypto_ec in
match curve with
| `SECP256R1 -> let* p = P256.Dsa.priv_of_octets priv in Ok (`P256 p)
| `SECP384R1 -> let* p = P384.Dsa.priv_of_octets priv in Ok (`P384 p)
| `SECP521R1 -> let* p = P521.Dsa.priv_of_octets priv in Ok (`P521 p)
(* external use (result) *)
let ec_priv_of_str =
let dec, _ = Asn_grammars.projections_of Asn.der ec_private_key in
fun cs ->
let* priv, curve, _pub = dec cs in
match curve with
| None -> Error (`Parse "no curve provided")
| Some c ->
Result.map_error
(fun e -> `Parse (Fmt.to_to_string Mirage_crypto_ec.pp_error e))
(reparse_ec_private c priv)
let ec_of_str ?curve cs =
let (priv, named_curve, _pub) = ec_of_str cs in
let nc =
match curve, named_curve with
| Some c, None -> c
| None, Some c -> c
| Some c, Some c' -> if c = c' then c else parse_error "conflicting curve"
| None, None -> parse_error "unknown curve"
in
ec_to_err (reparse_ec_private nc priv)
let ec_to_str ?curve ?pub key = ec_to_str (key, curve, pub)
let reparse_private pk =
match pk with
| (0, Algorithm.RSA, cs) -> `RSA (rsa_priv_of_str cs)
| (0, Algorithm.ED25519, cs) ->
let data = ed25519_of_str cs in
`ED25519 (ec_to_err (Mirage_crypto_ec.Ed25519.priv_of_octets data))
| (0, Algorithm.EC_pub curve, cs) -> ec_of_str ~curve cs
| _ -> parse_error "unknown private key info"
let unparse_private p =
let open Mirage_crypto_ec in
let open Algorithm in
let alg, cs =
match p with
| `RSA pk -> RSA, rsa_priv_to_str pk
| `ED25519 pk -> ED25519, ed25519_to_str (Ed25519.priv_to_octets pk)
| `P256 pk -> EC_pub `SECP256R1, ec_to_str (P256.Dsa.priv_to_octets pk)
| `P384 pk -> EC_pub `SECP384R1, ec_to_str (P384.Dsa.priv_to_octets pk)
| `P521 pk -> EC_pub `SECP521R1, ec_to_str (P521.Dsa.priv_to_octets pk)
in
(0, alg, cs)
let private_key_info =
map reparse_private unparse_private @@
sequence3
(required ~label:"version" int)
(required ~label:"privateKeyAlgorithm" Algorithm.identifier)
(required ~label:"privateKey" octet_string)
(* TODO: there's an
(optional ~label:"attributes" @@ implicit 0 (SET of Attributes)
which are defined in X.501; but nobody seems to use them anyways *)
let (private_of_octets, private_to_octets) =
Asn_grammars.projections_of Asn.der private_key_info
end
let decode_der cs =
Asn_grammars.err_to_msg (Asn.private_of_octets cs)
let encode_der = Asn.private_to_octets
let decode_pem cs =
let* data = Pem.parse cs in
let rsa_p (t, _) = String.equal "RSA PRIVATE KEY" t
and ec_p (t, _) = String.equal "EC PRIVATE KEY" t
and pk_p (t, _) = String.equal "PRIVATE KEY" t
in
let r, _ = List.partition rsa_p data
and ec, _ = List.partition ec_p data
and p, _ = List.partition pk_p data
in
let* k =
Pem.foldM (fun (_, k) ->
let* k = Asn_grammars.err_to_msg (Asn.rsa_private_of_octets k) in
Ok (`RSA k)) r
in
let* k' =
Pem.foldM (fun (_, k) ->
Asn_grammars.err_to_msg (Asn.ec_priv_of_str k)) ec
in
let* k'' =
Pem.foldM (fun (_, k) ->
Asn_grammars.err_to_msg (Asn.private_of_octets k)) p
in
Pem.exactly_one ~what:"private key" (k @ k' @ k'')
let encode_pem p =
Pem.unparse ~tag:"PRIVATE KEY" (Asn.private_to_octets p)

166
unikernel/duniverse/ocaml-x509/lib/public_key.ml Normal file
View file

@ -0,0 +1,166 @@
let ( let* ) = Result.bind
type ecdsa = [
| `P256 of Mirage_crypto_ec.P256.Dsa.pub
| `P384 of Mirage_crypto_ec.P384.Dsa.pub
| `P521 of Mirage_crypto_ec.P521.Dsa.pub
]
type t = [
| ecdsa
| `RSA of Mirage_crypto_pk.Rsa.pub
| `ED25519 of Mirage_crypto_ec.Ed25519.pub
]
module Asn_oid = Asn.OID
module Asn = struct
open Asn_grammars
open Asn.S
open Mirage_crypto_pk
let rsa_public_key =
let f (n, e) =
let n = Z_extra.of_octets_be n
and e = Z_extra.of_octets_be e in
match Rsa.pub ~e ~n with
| Ok p -> p
| Error (`Msg m) -> parse_error "bad RSA public key %s" m
and g ({ Rsa.n; e } : Rsa.pub) = (Z_extra.to_octets_be n, Z_extra.to_octets_be e) in
map f g @@
sequence2
(required ~label:"modulus" unsigned_integer)
(required ~label:"publicExponent" unsigned_integer)
let (rsa_public_of_octets, rsa_public_to_octets) =
projections_of Asn.der rsa_public_key
let rsa_pub_of_octets, rsa_pub_to_octets = project_exn rsa_public_key
let to_err = function
| Ok r -> r
| Error e ->
parse_error "failed to decode public EC key %a"
Mirage_crypto_ec.pp_error e
let reparse_pk =
let open Mirage_crypto_ec in
let open Algorithm in
function
| (RSA , cs) -> `RSA (rsa_pub_of_octets cs)
| (ED25519 , cs) -> `ED25519 (to_err (Ed25519.pub_of_octets cs))
| (EC_pub `SECP256R1, cs) -> `P256 (to_err (P256.Dsa.pub_of_octets cs))
| (EC_pub `SECP384R1, cs) -> `P384 (to_err (P384.Dsa.pub_of_octets cs))
| (EC_pub `SECP521R1, cs) -> `P521 (to_err (P521.Dsa.pub_of_octets cs))
| _ -> parse_error "unknown public key algorithm"
let unparse_pk =
let open Mirage_crypto_ec in
let open Algorithm in
function
| `RSA pk -> (RSA, rsa_pub_to_octets pk)
| `ED25519 pk -> (ED25519, Ed25519.pub_to_octets pk)
| `P256 pk -> (EC_pub `SECP256R1, P256.Dsa.pub_to_octets pk)
| `P384 pk -> (EC_pub `SECP384R1, P384.Dsa.pub_to_octets pk)
| `P521 pk -> (EC_pub `SECP521R1, P521.Dsa.pub_to_octets pk)
let pk_info_der =
map reparse_pk unparse_pk @@
sequence2
(required ~label:"algorithm" Algorithm.identifier)
(required ~label:"subjectPK" bit_string_octets)
let (pub_info_of_octets, pub_info_to_octets) =
projections_of Asn.der pk_info_der
end
let id k =
let data = match k with
| `RSA p -> Asn.rsa_public_to_octets p
| `ED25519 pk -> Mirage_crypto_ec.Ed25519.pub_to_octets pk
| `P256 pk -> Mirage_crypto_ec.P256.Dsa.pub_to_octets pk
| `P384 pk -> Mirage_crypto_ec.P384.Dsa.pub_to_octets pk
| `P521 pk -> Mirage_crypto_ec.P521.Dsa.pub_to_octets pk
in
Digestif.(to_raw_string SHA1 (digest_string SHA1 data))
let fingerprint ?(hash = `SHA256) pub =
let module Hash = (val (Digestif.module_of_hash' (hash :> Digestif.hash'))) in
Hash.(to_raw_string (digest_string (Asn.pub_info_to_octets pub)))
let key_type = function
| `RSA _ -> `RSA
| `ED25519 _ -> `ED25519
| `P256 _ -> `P256
| `P384 _ -> `P384
| `P521 _ -> `P521
let sig_alg = function
| #ecdsa -> `ECDSA
| `RSA _ -> `RSA
| `ED25519 _ -> `ED25519
let pp ppf k =
Fmt.string ppf (Key_type.to_string (key_type k));
Fmt.sp ppf ();
Ohex.pp ppf (fingerprint k)
let hashed hash data =
let module Hash = (val (Digestif.module_of_hash' hash)) in
match data with
| `Message msg -> Ok Hash.(to_raw_string (digest_string msg))
| `Digest d ->
let n = String.length d and m = Hash.digest_size in
if n = m then Ok d else Error (`Msg "digested data of invalid size")
let trunc len data =
if String.length data > len then
String.sub data 0 len
else
data
let verify hash ?scheme ~signature key data =
let open Mirage_crypto_ec in
let ok_if_true p = if p then Ok () else Error (`Msg "bad signature") in
let ecdsa_of_str cs =
Result.map_error (function `Parse s -> `Msg s)
(Algorithm.ecdsa_sig_of_octets cs)
in
let scheme = Key_type.opt_signature_scheme ?scheme (key_type key) in
match key, scheme with
| `RSA key, `RSA_PSS ->
let module H = (val (Digestif.module_of_hash' hash)) in
let module PSS = Mirage_crypto_pk.Rsa.PSS(H) in
let* d = hashed hash data in
ok_if_true (PSS.verify ~key ~signature (`Digest d))
| `RSA key, `RSA_PKCS1 ->
let hashp x = x = hash in
let* d = hashed hash data in
ok_if_true (Mirage_crypto_pk.Rsa.PKCS1.verify ~hashp ~key ~signature (`Digest d))
| `ED25519 key, `ED25519 ->
begin match data with
| `Message msg -> ok_if_true (Ed25519.verify ~key signature ~msg)
| `Digest _ -> Error (`Msg "Ed25519 only suitable with raw message")
end
| #ecdsa as key, `ECDSA ->
let* d = hashed hash data in
let* s = ecdsa_of_str signature in
ok_if_true
(match key with
| `P256 key -> P256.Dsa.verify ~key s (trunc P256.Dsa.byte_length d)
| `P384 key -> P384.Dsa.verify ~key s (trunc P384.Dsa.byte_length d)
| `P521 key -> P521.Dsa.verify ~key s (trunc P521.Dsa.byte_length d))
| _ -> Error (`Msg "invalid key and signature scheme combination")
let encode_der = Asn.pub_info_to_octets
let decode_der cs = Asn_grammars.err_to_msg (Asn.pub_info_of_octets cs)
let decode_pem cs =
let* data = Pem.parse cs in
let pks = List.filter (fun (t, _) -> String.equal "PUBLIC KEY" t) data in
let* keys = Pem.foldM (fun (_, k) -> decode_der k) pks in
Pem.exactly_one ~what:"public key" keys
let encode_pem v =
Pem.unparse ~tag:"PUBLIC KEY" (encode_der v)

175
unikernel/duniverse/ocaml-x509/lib/rc2.ml Normal file
View file

@ -0,0 +1,175 @@
let pitable = [|
0xd9; 0x78; 0xf9; 0xc4; 0x19; 0xdd; 0xb5; 0xed; 0x28; 0xe9; 0xfd; 0x79; 0x4a; 0xa0; 0xd8; 0x9d;
0xc6; 0x7e; 0x37; 0x83; 0x2b; 0x76; 0x53; 0x8e; 0x62; 0x4c; 0x64; 0x88; 0x44; 0x8b; 0xfb; 0xa2;
0x17; 0x9a; 0x59; 0xf5; 0x87; 0xb3; 0x4f; 0x13; 0x61; 0x45; 0x6d; 0x8d; 0x09; 0x81; 0x7d; 0x32;
0xbd; 0x8f; 0x40; 0xeb; 0x86; 0xb7; 0x7b; 0x0b; 0xf0; 0x95; 0x21; 0x22; 0x5c; 0x6b; 0x4e; 0x82;
0x54; 0xd6; 0x65; 0x93; 0xce; 0x60; 0xb2; 0x1c; 0x73; 0x56; 0xc0; 0x14; 0xa7; 0x8c; 0xf1; 0xdc;
0x12; 0x75; 0xca; 0x1f; 0x3b; 0xbe; 0xe4; 0xd1; 0x42; 0x3d; 0xd4; 0x30; 0xa3; 0x3c; 0xb6; 0x26;
0x6f; 0xbf; 0x0e; 0xda; 0x46; 0x69; 0x07; 0x57; 0x27; 0xf2; 0x1d; 0x9b; 0xbc; 0x94; 0x43; 0x03;
0xf8; 0x11; 0xc7; 0xf6; 0x90; 0xef; 0x3e; 0xe7; 0x06; 0xc3; 0xd5; 0x2f; 0xc8; 0x66; 0x1e; 0xd7;
0x08; 0xe8; 0xea; 0xde; 0x80; 0x52; 0xee; 0xf7; 0x84; 0xaa; 0x72; 0xac; 0x35; 0x4d; 0x6a; 0x2a;
0x96; 0x1a; 0xd2; 0x71; 0x5a; 0x15; 0x49; 0x74; 0x4b; 0x9f; 0xd0; 0x5e; 0x04; 0x18; 0xa4; 0xec;
0xc2; 0xe0; 0x41; 0x6e; 0x0f; 0x51; 0xcb; 0xcc; 0x24; 0x91; 0xaf; 0x50; 0xa1; 0xf4; 0x70; 0x39;
0x99; 0x7c; 0x3a; 0x85; 0x23; 0xb8; 0xb4; 0x7a; 0xfc; 0x02; 0x36; 0x5b; 0x25; 0x55; 0x97; 0x31;
0x2d; 0x5d; 0xfa; 0x98; 0xe3; 0x8a; 0x92; 0xae; 0x05; 0xdf; 0x29; 0x10; 0x67; 0x6c; 0xba; 0xc9;
0xd3; 0x00; 0xe6; 0xcf; 0xe1; 0x9e; 0xa8; 0x2c; 0x63; 0x16; 0x01; 0x3f; 0x58; 0xe2; 0x89; 0xa9;
0x0d; 0x38; 0x34; 0x1b; 0xab; 0x33; 0xff; 0xb0; 0xbb; 0x48; 0x0c; 0x5f; 0xb9; 0xb1; 0xcd; 0x2e;
0xc5; 0xf3; 0xdb; 0x47; 0xe5; 0xa5; 0x9c; 0x77; 0x0a; 0xa6; 0x20; 0x68; 0xfe; 0x7f; 0xc1; 0xad
|]
(* effective is sometimes named t1 *)
let tm effective =
let t8 = (effective + 7) / 8 in
(* RFC says (TM = 255 MOD 2^(8 + effective - 8*T8)) *)
let bits = 8 + effective - 8 * t8 in
(* likely there's a smarter way to do this *)
let rec c acc = function
| 0 -> acc
| n -> c ((acc lsl 1) + 1) (pred n)
in
t8, c 0 bits
(* L[i] is the i-th byte of the key; K[i] is the i-th 16-bit-word of the key *)
let key_expansion effective key =
(* result is a 128 byte key, where we need the words.. *)
let t = String.length key in
let l = Array.init 128 (fun idx -> if idx < t then String.get_uint8 key idx else 0) in
let t8, tm = tm effective in
for i = t to 127 do
l.(i) <- pitable.((l.(i - 1) + l.(i - t)) mod 256)
done;
l.(128 - t8) <- pitable.(l.(128 - t8) land tm);
for i = 127 - t8 downto 0 do
l.(i) <- pitable.(l.(i + 1) lxor l.(i + t8));
done;
Array.init 64 (fun idx -> l.(2 * idx) + 256 * l.(2 * idx + 1))
let mod16 f = 0xFFFF land f
let rol16 x k = mod16 ((x lsl k) lor (x lsr (16 - k)))
let ror16 x k = mod16 ((x lsr k) lor (x lsl (16 - k)))
let not16 x = mod16 (lnot x)
let s = Array.init 4 (function 0 -> 1 | 1 -> 2 | 2 -> 3 | 3 -> 5 | _ -> assert false)
let pmod a =
let b = 4 in
let r = a mod b in
if r < 0 then (r + b) mod b else r
(* only used for encryption which we don't support
let mix r i k j =
r.(i) <- mod16 (r.(i) + k.(j) + r.(pmod (i - 1)) land r.(pmod (i - 2)) +
(not16 r.(pmod (i - 1))) land r.(pmod (i - 3)));
let j = succ j in
r.(i) <- rol16 r.(i) s.(i);
j
let mix_round r k j =
let j' = mix r 0 k j in
let j'' = mix r 1 k j' in
let j''' = mix r 2 k j'' in
let j'''' = mix r 3 k j''' in
j''''
let mash r i k =
r.(i) <- mod16 (r.(i) + k.(r.(pmod (i - 1)) land 63))
let mash_round r k =
mash r 0 k;
mash r 1 k;
mash r 2 k;
mash r 3 k
let encrypt_one ~key ~data =
let r = Array.init 4 (fun idx -> Cstruct.LE.get_uint16 data (idx * 2)) in
let j = 0 in
let j = mix_round r key j in
let j = mix_round r key j in
let j = mix_round r key j in
let j = mix_round r key j in
let j = mix_round r key j in
mash_round r key;
let j = mix_round r key j in
let j = mix_round r key j in
let j = mix_round r key j in
let j = mix_round r key j in
let j = mix_round r key j in
let j = mix_round r key j in
mash_round r key;
let j = mix_round r key j in
let j = mix_round r key j in
let j = mix_round r key j in
let j = mix_round r key j in
let _j = mix_round r key j in
let out = Cstruct.create 8 in
Cstruct.LE.set_uint16 out 0 r.(0);
Cstruct.LE.set_uint16 out 2 r.(1);
Cstruct.LE.set_uint16 out 4 r.(2);
Cstruct.LE.set_uint16 out 6 r.(3);
out
*)
let r_mix r i k j =
r.(i) <- ror16 r.(i) s.(i);
r.(i) <- mod16 (r.(i) - k.(j) -
(r.(pmod (i - 1)) land r.(pmod (i - 2))) -
(not16 r.(pmod (i - 1)) land (r.(pmod (i - 3)))));
pred j
let r_mix_round r k j =
let j' = r_mix r 3 k j in
let j'' = r_mix r 2 k j' in
let j''' = r_mix r 1 k j'' in
let j'''' = r_mix r 0 k j''' in
j''''
let r_mash r i k =
r.(i) <- mod16 (r.(i) - k.(r.(pmod (i - 1)) land 63))
let r_mash_round r k =
r_mash r 3 k;
r_mash r 2 k;
r_mash r 1 k;
r_mash r 0 k
let decrypt_one ~key ~data ?(off = 0) dst =
let r = Array.init 4 (fun idx -> String.get_uint16_le data (off + idx * 2)) in
let j = 63 in
let j = r_mix_round r key j in
let j = r_mix_round r key j in
let j = r_mix_round r key j in
let j = r_mix_round r key j in
let j = r_mix_round r key j in
r_mash_round r key;
let j = r_mix_round r key j in
let j = r_mix_round r key j in
let j = r_mix_round r key j in
let j = r_mix_round r key j in
let j = r_mix_round r key j in
let j = r_mix_round r key j in
r_mash_round r key;
let j = r_mix_round r key j in
let j = r_mix_round r key j in
let j = r_mix_round r key j in
let j = r_mix_round r key j in
let _j = r_mix_round r key j in
Bytes.set_uint16_le dst (off + 0) r.(0);
Bytes.set_uint16_le dst (off + 2) r.(1);
Bytes.set_uint16_le dst (off + 4) r.(2);
Bytes.set_uint16_le dst (off + 6) r.(3)
let decrypt_cbc ?(effective = 128) ~key ~iv data =
let block = 8 in
let key = key_expansion effective key in
let l = String.length data in
let dst = Bytes.create l in
for i = 0 to pred ((l + pred block) / block) do
decrypt_one ~key ~data ~off:(i * block) dst
done;
Mirage_crypto.Uncommon.unsafe_xor_into iv ~src_off:0 dst ~dst_off:0 block;
Mirage_crypto.Uncommon.unsafe_xor_into data ~src_off:0 dst ~dst_off:block (l - block);
Bytes.unsafe_to_string dst

320
unikernel/duniverse/ocaml-x509/lib/registry.ml Normal file
View file

@ -0,0 +1,320 @@
(*
* Object Identifiers: magic numbers with a tie. Some OIDs also have an MBA.
*
* http://www.alvestrand.no/objectid/
* http://oid-info.com/
*)
open Asn.OID
let pkix = base 1 3 <| 6 <| 1 <| 5 <| 5 <| 7
let usa = base 1 2 <| 840
let rsadsi = usa <| 113549
let pkcs = rsadsi <| 1
let us_govt = base 2 16 <| 840 <| 1 <| 101
let nist_alg = us_govt <| 3 <| 4
let hash_algs = nist_alg <| 2
(* PKCS1 *)
and md5 = rsadsi <| 2 <| 5
and sha1 = base 1 3 <| 14 <| 3 <| 2 <| 26
and sha1_rsa_encryption = base 1 3 <| 14 <| 3 <| 2 <| 29
(* rfc5758 *)
let sha256 = hash_algs <| 1
and sha384 = hash_algs <| 2
and sha512 = hash_algs <| 3
and sha224 = hash_algs <| 4
module ANSI_X9_62 = struct
let ansi_x9_62 = usa <| 10045
let ecdsa_sha1 = ansi_x9_62 <| 1
let prime_field = ecdsa_sha1 <| 1
and characteristic_2_field = ecdsa_sha1 <| 2
let key_type = ansi_x9_62 <| 2
let ec_pub_key = key_type <| 1
let signatures = ansi_x9_62 <| 4
let field_type = signatures <| 1
and ecdsa_sha2 = signatures <| 3
let ecdsa_sha224 = ecdsa_sha2 <| 1
and ecdsa_sha256 = ecdsa_sha2 <| 2
and ecdsa_sha384 = ecdsa_sha2 <| 3
and ecdsa_sha512 = ecdsa_sha2 <| 4
(* from RFC 5480 *)
let certicom = base 1 3 <| 132 <| 0
let curves = ansi_x9_62 <| 3 <| 1
let secp224r1 = certicom <| 33
let secp256r1 = curves <| 7
let secp384r1 = certicom <| 34
let secp521r1 = certicom <| 35
end
module PKCS1 = struct
let pkcs1 = pkcs <| 1
let rsa_encryption = pkcs1 <| 1
and md5_rsa_encryption = pkcs1 <| 4
and sha1_rsa_encryption = pkcs1 <| 5
and rsaes_oaep = pkcs1 <| 7
and rsassa_pss = pkcs1 <| 10
and sha256_rsa_encryption = pkcs1 <| 11
and sha384_rsa_encryption = pkcs1 <| 12
and sha512_rsa_encryption = pkcs1 <| 13
and sha224_rsa_encryption = pkcs1 <| 14
end
module RFC8410 = struct
let thawte = base 1 3 <| 101
let x25519 = thawte <| 110
and x448 = thawte <| 111
and ed25519 = thawte <| 112
and ed448 = thawte <| 113
end
module PKCS2 = struct
let pkcs2 = rsadsi <| 2
let md4 = pkcs2 <| 4
and hmac_sha1 = pkcs2 <| 7
and hmac_sha224 = pkcs2 <| 8
and hmac_sha256 = pkcs2 <| 9
and hmac_sha384 = pkcs2 <| 10
and hmac_sha512 = pkcs2 <| 11
end
module PKCS5 = struct
let pkcs5 = pkcs <| 5
let pbe_md2_des_cbc = pkcs5 <| 1
and pbe_md5_des_cbc = pkcs5 <| 3
and pbe_md2_rc2_cbc = pkcs5 <| 4
and pbe_md5_rc2_cbc = pkcs5 <| 6
and pbe_md5_xor = pkcs5 <| 9
and pbe_sha1_des_cbc = pkcs5 <| 10
and pbe_sha1_rc2_cbc = pkcs5 <| 11
and pbkdf2 = pkcs5 <| 12
and pbes2 = pkcs5 <| 13
and pbmac1 = pkcs5 <| 14
let aes = nist_alg <| 1
let aes128_cbc = aes <| 2
and aes192_cbc = aes <| 22
and aes256_cbc = aes <| 42
end
module PKCS7 = struct
let pkcs7 = pkcs <| 7
let data = pkcs7 <| 1
and signed_data = pkcs7 <| 2
and enveloped_data = pkcs7 <| 3
and signed_and_enveloped_data = pkcs7 <| 4
and digested_data = pkcs7 <| 5
and encrypted_data = pkcs7 <| 6
end
module PKCS9 = struct
let pkcs9 = pkcs <| 9
let email = pkcs9 <| 1
and unstructured_name = pkcs9 <| 2
and content_type = pkcs9 <| 3
and message_digest = pkcs9 <| 4
and signing_time = pkcs9 <| 5
and challenge_password = pkcs9 <| 7
and unstructured_address = pkcs9 <| 8
and signing_description = pkcs9 <| 13
and extension_request = pkcs9 <| 14
and smime_capabilities = pkcs9 <| 15
and smime_oid_registry = pkcs9 <| 16
and friendly_name = pkcs9 <| 20
and local_key_id = pkcs9 <| 21
and cert_types = pkcs9 <| 22
and crl_types = pkcs9 <| 23
end
module PKCS12 = struct
let pkcs12 = pkcs <| 12
let bagtypes = pkcs12 <| 10 <| 1
let key_bag = bagtypes <| 1
and pkcs8_shrouded_key_bag = bagtypes <| 2
and cert_bag = bagtypes <| 3
and crl_bag = bagtypes <| 4
and secret_bag = bagtypes <| 5
and safe_contents_bag = bagtypes <| 6
let pbe_ids = pkcs12 <| 1
let pbe_with_SHA_and_128Bit_RC4 = pbe_ids <| 1
and pbe_with_SHA_and_40Bit_RC4 = pbe_ids <| 2
and pbe_with_SHA_and_3_KeyTripleDES_CBC = pbe_ids <| 3
and pbe_with_SHA_and_2_KeyTripleDES_CBC = pbe_ids <| 4
and pbe_with_SHA_and_128Bit_RC2_CBC = pbe_ids <| 5
and pbe_with_SHA_and_40Bit_RC2_CBC = pbe_ids <| 6
end
module X520 = struct
let x520 = base 2 5 <| 4
let object_class = x520 <| 0
and aliased_entry_name = x520 <| 1
and knowldgeinformation = x520 <| 2
and common_name = x520 <| 3
and surname = x520 <| 4
and serial_number = x520 <| 5
and country_name = x520 <| 6
and locality_name = x520 <| 7
and state_or_province_name = x520 <| 8
and street_address = x520 <| 9
and organization_name = x520 <| 10
and organizational_unit_name = x520 <| 11
and title = x520 <| 12
and description = x520 <| 13
and search_guide = x520 <| 14
and business_category = x520 <| 15
and postal_address = x520 <| 16
and postal_code = x520 <| 17
and post_office_box = x520 <| 18
and physical_delivery_office_name = x520 <| 19
and telephone_number = x520 <| 20
and telex_number = x520 <| 21
and teletex_terminal_identifier = x520 <| 22
and facsimile_telephone_number = x520 <| 23
and x121_address = x520 <| 24
and internationa_isdn_number = x520 <| 25
and registered_address = x520 <| 26
and destination_indicator = x520 <| 27
and preferred_delivery_method = x520 <| 28
and presentation_address = x520 <| 29
and supported_application_context = x520 <| 30
and member = x520 <| 31
and owner = x520 <| 32
and role_occupant = x520 <| 33
and see_also = x520 <| 34
and user_password = x520 <| 35
and user_certificate = x520 <| 36
and ca_certificate = x520 <| 37
and authority_revocation_list = x520 <| 38
and certificate_revocation_list = x520 <| 39
and cross_certificate_pair = x520 <| 40
and name = x520 <| 41
and given_name = x520 <| 42
and initials = x520 <| 43
and generation_qualifier = x520 <| 44
and unique_identifier = x520 <| 45
and dn_qualifier = x520 <| 46
and enhanced_search_guide = x520 <| 47
and protocol_information = x520 <| 48
and distinguished_name = x520 <| 49
and unique_member = x520 <| 50
and house_identifier = x520 <| 51
and supported_algorithms = x520 <| 52
and delta_revocation_list = x520 <| 53
and attribute_certificate = x520 <| 58
and pseudonym = x520 <| 65
end
let ucl_data_networks = base 0 9 <| 2342 <| 19200300
let directory_pilot = ucl_data_networks <| 100 <| 1
(* The single rfc4519 oid rfc5280 requires us to be aware of.... *)
let domain_component = directory_pilot <| 25
(* rfc4514 oid required for compliance *)
let userid = directory_pilot <| 1
module Cert_extn = struct
let ce = base 2 5 <| 29
let authority_key_identifier_old = ce <| 1
and primary_key_attributes_old = ce <| 2
and certificate_policies_1 = ce <| 3
and primary_key_usage_restriction = ce <| 4
and subject_directory_attributes = ce <| 9
and subject_key_identifier = ce <| 14
and key_usage = ce <| 15
and private_key_usage_period = ce <| 16
and subject_alternative_name = ce <| 17
and issuer_alternative_name = ce <| 18
and basic_constraints = ce <| 19
and crl_number = ce <| 20
and reason_code = ce <| 21
and hold_instruction_code = ce <| 23
and invalidity_date = ce <| 24
and delta_crl_indicator = ce <| 27
and issuing_distribution_point = ce <| 28
and certificate_issuer = ce <| 29
and name_constraints = ce <| 30
and crl_distribution_points = ce <| 31
and certificate_policies_2 = ce <| 32
and policy_mappings = ce <| 33
and authority_key_identifier = ce <| 35
and policy_constraints = ce <| 36
and extended_key_usage = ce <| 37
and freshest_crl = ce <| 46
and inhibit_any_policy = ce <| 54
(* https://tools.ietf.org/html/rfc5280#section-4.2.2.1 *)
module Private_internet_extensions = struct
let pe = pkix <| 1
let authority_info_access = pe <| 1
let ad = pkix <| 48
let ad_ca_issuer = ad <| 2
let ad_ocsp = ad <| 1
let ad_ocsp_basic = ad_ocsp <| 1
end
module Extended_usage = struct
let any = extended_key_usage <| 0
let key_purpose = pkix <| 3
let server_auth = key_purpose <| 1
and client_auth = key_purpose <| 2
and code_signing = key_purpose <| 3
and email_protection = key_purpose <| 4
and ipsec_end_system = key_purpose <| 5
and ipsec_tunnel = key_purpose <| 6
and ipsec_user = key_purpose <| 7
and time_stamping = key_purpose <| 8
and ocsp_signing = key_purpose <| 9
end
module Cert_policy = struct
let qt = pkix <| 2
let cps = qt <| 1
let unotice = qt <| 2
let any_policy = certificate_policies_2 <| 0
end
end
module Name_extn = struct
(* For the rarely-used feature of GeneralName: AnotherName. *)
let id_other_name = pkix <| 8
(* rfc6120 *)
let xmpp_addr = id_other_name <| 5
(* rfc4985 *)
let srv_name = id_other_name <| 7 (* an IA5String _Service.Name *)
let venezuela = base 2 16 <| 862
let venezuela_1 = venezuela <| 2 <| 1
and venezuela_2 = venezuela <| 2 <| 2
let is_utf8_id oid =
List.mem oid [ xmpp_addr ; venezuela_1 ; venezuela_2 ]
end

238
unikernel/duniverse/ocaml-x509/lib/signing_request.ml Normal file
View file

@ -0,0 +1,238 @@
let ( let* ) = Result.bind
module Ext = struct
type _ k =
| Password : string k
| Name : string k
| Extensions : Extension.t k
module K = struct
type 'a t = 'a k
let compare : type a b . a t -> b t -> (a, b) Gmap.Order.t = fun t t' ->
let open Gmap.Order in
match t, t' with
| Password, Password -> Eq | Password, _ -> Lt | _, Password -> Gt
| Name, Name -> Eq | Name, _ -> Lt | _, Name -> Gt
| Extensions, Extensions -> Eq
end
include Gmap.Make(K)
let pp_one : type a. a k -> Format.formatter -> a -> unit = fun k ppf v ->
match k, v with
| Password, pass -> Fmt.pf ppf "password %s" pass
| Name, name -> Fmt.pf ppf "name %s" name
| Extensions, ext -> Fmt.pf ppf "extensions %a" Extension.pp ext
let pp ppf m = iter (fun (B (k, v)) -> pp_one k ppf v ; Fmt.sp ppf ()) m
end
type request_info = {
subject : Distinguished_name.t ;
public_key : Public_key.t ;
extensions : Ext.t ;
}
type request = {
info : request_info ;
signature_algorithm : Algorithm.t ;
signature : string
}
type t = {
asn : request ;
raw : string ;
}
module Asn = struct
open Asn_grammars
open Asn.S
open Registry
let attributes =
let f = function[@ocaml.warning "-8"]
| (oid, [`C1 p]) when oid = PKCS9.challenge_password -> Ext.B (Password, p)
| (oid, [`C1 n]) when oid = PKCS9.unstructured_name -> Ext.B (Name, n)
| (oid, [`C2 es]) when oid = PKCS9.extension_request -> Ext.B (Extensions, es)
and g (Ext.B (k, v)) : Asn.oid * [ `C1 of string | `C2 of Extension.t ] list = match k, v with
| Ext.Password, v -> (PKCS9.challenge_password, [`C1 v])
| Ext.Name, v -> (PKCS9.unstructured_name, [`C1 v])
| Ext.Extensions, v -> (PKCS9.extension_request, [`C2 v])
in
map f g @@
sequence2
(required ~label:"attr type" oid)
(required ~label:"attr value"
(set_of (choice2
utf8_string
Extension.Asn.extensions_der)))
let request_info =
let f = function
| (0, subject, public_key, extensions) ->
let extensions =
List.fold_left (fun map (Ext.B (k, v)) ->
match Ext.add_unless_bound k v map with
| None -> parse_error "request extension %a already bound"
(Ext.pp_one k) v
| Some b -> b)
Ext.empty extensions
in
{ subject ; public_key ; extensions }
| _ ->
parse_error "unknown certificate request info"
and g { subject ; public_key ; extensions } =
let extensions = Ext.bindings extensions in
(0, subject, public_key, extensions)
in
map f g @@
sequence4
(required ~label:"version" int)
(required ~label:"subject" Distinguished_name.Asn.name)
(required ~label:"subjectPKInfo" Public_key.Asn.pk_info_der)
(required ~label:"attributes" @@ implicit 0 (set_of attributes))
let request_info_of_str, request_info_to_str =
projections_of Asn.der request_info
let signing_request =
let f = fun (info, signature_algorithm, signature) ->
{ info ; signature_algorithm ; signature }
and g = fun { info ; signature_algorithm ; signature } ->
(info, signature_algorithm, signature)
in
map f g @@
sequence3
(required ~label:"certificationRequestInfo" request_info)
(required ~label:"signatureAlgorithm" Algorithm.identifier)
(required ~label:"signature" bit_string_octets)
let signing_request_of_str, signing_request_to_str =
projections_of Asn.der signing_request
end
let info { asn ; _ } = asn.info
let signature_algorithm { asn ; _ } =
Algorithm.to_signature_algorithm asn.signature_algorithm
let hostnames csr =
let info = info csr in
let subj =
match Distinguished_name.common_name info.subject with
| None -> Host.Set.empty
| Some x ->
match Host.host x with
| Some (typ, n) -> Host.Set.singleton (typ, n)
| None -> Host.Set.empty
in
match Ext.(find Extensions info.extensions) with
| None -> subj
| Some exts -> match Extension.hostnames exts with
| Some names -> names
| None -> subj
let validate_signature allowed_hashes { asn ; raw } =
let raw_data = Validation.raw_cert_hack raw in
Validation.validate_raw_signature asn.info.subject allowed_hashes raw_data
asn.signature_algorithm asn.signature asn.info.public_key
let decode_der ?(allowed_hashes = Validation.sha2) cs =
let* csr = Asn_grammars.err_to_msg (Asn.signing_request_of_str cs) in
let csr = { raw = cs ; asn = csr } in
let* () =
Result.map_error
(fun e -> `Msg (Fmt.to_to_string Validation.pp_signature_error e))
(validate_signature allowed_hashes csr)
in
Ok csr
let encode_der { raw ; _ } = raw
let decode_pem cs =
let* data = Pem.parse cs in
let crs =
List.filter (fun (t, _) -> String.equal "CERTIFICATE REQUEST" t) data
in
let* csrs = Pem.foldM (fun (_, cs) -> decode_der cs) crs in
Pem.exactly_one ~what:"certificate request" csrs
let encode_pem v =
Pem.unparse ~tag:"CERTIFICATE REQUEST" (encode_der v)
let digest_of_key = function
| `RSA _ -> `SHA256
| `ED25519 _ -> `SHA512
| `P256 _ -> `SHA256
| `P384 _ -> `SHA384
| `P521 _ -> `SHA512
let default_digest digest key =
match digest with None -> digest_of_key key | Some x -> x
let create subject ?digest ?(extensions = Ext.empty) (key : Private_key.t) =
let hash = default_digest digest key in
let public_key = Private_key.public key in
let info : request_info = { subject ; public_key ; extensions } in
let info_str = Asn.request_info_to_str info in
let scheme = Key_type.x509_default_scheme (Private_key.key_type key) in
let* signature = Private_key.sign hash ~scheme key (`Message info_str) in
let signature_algorithm = Algorithm.of_signature_algorithm scheme hash in
let asn = { info ; signature_algorithm ; signature } in
let raw = Asn.signing_request_to_str asn in
Ok { asn ; raw }
let sign signing_request
~valid_from ~valid_until
?(allowed_hashes = Validation.sha2)
?digest
?serial
?(extensions = Extension.empty)
?(subject = signing_request.asn.info.subject)
key issuer =
let hash = default_digest digest key in
let serial = match serial with
| Some s -> s
| None ->
(* we generate a positive integer, asn1-encoded: so if the high bit is
set, we prepend a 0 byte *)
(* if it starts with 0x00 followed by 0xNN with NN <= 0x7f, we prepend
0x7f to make the integer valid *)
let s = Mirage_crypto_rng.generate 10 in
let start = String.get_uint8 s 0 in
if start > 0x7f then
"\x00" ^ s
else if start = 0x00 && String.get_uint8 s 1 <= 0x7f then
"\x7f" ^ s
else
s
in
let* () = validate_signature allowed_hashes signing_request in
let signature_algo =
let scheme = Key_type.x509_default_scheme (Private_key.key_type key) in
Algorithm.of_signature_algorithm scheme hash
and info = signing_request.asn.info
in
let tbs_cert : Certificate.tBSCertificate = {
version = `V3 ;
serial ;
signature = signature_algo ;
issuer = issuer ;
validity = (valid_from, valid_until) ;
subject ;
pk_info = info.public_key ;
issuer_id = None ;
subject_id = None ;
extensions
} in
let tbs_raw = Certificate.Asn.tbs_certificate_to_octets tbs_cert in
let scheme = Key_type.x509_default_scheme (Private_key.key_type key) in
let* signature_val = Private_key.sign hash ~scheme key (`Message tbs_raw) in
let asn = {
Certificate.tbs_cert ;
signature_algo ;
signature_val ;
} in
let raw = Certificate.Asn.certificate_to_octets asn in
Ok { Certificate.asn ; raw }

520
unikernel/duniverse/ocaml-x509/lib/validation.ml Normal file
View file

@ -0,0 +1,520 @@
let ( let* ) = Result.bind
let sha2 = [ `SHA256 ; `SHA384 ; `SHA512 ]
let all_hashes = [ `MD5 ; `SHA1 ; `SHA224 ] @ sha2
let src = Logs.Src.create "x509.validation" ~doc:"X509 validation"
module Log = (val Logs.src_log src : Logs.LOG)
type signature_error = [
| `Bad_signature of Distinguished_name.t * string
| `Bad_encoding of Distinguished_name.t * string * string
| `Hash_not_allowed of Distinguished_name.t * [ `MD5 | `SHA1 | `SHA224 | `SHA256 | `SHA384 | `SHA512 ]
| `Unsupported_keytype of Distinguished_name.t * Public_key.t
| `Unsupported_algorithm of Distinguished_name.t * string
| `Msg of string
]
let pp_signature_error ppf = function
| `Bad_signature (subj, msg) ->
Fmt.pf ppf "failed to verify signature of %a: %s"
Distinguished_name.pp subj msg
| `Bad_encoding (subj, err, sig_) ->
Fmt.pf ppf "bad signature encoding of %a, ASN error %s:@.%a"
Distinguished_name.pp subj err Ohex.pp sig_
| `Hash_not_allowed (subj, hash) ->
Fmt.pf ppf "hash algorithm %a is not allowed, but %a is signed using it"
Certificate.pp_hash hash Distinguished_name.pp subj
| `Unsupported_keytype (subj, pk) ->
Fmt.pf ppf "unsupported key used to sign %a: %a" Distinguished_name.pp subj
Public_key.pp pk
| `Unsupported_algorithm (subj, alg) ->
Fmt.pf ppf "unsupported algorithm used to sign %a: %s"
Distinguished_name.pp subj alg
| `Msg msg -> Fmt.string ppf msg
let maybe_validate_hostname cert = function
| None -> true
| Some x -> Certificate.supports_hostname cert x
let maybe_validate_ip cert = function
| None -> true
| Some ip -> Certificate.supports_ip cert ip
let issuer_matches_subject
{ Certificate.asn = parent ; _ } { Certificate.asn = cert ; _ } =
Distinguished_name.equal parent.tbs_cert.subject cert.tbs_cert.issuer
let is_self_signed cert = issuer_matches_subject cert cert
let validate_raw_signature subject allowed_hashes msg sig_alg signature pk =
match Algorithm.to_signature_algorithm sig_alg with
| Some (scheme, siga) ->
(* we check that siga is a member of allowed_hashes, to ensure not
using a weak one. *)
if not (List.mem siga allowed_hashes) then
Error (`Hash_not_allowed (subject, siga))
else if not (Key_type.supports_signature_scheme (Public_key.key_type pk) scheme) then
Error (`Unsupported_keytype (subject, pk))
else
let* () =
Result.map_error (function `Msg m -> `Bad_signature (subject, m))
(Public_key.verify siga ~scheme ~signature pk (`Message msg))
in
if not (List.mem siga sha2) then
Log.warn (fun m -> m "%a signature uses %a, a weak hash algorithm"
Distinguished_name.pp subject Certificate.pp_hash siga);
Ok ()
| None ->
Error (`Unsupported_algorithm (subject, Algorithm.to_string sig_alg))
let shift str off =
String.sub str off (String.length str - off)
(* XXX should return the tbs_cert blob from the parser, this is insane *)
let raw_cert_hack raw =
(* we only support definite-length *)
let loff = 1 in
let snd = String.get_uint8 raw loff in
let lenl = 2 + if 0x80 land snd = 0 then 0 else 0x7F land snd in
(* cut away the SEQUENCE and LENGTH from outer sequence (tbs, sigalg, sig) *)
let cert_buf = shift raw lenl in
let rec l acc idx last =
if idx = last then
acc
else
l (acc lsl 8 + String.get_uint8 cert_buf idx) (succ idx) last
in
let cert_len_byte = String.get_uint8 cert_buf loff in
let cert_len =
(* two cases: *)
if 0x80 land cert_len_byte = 0 then
(* length < 127: highest bit is zero and lower 7 bits encode the length *)
2 + (0x7F land cert_len_byte)
else
(* length > 127: highest bit is 1 and lower 7 bits encode the bytes used
to encode the length *)
let len_len = 2 + 0x7F land cert_len_byte in
len_len + (l 0 2 len_len)
in
String.sub cert_buf 0 cert_len
let validate_signature allowed_hashes { Certificate.asn = trusted ; _ } { Certificate.asn ; raw } =
let tbs_raw = raw_cert_hack raw in
validate_raw_signature asn.tbs_cert.subject allowed_hashes tbs_raw
asn.signature_algo asn.signature_val trusted.tbs_cert.pk_info
let validate_time time { Certificate.asn = cert ; _ } =
match time with
| None -> true
| Some now ->
let (not_before, not_after) = cert.tbs_cert.validity in
Ptime.(is_later ~than:not_before now && is_earlier ~than:not_after now)
let version_matches_extensions { Certificate.asn = cert ; _ } =
let tbs = cert.tbs_cert in
match tbs.version, Extension.is_empty tbs.extensions with
| (`V1 | `V2), true -> true
| (`V1 | `V2), _ -> false
| `V3, _ -> true
let validate_path_len pathlen { Certificate.asn = cert ; _ } =
(* X509 V1/V2 certificates do not contain X509v3 extensions! *)
(* thus, we cannot check the path length. this will only ever happen for trust anchors: *)
(* intermediate CAs are checked by is_cert_valid, which checks that the CA extensions are there *)
(* whereas trust anchor are ok with getting V1/2 certificates *)
(* TODO: make it configurable whether to accept V1/2 certificates at all *)
let exts = cert.tbs_cert.extensions in
match cert.tbs_cert.version, Extension.(find Basic_constraints exts) with
| (`V1 | `V2), _ -> true
| `V3, Some (_ , (true, None)) -> true
| `V3, Some (_ , (true, Some n)) -> n >= pathlen
| _ -> false
let validate_ca_extensions { Certificate.asn = cert ; _ } =
let exts = cert.tbs_cert.extensions in
(* comments from RFC5280 *)
(* 4.2.1.9 Basic Constraints *)
(* Conforming CAs MUST include this extension in all CA certificates used *)
(* to validate digital signatures on certificates and MUST mark the *)
(* extension as critical in such certificates *)
(* unfortunately, there are 8 CA certs (including the one which
signed google.com) which are _NOT_ marked as critical *)
( match Extension.(find Basic_constraints exts) with
| Some (_ , (true, _)) -> true
| _ -> false ) &&
(* 4.2.1.3 Key Usage *)
(* Conforming CAs MUST include key usage extension *)
(* CA Cert (cacert.org) does not *)
( match Extension.(find Key_usage exts) with
(* When present, conforming CAs SHOULD mark this extension as critical *)
(* yeah, you wish... *)
| Some (_, usage) -> List.mem `Key_cert_sign usage
| _ -> false ) &&
(* if we require this, we cannot talk to github.com
(* 4.2.1.12. Extended Key Usage
If a certificate contains both a key usage extension and an extended
key usage extension, then both extensions MUST be processed
independently and the certificate MUST only be used for a purpose
consistent with both extensions. If there is no purpose consistent
with both extensions, then the certificate MUST NOT be used for any
purpose. *)
( match extn_ext_key_usage cert with
| Some (_, Ext_key_usage usages) -> List.mem Any usages
| _ -> true ) &&
*)
(* Name Constraints - name constraints should match servername *)
(* check criticality *)
Extension.for_all (fun (Extension.B (k, v)) ->
match k with
| Extension.Key_usage -> true
| Extension.Basic_constraints -> true
| _ -> not (Extension.critical k v) )
exts
let validate_server_extensions cert =
Extension.for_all (fun (Extension.B (k, v)) ->
match k, v with
| Extension.Basic_constraints, (_, (true, _)) ->
if is_self_signed cert then
(Log.warn (fun m -> m "allowing self-signed certificate with BasicConstraints CA true");
true)
else
false
| Extension.Basic_constraints, (_, (false, _)) -> true
| Extension.Key_usage, _ -> true
| Extension.Ext_key_usage, _ -> true
| Extension.Subject_alt_name, _ -> true
| Extension.Policies, (crit, ps) -> not crit || List.mem `Any ps
(* we've to deal with _all_ extensions marked critical! *)
| _, _ -> not (Extension.critical k v))
cert.Certificate.asn.tbs_cert.extensions
let valid_trust_anchor_extensions cert =
match cert.Certificate.asn.tbs_cert.version with
| `V1 | `V2 -> true
| `V3 -> validate_ca_extensions cert
let ext_authority_matches_subject trusted cert =
match Extension.(find Authority_key_id (Certificate.extensions cert),
find Subject_key_id (Certificate.extensions trusted))
with
| (_, None) | (None, _) -> true (* not mandatory *)
| Some (_, (Some auth, _, _)), Some (_, au) -> String.equal auth au
(* TODO: check exact rules in RFC5280 *)
| Some (_, (None, _, _)), _ -> true (* not mandatory *)
(* t -> t list (* set *) -> t list list *)
let rec build_paths fst rst =
match
List.filter
(fun x -> Distinguished_name.equal (Certificate.issuer fst) (Certificate.subject x))
rst
with
| [] -> [[fst]]
| xs ->
let tails =
List.fold_left
(fun acc x -> acc @ build_paths x (List.filter (fun y -> x <> y) rst))
[[]]
xs
in
List.map (fun x -> fst :: x) tails
type ca_error = [
| signature_error
| `CAIssuerSubjectMismatch of Certificate.t
| `CAInvalidVersion of Certificate.t
| `CACertificateExpired of Certificate.t * Ptime.t option
| `CAInvalidExtensions of Certificate.t
]
let pp_ca_error ppf = function
| #signature_error as e -> pp_signature_error ppf e
| `CAIssuerSubjectMismatch c ->
Fmt.pf ppf "CA certificate %a: issuer does not match subject" Certificate.pp c
| `CAInvalidVersion c ->
Fmt.pf ppf "CA certificate %a: version 3 is required for extensions" Certificate.pp c
| `CAInvalidExtensions c ->
Fmt.pf ppf "CA certificate %a: invalid CA extensions" Certificate.pp c
| `CACertificateExpired (c, now) ->
let pp_pt = Ptime.pp_human ~tz_offset_s:0 () in
Fmt.pf ppf "CA certificate %a: expired (now %a)" Certificate.pp c
Fmt.(option ~none:(any "no timestamp provided") pp_pt) now
type leaf_validation_error = [
| `LeafCertificateExpired of Certificate.t * Ptime.t option
| `LeafInvalidIP of Certificate.t * Ipaddr.t option
| `LeafInvalidName of Certificate.t * [`host] Domain_name.t option
| `LeafInvalidVersion of Certificate.t
| `LeafInvalidExtensions of Certificate.t
]
let pp_leaf_validation_error ppf = function
| `LeafCertificateExpired (c, now) ->
let pp_pt = Ptime.pp_human ~tz_offset_s:0 () in
Fmt.pf ppf "leaf certificate %a expired (now %a)" Certificate.pp c
Fmt.(option ~none:(any "no timestamp provided") pp_pt) now
| `LeafInvalidIP (c, ip) ->
Fmt.pf ppf "leaf certificate %a does not contain the IP %a (IPs present: %a)String"
Certificate.pp c Fmt.(option ~none:(any "none") Ipaddr.pp) ip
Fmt.(list ~sep:(any ", ") Ipaddr.pp) (Certificate.ips c |> Ipaddr.Set.elements)
| `LeafInvalidName (c, n) ->
Fmt.pf ppf "leaf certificate %a does not contain the name %a"
Certificate.pp c Fmt.(option ~none:(any "none") Domain_name.pp) n
| `LeafInvalidVersion c ->
Fmt.pf ppf "leaf certificate %a: version 3 is required for extensions" Certificate.pp c
| `LeafInvalidExtensions c ->
Fmt.pf ppf "leaf certificate %a: invalid server extensions" Certificate.pp c
type chain_validation_error = [
| `IntermediateInvalidExtensions of Certificate.t
| `IntermediateCertificateExpired of Certificate.t * Ptime.t option
| `IntermediateInvalidVersion of Certificate.t
| `ChainIssuerSubjectMismatch of Certificate.t * Certificate.t
| `ChainAuthorityKeyIdSubjectKeyIdMismatch of Certificate.t * Certificate.t
| `ChainInvalidPathlen of Certificate.t * int
| `EmptyCertificateChain
| `NoTrustAnchor of Certificate.t
| `Revoked of Certificate.t
]
let pp_chain_validation_error ppf = function
| `IntermediateInvalidExtensions c ->
Fmt.pf ppf "intermediate certificate %a: invalid extensions" Certificate.pp c
| `IntermediateCertificateExpired (c, now) ->
let pp_pt = Ptime.pp_human ~tz_offset_s:0 () in
Fmt.pf ppf "intermediate certificate %a expired (now %a)" Certificate.pp c
Fmt.(option ~none:(any "no timestamp provided") pp_pt) now
| `IntermediateInvalidVersion c ->
Fmt.pf ppf "intermediate certificate %a: version 3 is required for extensions"
Certificate.pp c
| `ChainIssuerSubjectMismatch (c, parent) ->
Fmt.pf ppf "invalid chain: issuer of %a does not match subject of %a"
Certificate.pp c Certificate.pp parent
| `ChainAuthorityKeyIdSubjectKeyIdMismatch (c, parent) ->
Fmt.pf ppf "invalid chain: authority key id extension of %a does not match subject key id extension of %a"
Certificate.pp c Certificate.pp parent
| `ChainInvalidPathlen (c, pathlen) ->
Fmt.pf ppf "invalid chain: the path length of %a is smaller than the required path length %d"
Certificate.pp c pathlen
| `EmptyCertificateChain -> Fmt.string ppf "certificate chain is empty"
| `NoTrustAnchor c ->
Fmt.pf ppf "no trust anchor found for %a" Certificate.pp c
| `Revoked c ->
Fmt.pf ppf "certificate %a is revoked" Certificate.pp c
type chain_error = [
| signature_error
| leaf_validation_error
| chain_validation_error
]
let pp_chain_error ppf = function
| #signature_error as e -> pp_signature_error ppf e
| #leaf_validation_error as l -> pp_leaf_validation_error ppf l
| #chain_validation_error as c -> pp_chain_validation_error ppf c
type fingerprint_validation_error = [
| `InvalidFingerprint of Certificate.t * string * string
]
let pp_fingerprint_validation_error ppf = function
| `InvalidFingerprint (c, c_fp, fp) ->
Fmt.pf ppf "fingerprint for %a (computed %a) does not match, expected %a"
Certificate.pp c Ohex.pp c_fp Ohex.pp fp
type validation_error = [
| signature_error
| leaf_validation_error
| fingerprint_validation_error
| `EmptyCertificateChain
| `InvalidChain
]
let pp_validation_error ppf = function
| #signature_error as e -> pp_signature_error ppf e
| #leaf_validation_error as l -> pp_leaf_validation_error ppf l
| #fingerprint_validation_error as f -> pp_fingerprint_validation_error ppf f
| `EmptyCertificateChain ->
Fmt.string ppf "provided certificate chain is empty"
| `InvalidChain -> Fmt.string ppf "invalid certificate chain"
type r = ((Certificate.t list * Certificate.t) option, validation_error) result
(* TODO RFC 5280: A certificate MUST NOT include more than one
instance of a particular extension. *)
let is_cert_valid now cert =
match
validate_time now cert,
version_matches_extensions cert,
validate_ca_extensions cert
with
| (true, true, true) -> Ok ()
| (false, _, _) -> Error (`IntermediateCertificateExpired (cert, now))
| (_, false, _) -> Error (`IntermediateInvalidVersion cert)
| (_, _, false) -> Error (`IntermediateInvalidExtensions cert)
let is_ca_cert_valid allowed_hashes now cert =
match
is_self_signed cert,
version_matches_extensions cert,
validate_signature allowed_hashes cert cert,
validate_time now cert,
valid_trust_anchor_extensions cert
with
| (true, true, Ok (), true, true) -> Ok ()
| (false, _, _, _, _) -> Error (`CAIssuerSubjectMismatch cert)
| (_, false, _, _, _) -> Error (`CAInvalidVersion cert)
| (_, _, Error e, _, _) -> Error e
| (_, _, _, false, _) -> Error (`CACertificateExpired (cert, now))
| (_, _, _, _, false) -> Error (`CAInvalidExtensions cert)
let valid_ca ?(allowed_hashes = all_hashes) ?time cacert =
is_ca_cert_valid allowed_hashes time cacert
let is_server_cert_valid ip host now cert =
match
validate_time now cert,
maybe_validate_ip cert ip,
maybe_validate_hostname cert host,
version_matches_extensions cert,
validate_server_extensions cert
with
| (true, true, true, true, true) -> Ok ()
| (false, _, _, _, _) -> Error (`LeafCertificateExpired (cert, now))
| (_, false, _, _, _) -> Error (`LeafInvalidIP (cert, ip))
| (_, _, false, _, _) -> Error (`LeafInvalidName (cert, host))
| (_, _, _, false, _) -> Error (`LeafInvalidVersion cert)
| (_, _, _, _, false) -> Error (`LeafInvalidExtensions cert)
let signs hash pathlen trusted cert =
match
issuer_matches_subject trusted cert,
ext_authority_matches_subject trusted cert,
validate_signature hash trusted cert,
validate_path_len pathlen trusted
with
| (true, true, Ok (), true) -> Ok ()
| (false, _, _, _) -> Error (`ChainIssuerSubjectMismatch (trusted, cert))
| (_, false, _, _) -> Error (`ChainAuthorityKeyIdSubjectKeyIdMismatch (trusted, cert))
| (_, _, Error e, _) -> Error e
| (_, _, _, false) -> Error (`ChainInvalidPathlen (trusted, pathlen))
let issuer trusted cert =
List.filter (fun p -> issuer_matches_subject p cert) trusted
let rec validate_anchors revoked hash pathlen cert = function
| [] -> Error (`NoTrustAnchor cert)
| x::xs -> match signs hash pathlen x cert with
| Ok _ -> if revoked ~issuer:x ~cert then Error (`Revoked cert) else Ok x
| Error _ -> validate_anchors revoked hash pathlen cert xs
let verify_single_chain now ?(revoked = fun ~issuer:_ ~cert:_ -> false) hash anchors chain =
let rec climb pathlen = function
| cert :: issuer :: certs ->
let* () = is_cert_valid now issuer in
let* () = if revoked ~issuer ~cert then Error (`Revoked cert) else Ok () in
let* () = signs hash pathlen issuer cert in
climb (succ pathlen) (issuer :: certs)
| [c] ->
let anchors = issuer anchors c in
validate_anchors revoked hash pathlen c anchors
| [] -> Error `EmptyCertificateChain
in
climb 0 chain
let verify_chain ?ip ~host ~time ?revoked ?(allowed_hashes = sha2) ~anchors = function
| [] -> Error `EmptyCertificateChain
| server :: certs ->
let now = time () in
let anchors = List.filter (validate_time now) anchors in
let* () = is_server_cert_valid ip host now server in
verify_single_chain now ?revoked allowed_hashes anchors (server :: certs)
let rec any_m e f = function
| [] -> Error e
| c::cs -> match f c with
| Ok ta -> Ok (Some (c, ta))
| Error _ -> any_m e f cs
let verify_chain_of_trust ?ip ~host ~time ?revoked ?(allowed_hashes = sha2) ~anchors = function
| [] -> Error `EmptyCertificateChain
| server :: certs ->
let now = time () in
(* verify server! *)
let* () = is_server_cert_valid ip host now server in
(* build all paths *)
let paths = build_paths server certs
and anchors = List.filter (validate_time now) anchors
in
(* exists there one which is good? *)
any_m `InvalidChain (verify_single_chain now ?revoked allowed_hashes anchors) paths
let valid_cas ?(allowed_hashes = all_hashes) ?time cas =
List.filter (fun cert ->
Result.is_ok (is_ca_cert_valid allowed_hashes time cert))
cas
let fingerprint_verification ?ip host now fingerprint fp = function
| [] -> Error `EmptyCertificateChain
| server::_ ->
let computed_fingerprint = fp server in
if String.equal computed_fingerprint fingerprint then
match
validate_time now server,
maybe_validate_hostname server host,
maybe_validate_ip server ip
with
| true , true , true -> Ok None
| false, _ , _ -> Error (`LeafCertificateExpired (server, now))
| _ , false, _ -> Error (`LeafInvalidName (server, host))
| _ , _ , false -> Error (`LeafInvalidIP (server, ip))
else
Error (`InvalidFingerprint (server, computed_fingerprint, fingerprint))
let trust_key_fingerprint ?ip ~host ~time ~hash ~fingerprint =
let now = time () in
let fp cert = Public_key.fingerprint ~hash (Certificate.public_key cert) in
fingerprint_verification ?ip host now fingerprint fp
let trust_cert_fingerprint ?ip ~host ~time ~hash ~fingerprint =
let now = time () in
let fp = Certificate.fingerprint hash in
fingerprint_verification ?ip host now fingerprint fp
(* RFC5246 says 'root certificate authority MAY be omitted' *)
(* TODO: how to deal with
2.16.840.1.113730.1.1 - Netscape certificate type
2.16.840.1.113730.1.12 - SSL server name
2.16.840.1.113730.1.13 - Netscape certificate comment *)
(* stuff from 4366 (TLS extensions):
- root CAs
- client cert url *)
(* Future TODO Certificate Revocation Lists and OCSP (RFC6520)
2.16.840.1.113730.1.2 - Base URL
2.16.840.1.113730.1.3 - Revocation URL
2.16.840.1.113730.1.4 - CA Revocation URL
2.16.840.1.113730.1.7 - Renewal URL
2.16.840.1.113730.1.8 - Netscape CA policy URL
2.5.4.38 - id-at-authorityRevocationList
2.5.4.39 - id-at-certificateRevocationList
do not forget about 'authority information access' (private internet extension -- 4.2.2 of 5280) *)
(* Future TODO: Policies
2.5.29.32 - Certificate Policies
2.5.29.33 - Policy Mappings
2.5.29.36 - Policy Constraints
*)
(* Future TODO: anything with subject_id and issuer_id ? seems to be not used by anybody *)

27
unikernel/duniverse/ocaml-x509/lib/x509.ml Normal file
View file

@ -0,0 +1,27 @@
module Host = Host
module Key_type = Key_type
module Public_key = Public_key
module Private_key = Private_key
module Distinguished_name = Distinguished_name
module General_name = General_name
module Certificate = Certificate
module Validation = Validation
module Extension = Extension
module Signing_request = Signing_request
module CRL = Crl
module Authenticator = Authenticator
module PKCS12 = P12
module OCSP = Ocsp

1248
unikernel/duniverse/ocaml-x509/lib/x509.mli Normal file
View file

File diff suppressed because it is too large Load diff

BIN
unikernel/duniverse/ocaml-x509/tests/crl/1.crl Normal file
View file

Binary file not shown.

29
unikernel/duniverse/ocaml-x509/tests/crl/1.pem Normal file
View file

@ -0,0 +1,29 @@
-----BEGIN CERTIFICATE-----
MIIEvTCCA6WgAwIBAgIBADANBgkqhkiG9w0BAQUFADB/MQswCQYDVQQGEwJFVTEn
MCUGA1UEChMeQUMgQ2FtZXJmaXJtYSBTQSBDSUYgQTgyNzQzMjg3MSMwIQYDVQQL
ExpodHRwOi8vd3d3LmNoYW1iZXJzaWduLm9yZzEiMCAGA1UEAxMZQ2hhbWJlcnMg
b2YgQ29tbWVyY2UgUm9vdDAeFw0wMzA5MzAxNjEzNDNaFw0zNzA5MzAxNjEzNDRa
MH8xCzAJBgNVBAYTAkVVMScwJQYDVQQKEx5BQyBDYW1lcmZpcm1hIFNBIENJRiBB
ODI3NDMyODcxIzAhBgNVBAsTGmh0dHA6Ly93d3cuY2hhbWJlcnNpZ24ub3JnMSIw
IAYDVQQDExlDaGFtYmVycyBvZiBDb21tZXJjZSBSb290MIIBIDANBgkqhkiG9w0B
AQEFAAOCAQ0AMIIBCAKCAQEAtzZV5aVdGDDg2olUkfzIx1L4L1DZ77F1c2VHfRtb
unXF/KGIJPov7coISjlUxFF6tdpg6jg8gbLL8bvZkSM/SAFwdakFKq0fcfPJVD0d
BmpAPrMMhe5cG3nCYsS4No41XQEMIwRHNaqbYE6gZj3LJgqcQKH0XZi/caulAGgq
7YN6D6IUtdQis4CwPAxaUWktWBiP7Zme8a7ileb2R6jWDA+wWFjbw2Y3npuRVDM3
0pQcakjJyfKl2qUMI/cjDpwyVV5xnIQFUZot/eZOKjRa3spAN2cMVCFVd9oKDMyX
roDclDZK9D7ONhMeU+SsTjoF7Nuucpw4i9A5O4kKPnf+dQIBA6OCAUQwggFAMBIG
A1UdEwEB/wQIMAYBAf8CAQwwPAYDVR0fBDUwMzAxoC+gLYYraHR0cDovL2NybC5j
aGFtYmVyc2lnbi5vcmcvY2hhbWJlcnNyb290LmNybDAdBgNVHQ4EFgQU45T1sU3p
26EpW1eLTXYGduHRooowDgYDVR0PAQH/BAQDAgEGMBEGCWCGSAGG+EIBAQQEAwIA
BzAnBgNVHREEIDAegRxjaGFtYmVyc3Jvb3RAY2hhbWJlcnNpZ24ub3JnMCcGA1Ud
EgQgMB6BHGNoYW1iZXJzcm9vdEBjaGFtYmVyc2lnbi5vcmcwWAYDVR0gBFEwTzBN
BgsrBgEEAYGHLgoDATA+MDwGCCsGAQUFBwIBFjBodHRwOi8vY3BzLmNoYW1iZXJz
aWduLm9yZy9jcHMvY2hhbWJlcnNyb290Lmh0bWwwDQYJKoZIhvcNAQEFBQADggEB
AAxBl8IahsAifJ/7kPMa0QOx7xP5IV8EnNrJpY0nbJaHkb5BkAFyk+cefV/2icZd
p0AJPaxJRUXcLo0waLIJuvvDL8y6C98/d3tGfToSJI6WjzwFCm/SlCgdbQzALogi
1djPHRPH8EjX1wWnz8dHnjs8NMiAT9QUu/wNUPf6s+xCX6ndbcj0dc97wXImsQEc
XCz9ek60AcUFV7nnPKoF2YjpB0ZBzu9Bga5Y34OirsrXdx/nADydb47kMgkdTXg0
eDQ8lJsm7U9xxhl6vSAiSFr+S30Dt+dYvsYyTnQeaN2oaFuzPu5ifdmA6Ap1erfu
tGWaIZDgqtCYvDi1czyL+Nw=
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/10.crl Normal file
View file

Binary file not shown.

23
unikernel/duniverse/ocaml-x509/tests/crl/10.pem Normal file
View file

@ -0,0 +1,23 @@
-----BEGIN CERTIFICATE-----
MIIDqzCCApOgAwIBAgIRAMcoRwmzuGxFjB36JPU2TukwDQYJKoZIhvcNAQEFBQAw
PDEbMBkGA1UEAxMSQ29tU2lnbiBTZWN1cmVkIENBMRAwDgYDVQQKEwdDb21TaWdu
MQswCQYDVQQGEwJJTDAeFw0wNDAzMjQxMTM3MjBaFw0yOTAzMTYxNTA0NTZaMDwx
GzAZBgNVBAMTEkNvbVNpZ24gU2VjdXJlZCBDQTEQMA4GA1UEChMHQ29tU2lnbjEL
MAkGA1UEBhMCSUwwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDGtWhf
HZQVw6QIVS3joFd67+l0Kru5fFdJGhFeTymHDEjWaueP1H5XJLkGieQcPOqs49oh
gHMhCu95mGwfCP+hUH3ymBvJVG8+pSjsIQQPRbsHPaHA+iqYHU4Gk/v1iDurX8sW
v+bznkqH7Rnqwp9D5PGBpX8QTz7RSmKtUxvLg/8HZaWSLWapW7ha9B20IZFKF3ue
Mv5WJDmyVIRD9YTC2LxBkMyd1mja6YJQqTtoz7VdApRgFrFD2UNd3V2Hbuq7s8lr
9gOUCXDeFhF6K+h2j0kQmHe5Y1yLM5d19guMsqtb3nQgJT/j8xH5h2iGNXHDHYwt
6+UarA9z1YJZQIDTAgMBAAGjgacwgaQwDAYDVR0TBAUwAwEB/zBEBgNVHR8EPTA7
MDmgN6A1hjNodHRwOi8vZmVkaXIuY29tc2lnbi5jby5pbC9jcmwvQ29tU2lnblNl
Y3VyZWRDQS5jcmwwDgYDVR0PAQH/BAQDAgGGMB8GA1UdIwQYMBaAFMFL7XC29z58
ADsAj8c+DkWfHl3sMB0GA1UdDgQWBBTBS+1wtvc+fAA7AI/HPg5Fnx5d7DANBgkq
hkiG9w0BAQUFAAOCAQEAFs/ukhNQq3sUnjO2QiBq1BW9Cav8cujvR3qQrFHBZE7p
iL1DRYHjZiM/EoZNGeQFsOY3wo3aBijJD4mkU6l1P7CW+6tMM1X5eCZGbxs2mPtC
dsGCuY7e+0X5YxtiOzkGynd6qDwJz2w2PQ8KRUtpFhpFfTMDZflScZAmlaxMDPWL
kz/MdXSFmLr/YnpNH4n+rr2UAJm/EaXc4HnFFgt9AmEd6oX5AhVP51qJThRv4zdL
hfXBPGHg/QVBspJ/wx2g0K5SZGBrGMYmnNj1ZOQ2GmKfig8+/21OGVZOIJFsnzQz
OjRXUDpvgV4GxvU+fE6OK85lBi5d0ipTdF7Tbieejw==
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/11.crl Normal file
View file

Binary file not shown.

23
unikernel/duniverse/ocaml-x509/tests/crl/11.pem Normal file
View file

@ -0,0 +1,23 @@
-----BEGIN CERTIFICATE-----
MIIDoTCCAomgAwIBAgILBAAAAAABD4WqLUgwDQYJKoZIhvcNAQEFBQAwOzEYMBYG
A1UEChMPQ3liZXJ0cnVzdCwgSW5jMR8wHQYDVQQDExZDeWJlcnRydXN0IEdsb2Jh
bCBSb290MB4XDTA2MTIxNTA4MDAwMFoXDTIxMTIxNTA4MDAwMFowOzEYMBYGA1UE
ChMPQ3liZXJ0cnVzdCwgSW5jMR8wHQYDVQQDExZDeWJlcnRydXN0IEdsb2JhbCBS
b290MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA+Mi8vRRQZhP/8NN5
7CPytxrHjoXxEnOmGaoQ25yiZXRadz5RfVb23CO21O1fWLE3TdVJDm71aofW0ozS
J8bi/zafmGWgE07GKmSb1ZASzxQG9Dvj1Ci+6A74q05IlG2OlTEQXO2iLb3VOm2y
HLtgwEZLAfVJrn5GitB0jaEMAs7u/OePuGtm839EAL9mJRQr3RAwHQeWP032a7iP
t3sMpTjr3kfb1V05/Iin89cqdPHoWqI7n1C6poxFNcJQZZXcY4Lv3b93TZxiyWNz
FtApD0mpSPCzqrdsxacwOUBdrsTiXSZT8M4cIwhhqJQZugRiQOwfOHB3EgZxpzAY
XSUnpQIDAQABo4GlMIGiMA4GA1UdDwEB/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/
MB0GA1UdDgQWBBS2CHsNesysIEyGVjJez6tuhS1wVzA/BgNVHR8EODA2MDSgMqAw
hi5odHRwOi8vd3d3Mi5wdWJsaWMtdHJ1c3QuY29tL2NybC9jdC9jdHJvb3QuY3Js
MB8GA1UdIwQYMBaAFLYIew16zKwgTIZWMl7Pq26FLXBXMA0GCSqGSIb3DQEBBQUA
A4IBAQBW7wojoFROlZfJ+InaRcHUowAl9B8Tq7ejhVhpwjCt2BWKLePJzYFa+HMj
Wqd8BfP9IjsO0QbE2zZMcwSO5bAi5MXzLqXZI+O4Tkogp24CJJ8iYGd7ix1yCcUx
XOl5n4BHPa2hCwcUPUf/A2kaDAtE52Mlp3+yybh2hO0j9n0Hq0V+09+zv+mKts2o
omcrUtW3ZfA5TGOgkXmTUg9U3YO7n9GPp1Nzw8v/MOx8BLjYRB+TX3EJIrduPuoc
A06dGiBh+4E37F78CkWr1+cXVdCg6mCbpvbjjFspwgZgFJ0tl0ypkxWdYcQBX0jW
WL1WMRJOEcgh4LMRkWXbtKaIOM5V
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/12.crl Normal file
View file

Binary file not shown.

29
unikernel/duniverse/ocaml-x509/tests/crl/12.pem Normal file
View file

@ -0,0 +1,29 @@
-----BEGIN CERTIFICATE-----
MIIE2DCCBEGgAwIBAgIEN0rSQzANBgkqhkiG9w0BAQUFADCBwzELMAkGA1UEBhMC
VVMxFDASBgNVBAoTC0VudHJ1c3QubmV0MTswOQYDVQQLEzJ3d3cuZW50cnVzdC5u
ZXQvQ1BTIGluY29ycC4gYnkgcmVmLiAobGltaXRzIGxpYWIuKTElMCMGA1UECxMc
KGMpIDE5OTkgRW50cnVzdC5uZXQgTGltaXRlZDE6MDgGA1UEAxMxRW50cnVzdC5u
ZXQgU2VjdXJlIFNlcnZlciBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTAeFw05OTA1
MjUxNjA5NDBaFw0xOTA1MjUxNjM5NDBaMIHDMQswCQYDVQQGEwJVUzEUMBIGA1UE
ChMLRW50cnVzdC5uZXQxOzA5BgNVBAsTMnd3dy5lbnRydXN0Lm5ldC9DUFMgaW5j
b3JwLiBieSByZWYuIChsaW1pdHMgbGlhYi4pMSUwIwYDVQQLExwoYykgMTk5OSBF
bnRydXN0Lm5ldCBMaW1pdGVkMTowOAYDVQQDEzFFbnRydXN0Lm5ldCBTZWN1cmUg
U2VydmVyIENlcnRpZmljYXRpb24gQXV0aG9yaXR5MIGdMA0GCSqGSIb3DQEBAQUA
A4GLADCBhwKBgQDNKIM0VBuJ8w+vN5Ex/68xYMmo6LIQaO2f55M28Qpku0f1BBc/
I0dNxScZgSYMVHINiC3ZH5oSn7yzcdOAGT9HZnuMNSjSuQrfJNqc1lB5gXpa0zf3
wkrYKZImZNHkmGw6AIr1NJtl+O3jEP/9uElY3KDegjlrgbEWGWG5VLbmQwIBA6OC
AdcwggHTMBEGCWCGSAGG+EIBAQQEAwIABzCCARkGA1UdHwSCARAwggEMMIHeoIHb
oIHYpIHVMIHSMQswCQYDVQQGEwJVUzEUMBIGA1UEChMLRW50cnVzdC5uZXQxOzA5
BgNVBAsTMnd3dy5lbnRydXN0Lm5ldC9DUFMgaW5jb3JwLiBieSByZWYuIChsaW1p
dHMgbGlhYi4pMSUwIwYDVQQLExwoYykgMTk5OSBFbnRydXN0Lm5ldCBMaW1pdGVk
MTowOAYDVQQDEzFFbnRydXN0Lm5ldCBTZWN1cmUgU2VydmVyIENlcnRpZmljYXRp
b24gQXV0aG9yaXR5MQ0wCwYDVQQDEwRDUkwxMCmgJ6AlhiNodHRwOi8vd3d3LmVu
dHJ1c3QubmV0L0NSTC9uZXQxLmNybDArBgNVHRAEJDAigA8xOTk5MDUyNTE2MDk0
MFqBDzIwMTkwNTI1MTYwOTQwWjALBgNVHQ8EBAMCAQYwHwYDVR0jBBgwFoAU8Bdi
E1U9s/8KAGv7UISX8+1i0BowHQYDVR0OBBYEFPAXYhNVPbP/CgBr+1CEl/PtYtAa
MAwGA1UdEwQFMAMBAf8wGQYJKoZIhvZ9B0EABAwwChsEVjQuMAMCBJAwDQYJKoZI
hvcNAQEFBQADgYEAkNwwAvpkdMKnCqV8IY00F6j7Rw7/JXyNEwr75Ji174z4xRAN
95K+8cPV1ZVqBLssziY2ZcgxxufuP+NXdYR6Ee9GTxj005i7qIcyunL2POI9n9cd
2cNgQ4xYDiKWL2KjLB+6rQXvqzJ4h6BUcxm1XAX5Uj5tLUUL9wqT6u0G+bI=
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/13.crl Normal file
View file

Binary file not shown.

23
unikernel/duniverse/ocaml-x509/tests/crl/13.pem Normal file
View file

@ -0,0 +1,23 @@
-----BEGIN CERTIFICATE-----
MIIDujCCAqKgAwIBAgILBAAAAAABD4Ym5g0wDQYJKoZIhvcNAQEFBQAwTDEgMB4G
A1UECxMXR2xvYmFsU2lnbiBSb290IENBIC0gUjIxEzARBgNVBAoTCkdsb2JhbFNp
Z24xEzARBgNVBAMTCkdsb2JhbFNpZ24wHhcNMDYxMjE1MDgwMDAwWhcNMjExMjE1
MDgwMDAwWjBMMSAwHgYDVQQLExdHbG9iYWxTaWduIFJvb3QgQ0EgLSBSMjETMBEG
A1UEChMKR2xvYmFsU2lnbjETMBEGA1UEAxMKR2xvYmFsU2lnbjCCASIwDQYJKoZI
hvcNAQEBBQADggEPADCCAQoCggEBAKbPJA6+Lm8omUVCxKs+IVSbC9N/hHD6ErPL
v4dfxn+G07IwXNb9rfF73OX4YJYJkhD10FPe+3t+c4isUoh7SqbKSaZeqKeMWhG8
eoLrvozps6yWJQeXSpkqBy+0Hne/ig+1AnwblrjFuTosvNYSuetZfeLQBoZfXklq
tTleiDTsvHgMCJiEbKjNS7SgfQx5TfC4LcshytVsW33hoCmEofnTlEnLJGKRILzd
C9XZzPnqJworc5HGnRusyMvo4KD0L5CLTfuwNhv2GXqF4G3yYROIXJ/gkwpRl4pa
zq+r1feqCapgvdzZX99yqWATXgAByUr6P6TqBwMhAo6CygPCm48CAwEAAaOBnDCB
mTAOBgNVHQ8BAf8EBAMCAQYwDwYDVR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQUm+IH
V2ccHsBqBt5ZtJot39wZhi4wNgYDVR0fBC8wLTAroCmgJ4YlaHR0cDovL2NybC5n
bG9iYWxzaWduLm5ldC9yb290LXIyLmNybDAfBgNVHSMEGDAWgBSb4gdXZxwewGoG
3lm0mi3f3BmGLjANBgkqhkiG9w0BAQUFAAOCAQEAmYFThxxol4aR7OBKuEQLq4Gs
J0/WwbgcQ3izDJr86iw8bmEbTUsp9Z8FHSbBuOmDAGJFtqkIk7mpM0sYmsL4h4hO
291xNBrBVNpGP+DTKqttVCL1OmLNIG+6KYnX3ZHu01yiPqFbQfXf5WRDLenVOavS
ot+3i9DAgBkcRcAtjOj4LaR0VknFBbVPFd5uRHg5h6h+u/N5GJG79G+dwfCMNYxd
AfvDbbnvRG15RjF+Cv6pgsH/76tuIMRQyV+dTZsXjAzlAcmgQWpzU/qlULRuJQ/7
TBj0/VLZjmmx6BEP3ojY+x1J96relc8geMJgEtslQIxq/H5COEBkEveegeGTLg==
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/14.crl Normal file
View file

Binary file not shown.

44
unikernel/duniverse/ocaml-x509/tests/crl/14.pem Normal file
View file

@ -0,0 +1,44 @@
-----BEGIN CERTIFICATE-----
MIIHqDCCBpCgAwIBAgIRAMy4579OKRr9otxmpRwsDxEwDQYJKoZIhvcNAQEFBQAw
cjELMAkGA1UEBhMCSFUxETAPBgNVBAcTCEJ1ZGFwZXN0MRYwFAYDVQQKEw1NaWNy
b3NlYyBMdGQuMRQwEgYDVQQLEwtlLVN6aWdubyBDQTEiMCAGA1UEAxMZTWljcm9z
ZWMgZS1Temlnbm8gUm9vdCBDQTAeFw0wNTA0MDYxMjI4NDRaFw0xNzA0MDYxMjI4
NDRaMHIxCzAJBgNVBAYTAkhVMREwDwYDVQQHEwhCdWRhcGVzdDEWMBQGA1UEChMN
TWljcm9zZWMgTHRkLjEUMBIGA1UECxMLZS1Temlnbm8gQ0ExIjAgBgNVBAMTGU1p
Y3Jvc2VjIGUtU3ppZ25vIFJvb3QgQ0EwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAw
ggEKAoIBAQDtyADVgXvNOABHzNuEwSFpLHSQDCHZU4ftPkNEU6+r+ICbPHiN1I2u
uO/TEdyB5s87lozWbxXGd36hL+BfkrYn13aaHUM86tnsL+4582pnS4uCzyL4ZVX+
LMsvfUh6PXX5qqAnu3jCBspRwn5mS6/NoqdNAoI/gqyFxuEPkEeZlApxcpMqyabA
vjxWTHOSJ/FrtfX9/DAFYJLG65Z+AZHCabEeHXtTRbjcQR/Ji3HWVBTji1R4P770
Yjtb9aPs1ZJ04nQw7wHb4dSrmZsqa/i9phyGI0Jf7Enemotb9HI6QMVJPqW+jqpx
62z69Rrkav17fVVA71hu5tnVvCSrwe+3AgMBAAGjggQ3MIIEMzBnBggrBgEFBQcB
AQRbMFkwKAYIKwYBBQUHMAGGHGh0dHBzOi8vcmNhLmUtc3ppZ25vLmh1L29jc3Aw
LQYIKwYBBQUHMAKGIWh0dHA6Ly93d3cuZS1zemlnbm8uaHUvUm9vdENBLmNydDAP
BgNVHRMBAf8EBTADAQH/MIIBcwYDVR0gBIIBajCCAWYwggFiBgwrBgEEAYGoGAIB
AQEwggFQMCgGCCsGAQUFBwIBFhxodHRwOi8vd3d3LmUtc3ppZ25vLmh1L1NaU1ov
MIIBIgYIKwYBBQUHAgIwggEUHoIBEABBACAAdABhAG4A+gBzAO0AdAB2AOEAbgB5
ACAA6QByAHQAZQBsAG0AZQB6AOkAcwDpAGgAZQB6ACAA6QBzACAAZQBsAGYAbwBn
AGEAZADhAHMA4QBoAG8AegAgAGEAIABTAHoAbwBsAGcA4QBsAHQAYQB0APMAIABT
AHoAbwBsAGcA4QBsAHQAYQB0AOEAcwBpACAAUwB6AGEAYgDhAGwAeQB6AGEAdABh
ACAAcwB6AGUAcgBpAG4AdAAgAGsAZQBsAGwAIABlAGwAagDhAHIAbgBpADoAIABo
AHQAdABwADoALwAvAHcAdwB3AC4AZQAtAHMAegBpAGcAbgBvAC4AaAB1AC8AUwBa
AFMAWgAvMIHIBgNVHR8EgcAwgb0wgbqggbeggbSGIWh0dHA6Ly93d3cuZS1zemln
bm8uaHUvUm9vdENBLmNybIaBjmxkYXA6Ly9sZGFwLmUtc3ppZ25vLmh1L0NOPU1p
Y3Jvc2VjJTIwZS1Temlnbm8lMjBSb290JTIwQ0EsT1U9ZS1Temlnbm8lMjBDQSxP
PU1pY3Jvc2VjJTIwTHRkLixMPUJ1ZGFwZXN0LEM9SFU/Y2VydGlmaWNhdGVSZXZv
Y2F0aW9uTGlzdDtiaW5hcnkwDgYDVR0PAQH/BAQDAgEGMIGWBgNVHREEgY4wgYuB
EGluZm9AZS1zemlnbm8uaHWkdzB1MSMwIQYDVQQDDBpNaWNyb3NlYyBlLVN6aWdu
w7MgUm9vdCBDQTEWMBQGA1UECwwNZS1TemlnbsOzIEhTWjEWMBQGA1UEChMNTWlj
cm9zZWMgS2Z0LjERMA8GA1UEBxMIQnVkYXBlc3QxCzAJBgNVBAYTAkhVMIGsBgNV
HSMEgaQwgaGAFMegSXUWYYTbMUuE0vE3QJDvTtz3oXakdDByMQswCQYDVQQGEwJI
VTERMA8GA1UEBxMIQnVkYXBlc3QxFjAUBgNVBAoTDU1pY3Jvc2VjIEx0ZC4xFDAS
BgNVBAsTC2UtU3ppZ25vIENBMSIwIAYDVQQDExlNaWNyb3NlYyBlLVN6aWdubyBS
b290IENBghEAzLjnv04pGv2i3GalHCwPETAdBgNVHQ4EFgQUx6BJdRZhhNsxS4TS
8TdAkO9O3PcwDQYJKoZIhvcNAQEFBQADggEBANMTnGZjWS7KXHAM/IO8VbH0jgds
ZifOwTsgqRy7RlRw7lrMoHfqaEQn6/Ip3Xep1fvj1KcExJW4C+FEaGAHQzAxQmHl
7tnlJNUb3+FKG6qfx1/4ehHqE5MAyopYse7tDk2016g2JnzgOsHVV4Lxdbb9iV/a
86g4nzUGCM4ilb7N1fy+W955a9x6qWVmvrElWl/tftOsRm1M9DKHtCAE4Gx4sHfR
hUZLphK3dehKyVZs15KrnfVJONJPU+NVkBHbmJbGSfI+9J8b4PeI3CVimUTYc78/
MPMMNz7UwiiAc7EBt51alhQBS6kRnSlqLtBdgcDPsiBDxwPgN05dCtxZICU=
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/15.crl Normal file
View file

Binary file not shown.

24
unikernel/duniverse/ocaml-x509/tests/crl/15.pem Normal file
View file

@ -0,0 +1,24 @@
-----BEGIN CERTIFICATE-----
MIID5jCCAs6gAwIBAgIQV8szb8JcFuZHFhfjkDFo4DANBgkqhkiG9w0BAQUFADBi
MQswCQYDVQQGEwJVUzEhMB8GA1UEChMYTmV0d29yayBTb2x1dGlvbnMgTC5MLkMu
MTAwLgYDVQQDEydOZXR3b3JrIFNvbHV0aW9ucyBDZXJ0aWZpY2F0ZSBBdXRob3Jp
dHkwHhcNMDYxMjAxMDAwMDAwWhcNMjkxMjMxMjM1OTU5WjBiMQswCQYDVQQGEwJV
UzEhMB8GA1UEChMYTmV0d29yayBTb2x1dGlvbnMgTC5MLkMuMTAwLgYDVQQDEydO
ZXR3b3JrIFNvbHV0aW9ucyBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkwggEiMA0GCSqG
SIb3DQEBAQUAA4IBDwAwggEKAoIBAQDkvH6SMG3G2I4rC7xGzuAnlt7e+foS0zwz
c7MEL7xxjOWftiJgPl9dzgn/ggwbmlFQGiaJ3dVhXRncEg8tCqJDXRfQNJIg6nPP
OCwGJgl6cvf6UDL4wpPTaaIjzkGxzOTVHzbRijr4jGPiFFlp7Q3Tf2vouAPlT2rl
mGNpSAW+Lv8ztumXWWn4Zxmuk2GWRBXTcrA/vGp97Eh/jcOrqnErU2lBUzS1sLnF
BgrEsEX1QV1uiUV7PTsmjHTC5dLRfbIR1PtYMiKagMnc/Qzpf14Dl847ABSHJ3A4
qY5usyd2mFHgBeMhqxrVhSI8KbWaFsWAqPS7azCPL0YCorEMIuDTAgMBAAGjgZcw
gZQwHQYDVR0OBBYEFCEwyfsA106Y2oeqKtCnLrFAMadMMA4GA1UdDwEB/wQEAwIB
BjAPBgNVHRMBAf8EBTADAQH/MFIGA1UdHwRLMEkwR6BFoEOGQWh0dHA6Ly9jcmwu
bmV0c29sc3NsLmNvbS9OZXR3b3JrU29sdXRpb25zQ2VydGlmaWNhdGVBdXRob3Jp
dHkuY3JsMA0GCSqGSIb3DQEBBQUAA4IBAQC7rkvnt1frf6ott3NHhWrB5KUd5Oc8
6fRZZXe1eltajSU24HqXLjjAV2CDmAaDn7l2em5Q4LqILPxFzBiwmZVRDuwduIj/
h1AcgsLj4DKAv6ALR8jDMe+ZZzKATxcheQxpXN5eNK4CtSbqUN9/GGUsyfJj4akH
/nxxH2szJGoeBfcFaMBqEssuXmHLrijTfsK0ZpEmXzwuJF/LWA/rKOyvEZbz3Htv
wKeI8lN3s2Berq4o2jUsbzRF0ybh3uxbTydrFny9RAQYgrOJeRcQcT16ohZO9QHN
pGxlaKFJdlxDydi8NmdspZS11My5vWo1ViHe2MPr+8ukYEywVaCge1ey
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/16.crl Normal file
View file

Binary file not shown.

23
unikernel/duniverse/ocaml-x509/tests/crl/16.pem Normal file
View file

@ -0,0 +1,23 @@
-----BEGIN CERTIFICATE-----
MIIDvDCCAqSgAwIBAgIQB1YipOjUiolN9BPI8PjqpTANBgkqhkiG9w0BAQUFADBK
MQswCQYDVQQGEwJVUzEgMB4GA1UEChMXU2VjdXJlVHJ1c3QgQ29ycG9yYXRpb24x
GTAXBgNVBAMTEFNlY3VyZSBHbG9iYWwgQ0EwHhcNMDYxMTA3MTk0MjI4WhcNMjkx
MjMxMTk1MjA2WjBKMQswCQYDVQQGEwJVUzEgMB4GA1UEChMXU2VjdXJlVHJ1c3Qg
Q29ycG9yYXRpb24xGTAXBgNVBAMTEFNlY3VyZSBHbG9iYWwgQ0EwggEiMA0GCSqG
SIb3DQEBAQUAA4IBDwAwggEKAoIBAQCvNS7YrGxVaQZx5RNoJLNP2MwhR/jxYDiJ
iQPpvepeRlMJ3Fz1Wuj3RSoC6zFh1ykzTM7HfAo3fg+6MpjhHZevj8fcyTiW89sa
/FHtaMbQbqR8JNGuQsiWUGMu4P51/pinX0kuleM5M2SOHqRfkNJnPLLZ/kG5VacJ
jnIFHovdRIWCQtBJwB1g8NEXLJXr9qXBkqPFwqcIYA1gBBCWeZ4WNOaptvolRTnI
HmX5k/Wq8VLcmZg9pYYaDDUz+kulBAYVHDGA76oYa8J719rO+TMg1fW9ajMtgQT7
sFzUnKPiXB3jqUJ1XnvUd+85VLrJChgbEplJL4hL/VBi0XPnj3pDAgMBAAGjgZ0w
gZowEwYJKwYBBAGCNxQCBAYeBABDAEEwCwYDVR0PBAQDAgGGMA8GA1UdEwEB/wQF
MAMBAf8wHQYDVR0OBBYEFK9EBMJBfkiD2045AuzshHrmzsmkMDQGA1UdHwQtMCsw
KaAnoCWGI2h0dHA6Ly9jcmwuc2VjdXJldHJ1c3QuY29tL1NHQ0EuY3JsMBAGCSsG
AQQBgjcVAQQDAgEAMA0GCSqGSIb3DQEBBQUAA4IBAQBjGghAfaReUw132HquHw0L
URYD7xh8yOOvaliTFGCRsoTciE6+OYo68+aCiV0BN7OrJKQVDpI1WkpEXk5X+nXO
H0jOZvQ8QCaSmGwb7iRGDBezUqXbpZGRzzfTb+cnCDpOGR86p1hcF895P4vkp9Mm
I50mD1hp/Ed+stCNi5O/KU9DaXR2Z0vPB4zmAve14bRDtUstFJ/53CYNv6ZHdAbY
iNE6KTCEztI5gGIbqMdXSbxqVVFnFUq+NQfk1XWYN3kwFNspnWzFacxHVaIw98xc
f8LDmBxrThaA63p4ZUWiABqvDA1VZDRIuJK58bRQKfJPIx/abKwfROHdI3hRW8cW
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/17.crl Normal file
View file

Binary file not shown.

23
unikernel/duniverse/ocaml-x509/tests/crl/17.pem Normal file
View file

@ -0,0 +1,23 @@
-----BEGIN CERTIFICATE-----
MIIDuDCCAqCgAwIBAgIQDPCOXAgWpa1Cf/DrJxhZ0DANBgkqhkiG9w0BAQUFADBI
MQswCQYDVQQGEwJVUzEgMB4GA1UEChMXU2VjdXJlVHJ1c3QgQ29ycG9yYXRpb24x
FzAVBgNVBAMTDlNlY3VyZVRydXN0IENBMB4XDTA2MTEwNzE5MzExOFoXDTI5MTIz
MTE5NDA1NVowSDELMAkGA1UEBhMCVVMxIDAeBgNVBAoTF1NlY3VyZVRydXN0IENv
cnBvcmF0aW9uMRcwFQYDVQQDEw5TZWN1cmVUcnVzdCBDQTCCASIwDQYJKoZIhvcN
AQEBBQADggEPADCCAQoCggEBAKukgeWVzfX2FI7CT8rU4niVWJxB4Q2ZQCQXOZEz
Zum+4YOvYlyJ0fwkW2Gz4BERQRwdbvC4u/jep4G6pkjGnx29vo6pQT64lO0pGtSO
0gMdA+9tDWccV9cGrcrI9f4Or2YlSASWC12juhbDCE/RRvgUXPLIXgGZbf2IzIao
wW8xQmxSPmjL8xk037uHGFaAJsTQ3MBv396gwpEWoGQRS0S8Hvbn+mPeZqx2pHGj
7DaUaHp3pLHnDi+BeuK1cobvomuL8A/b01k/unK8RCSc43Oz969XL0Imnal0ugBS
8kvNU3xHCzaFDmapCJcWNFfBZveA4+1wVMeT4C4oFVmHursCAwEAAaOBnTCBmjAT
BgkrBgEEAYI3FAIEBh4EAEMAQTALBgNVHQ8EBAMCAYYwDwYDVR0TAQH/BAUwAwEB
/zAdBgNVHQ4EFgQUQjK2FvoE/f5dS3rD/fdMQB1aQ68wNAYDVR0fBC0wKzApoCeg
JYYjaHR0cDovL2NybC5zZWN1cmV0cnVzdC5jb20vU1RDQS5jcmwwEAYJKwYBBAGC
NxUBBAMCAQAwDQYJKoZIhvcNAQEFBQADggEBADDtT0rhWDpSclu1pqNlGKa7UTt3
6Z3q059c4EVlew3KW+JwULKUBRSuSceNQQcSc5R+DCMh/bwQf2AQWnL1mA6s7Ll/
3XpvXdMc9P+IBWlCqQVxyLesJugutIxq/3HcuLHfmbx8IVQr5Fiiu1cprp6poxkm
D5kuCLDv/WnPmRoJjeOnnyvJNjR7JLN4TJUXpAYmHrZkUjZfYGfZnMUFdAvnZyPS
CPyI6a6Lf+Ew9Dd+/cYy2i2eRDAwbO4H3tI0/NL/QPZL9GZGBlSm8jIKYyYwa5vR
3ItHuuG51WLQoqD0ZwV4KWMabwTW+MZMo5qxN7SN5ShLHZ4swrhovO0C7jE=
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/18.crl Normal file
View file

Binary file not shown.

45
unikernel/duniverse/ocaml-x509/tests/crl/18.pem Normal file
View file

@ -0,0 +1,45 @@
-----BEGIN CERTIFICATE-----
MIIHyTCCBbGgAwIBAgIBATANBgkqhkiG9w0BAQUFADB9MQswCQYDVQQGEwJJTDEW
MBQGA1UEChMNU3RhcnRDb20gTHRkLjErMCkGA1UECxMiU2VjdXJlIERpZ2l0YWwg
Q2VydGlmaWNhdGUgU2lnbmluZzEpMCcGA1UEAxMgU3RhcnRDb20gQ2VydGlmaWNh
dGlvbiBBdXRob3JpdHkwHhcNMDYwOTE3MTk0NjM2WhcNMzYwOTE3MTk0NjM2WjB9
MQswCQYDVQQGEwJJTDEWMBQGA1UEChMNU3RhcnRDb20gTHRkLjErMCkGA1UECxMi
U2VjdXJlIERpZ2l0YWwgQ2VydGlmaWNhdGUgU2lnbmluZzEpMCcGA1UEAxMgU3Rh
cnRDb20gQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkwggIiMA0GCSqGSIb3DQEBAQUA
A4ICDwAwggIKAoICAQDBiNsJvGxGfHiflXu1M5DycmLWwTYgIiRezul38kMKogZk
pMyONvg45iPwbm2xPN1yo4UcodM9tDMr0y+v/uqwQVlntsQGfQqedIXWeUyAN3rf
OQVSWff0G0ZDpNKFhdLDcfN1YjS6LIp/Ho/u7TTQEceWzVI9ujPW3U3eCztKS5/C
Ji/6tRYccjV3yjxd5srhJosaNnZcAdt0FCX+7bWgiA/deMotHweXMAEtcnn6RtYT
Kqi5pquDSR3l8u/d5AGOGAqPY1MWhWKpDhk6zLVmpsJrdAfkK+F2PrRt2PZE4XNi
HzvEvqBTViVsUQn3qqvKv3b9bZvzndu/PWa8DFaqr5hIlTpL36dYUNk4dalb6kMM
Av+Z6+hsTXBbKWWc3apdzK8BMewM69KN6Oqce+Zu9ydmDBpI125C4z/eIT574Q1w
+2OqqGwaVLRcJXrJosmLFqa7LH4XXgVNWG4SHQHuEhANxjJ/GP/89PrNbpHoNkm+
Gkhpi8KWTRoSsmkXwQqQ1vp5Iki/untp+HDH+no32NgN0nZPV/+Qt+OR0t3vwmC3
Zzrd/qqc8NSLf3Iizsafl7b4r4qgEKjZ+xjGtrVcUjyJthkqcwEKDwOzEmDyei+B
26Nu/yYwl/WL3YlXtq09s68rxbd2AvCl1iuahhQqcvbjM4xdCUsT37uMdBNSSwID
AQABo4ICUjCCAk4wDAYDVR0TBAUwAwEB/zALBgNVHQ8EBAMCAa4wHQYDVR0OBBYE
FE4L7xqkQFulF2mHMMo0aEPQQa7yMGQGA1UdHwRdMFswLKAqoCiGJmh0dHA6Ly9j
ZXJ0LnN0YXJ0Y29tLm9yZy9zZnNjYS1jcmwuY3JsMCugKaAnhiVodHRwOi8vY3Js
LnN0YXJ0Y29tLm9yZy9zZnNjYS1jcmwuY3JsMIIBXQYDVR0gBIIBVDCCAVAwggFM
BgsrBgEEAYG1NwEBATCCATswLwYIKwYBBQUHAgEWI2h0dHA6Ly9jZXJ0LnN0YXJ0
Y29tLm9yZy9wb2xpY3kucGRmMDUGCCsGAQUFBwIBFilodHRwOi8vY2VydC5zdGFy
dGNvbS5vcmcvaW50ZXJtZWRpYXRlLnBkZjCB0AYIKwYBBQUHAgIwgcMwJxYgU3Rh
cnQgQ29tbWVyY2lhbCAoU3RhcnRDb20pIEx0ZC4wAwIBARqBl0xpbWl0ZWQgTGlh
YmlsaXR5LCByZWFkIHRoZSBzZWN0aW9uICpMZWdhbCBMaW1pdGF0aW9ucyogb2Yg
dGhlIFN0YXJ0Q29tIENlcnRpZmljYXRpb24gQXV0aG9yaXR5IFBvbGljeSBhdmFp
bGFibGUgYXQgaHR0cDovL2NlcnQuc3RhcnRjb20ub3JnL3BvbGljeS5wZGYwEQYJ
YIZIAYb4QgEBBAQDAgAHMDgGCWCGSAGG+EIBDQQrFilTdGFydENvbSBGcmVlIFNT
TCBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTANBgkqhkiG9w0BAQUFAAOCAgEAFmyZ
9GYMNPXQhV59CuzaEE44HF7fpiUFS5Eyweg78T3dRAlbB0mKKctmArexmvclmAk8
jhvh3TaHK0u7aNM5Zj2gJsfyOZEdUauCe37Vzlrk4gNXcGmXCPleWKYK34wGmkUW
FjgKXlf2Ysd6AgXmvB618p70qSmD+LIU424oh0TDkBreOKk8rENNZEXO3SipXPJz
ewT4F+irsfMuXGRuczE6Eri8sxHkfY+BUZo7jYn0TZNmezwD7dOaHZrzZVD1oNB1
ny+v8OqCQ5j4aZyJecRDjkZy42Q2Eq/3JR44iZB3fsNrarnDy0RLrHiQi+fHLB5L
EUTINFInzQpdn4XBidUaePKVEFMy3YCEZnXZtWgo+2EuvoSoOMCZEoalHmdkrQYu
L6lwhceWD3yJZfWOQ1QOq92lgDmUYMA0yZZwLKMS9R9Ie70cfmu3nZD0Ijuu+Pwq
yvqCUqDvr0tVk+vBtfAii6w0TiYiBKGHLHVKt+V9E9e4DGTANtLJL4YSjCMJwRuC
O3NJo2pXh5Tl1njFmUNj403gdy3hZZlyaQQaRwnmDwFWJPsfvw55qVguucQJAX6V
um0ABj6y6koQOdjQK/W/7HW/lwLFCRsI3FU34oH7N4RDYiDK51ZLZer+bMEkkySh
NOsF/5oirpt9P/FlUQqmMGqz9IgcgA38corog14=
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/19.crl Normal file
View file

Binary file not shown.

28
unikernel/duniverse/ocaml-x509/tests/crl/19.pem Normal file
View file

@ -0,0 +1,28 @@
-----BEGIN CERTIFICATE-----
MIIEqjCCA5KgAwIBAgIOLmoAAQACH9dSISwRXDswDQYJKoZIhvcNAQEFBQAwdjEL
MAkGA1UEBhMCREUxHDAaBgNVBAoTE1RDIFRydXN0Q2VudGVyIEdtYkgxIjAgBgNV
BAsTGVRDIFRydXN0Q2VudGVyIENsYXNzIDIgQ0ExJTAjBgNVBAMTHFRDIFRydXN0
Q2VudGVyIENsYXNzIDIgQ0EgSUkwHhcNMDYwMTEyMTQzODQzWhcNMjUxMjMxMjI1
OTU5WjB2MQswCQYDVQQGEwJERTEcMBoGA1UEChMTVEMgVHJ1c3RDZW50ZXIgR21i
SDEiMCAGA1UECxMZVEMgVHJ1c3RDZW50ZXIgQ2xhc3MgMiBDQTElMCMGA1UEAxMc
VEMgVHJ1c3RDZW50ZXIgQ2xhc3MgMiBDQSBJSTCCASIwDQYJKoZIhvcNAQEBBQAD
ggEPADCCAQoCggEBAKuAh5uO8MN8h9foJIIRszzdQ2Lu+MNF2ujhoF/RKrLqk2jf
tMjWQ+nEdVl//OEd+DFwIxuInie5e/060smp6RQvkL4DUsFJzfb95AhmC1eKokKg
uNV/aVyQMrKXDcpK3EY+AlWJU+MaWss2xgdW94zPEfRMuzBwBJWl9jmM/XOBCH2J
XjIeIqkiRUuwZi4wzJ9l/fzLganx4Duvo4bRierERXlQXa7pIXSSTYtZgo+U4+lK
8edJsBTj9WLL1XK9H7nSn6DNqPoByNkN39r8R52zyFTfSUrxIan+GE7uSNQZu+99
5OKdy1u2bv/jzVrndIIFuoAlOMvkaZ6vQaoahPUCAwEAAaOCATQwggEwMA8GA1Ud
EwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMB0GA1UdDgQWBBTjq1RMgKHbVkO3
kUrL84J6E1wIqzCB7QYDVR0fBIHlMIHiMIHfoIHcoIHZhjVodHRwOi8vd3d3LnRy
dXN0Y2VudGVyLmRlL2NybC92Mi90Y19jbGFzc18yX2NhX0lJLmNybIaBn2xkYXA6
Ly93d3cudHJ1c3RjZW50ZXIuZGUvQ049VEMlMjBUcnVzdENlbnRlciUyMENsYXNz
JTIwMiUyMENBJTIwSUksTz1UQyUyMFRydXN0Q2VudGVyJTIwR21iSCxPVT1yb290
Y2VydHMsREM9dHJ1c3RjZW50ZXIsREM9ZGU/Y2VydGlmaWNhdGVSZXZvY2F0aW9u
TGlzdD9iYXNlPzANBgkqhkiG9w0BAQUFAAOCAQEAjNfffu4bgBCzg/XbEeprS6iS
GNn3Bzn1LL4GdXpoUxUc6krtXvwjshOg0wn/9vYua0Fxec3ibf2uWWuFHbhOIprt
ZjluS5TmVfwLG4t3wVMTZonZKNaL80VKY7f9ewthXbhtvsPcW3nS7Yblok2+XnR8
au0WOB9/WIFaGusyiC2y8zl3gK9etmF1KdsjTYjKUCjLhdLTEKJZbtOTVAB6okaV
hgWcqRmY5TFyDADiZ9lA4CQze28suVyrZZ0srHbqNZn1l7kPJOzHdiEoZa5X6AeI
dUpWoNIFOqTmjZKILPPy4cHGYdtBxceb9w4aUUXCYWvcZCcXjFq32nQozZfkvQ==
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/2.crl Normal file
View file

Binary file not shown.

29
unikernel/duniverse/ocaml-x509/tests/crl/2.pem Normal file
View file

@ -0,0 +1,29 @@
-----BEGIN CERTIFICATE-----
MIIExTCCA62gAwIBAgIBADANBgkqhkiG9w0BAQUFADB9MQswCQYDVQQGEwJFVTEn
MCUGA1UEChMeQUMgQ2FtZXJmaXJtYSBTQSBDSUYgQTgyNzQzMjg3MSMwIQYDVQQL
ExpodHRwOi8vd3d3LmNoYW1iZXJzaWduLm9yZzEgMB4GA1UEAxMXR2xvYmFsIENo
YW1iZXJzaWduIFJvb3QwHhcNMDMwOTMwMTYxNDE4WhcNMzcwOTMwMTYxNDE4WjB9
MQswCQYDVQQGEwJFVTEnMCUGA1UEChMeQUMgQ2FtZXJmaXJtYSBTQSBDSUYgQTgy
NzQzMjg3MSMwIQYDVQQLExpodHRwOi8vd3d3LmNoYW1iZXJzaWduLm9yZzEgMB4G
A1UEAxMXR2xvYmFsIENoYW1iZXJzaWduIFJvb3QwggEgMA0GCSqGSIb3DQEBAQUA
A4IBDQAwggEIAoIBAQCicKLQn0KuWxfH2H3PFIP8T8mhtxOviteePgQKkotgVvq0
Mi+ITaFgCPS3CU6gSS9J1tPfnZdan5QEcOw/Wdm3zGaLmFIoCQLfxS+EjXqXd7/s
QJ0lcqu1PzKY+7e3/HKE5TWH+VX6ox8Oby4o3Wmg2UIQxvi1RMLQQ3/bvOSiPGpV
eAp3qdjqGTK3L/5cPxvusZjsyq16aUXjlg9V9ubtdepl6DJWk0aJqCWKZQbua795
B9Dxt6/tLE2Su8CoX6dnfQTyFQhwrJLWfQTSM/tMtgsL+xrJxI0DqX5c8lCrEqWh
z0hQpe/SyBoT+rB/sYIcd2oPX9wLlY/vQ37mRQklAgEDo4IBUDCCAUwwEgYDVR0T
AQH/BAgwBgEB/wIBDDA/BgNVHR8EODA2MDSgMqAwhi5odHRwOi8vY3JsLmNoYW1i
ZXJzaWduLm9yZy9jaGFtYmVyc2lnbnJvb3QuY3JsMB0GA1UdDgQWBBRDnDafsJ4w
TcbOX60Qq+UDpfqpFDAOBgNVHQ8BAf8EBAMCAQYwEQYJYIZIAYb4QgEBBAQDAgAH
MCoGA1UdEQQjMCGBH2NoYW1iZXJzaWducm9vdEBjaGFtYmVyc2lnbi5vcmcwKgYD
VR0SBCMwIYEfY2hhbWJlcnNpZ25yb290QGNoYW1iZXJzaWduLm9yZzBbBgNVHSAE
VDBSMFAGCysGAQQBgYcuCgEBMEEwPwYIKwYBBQUHAgEWM2h0dHA6Ly9jcHMuY2hh
bWJlcnNpZ24ub3JnL2Nwcy9jaGFtYmVyc2lnbnJvb3QuaHRtbDANBgkqhkiG9w0B
AQUFAAOCAQEAPDtwkfkEVCeR4e3t/mh/YV3lQWVPMvEYBZRqHN4fcNs+ezICNLUM
bKGKfKX0j//U2K0X1S0E0T9YgOKBWYi+wONGkyT+kL0mojAt6JcmVzWJdJYY9hXi
ryQZVgICsroPFOrGimbBhkVVi76SvpykBMdJPJ7oKXqJ1/6v/2j1pReQvayZzKWG
VwlnRtvWFsJG8eSpUPWP0ZIV018+xgBJOm5YstHRJw0lyDL4IBHNfTIzSJRUTN3c
ecQwn+uOuFW114hcxWokPbLTBQNRxgfvzBRydD1ucs4YKIxKoHflCStFREest2d/
AYoFWpO+ocH/+OcOZ6RHSXZddZAa9SaP8A==
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/20.crl Normal file
View file

Binary file not shown.

28
unikernel/duniverse/ocaml-x509/tests/crl/20.pem Normal file
View file

@ -0,0 +1,28 @@
-----BEGIN CERTIFICATE-----
MIIEqjCCA5KgAwIBAgIOSkcAAQAC5aBd1j8AUb8wDQYJKoZIhvcNAQEFBQAwdjEL
MAkGA1UEBhMCREUxHDAaBgNVBAoTE1RDIFRydXN0Q2VudGVyIEdtYkgxIjAgBgNV
BAsTGVRDIFRydXN0Q2VudGVyIENsYXNzIDMgQ0ExJTAjBgNVBAMTHFRDIFRydXN0
Q2VudGVyIENsYXNzIDMgQ0EgSUkwHhcNMDYwMTEyMTQ0MTU3WhcNMjUxMjMxMjI1
OTU5WjB2MQswCQYDVQQGEwJERTEcMBoGA1UEChMTVEMgVHJ1c3RDZW50ZXIgR21i
SDEiMCAGA1UECxMZVEMgVHJ1c3RDZW50ZXIgQ2xhc3MgMyBDQTElMCMGA1UEAxMc
VEMgVHJ1c3RDZW50ZXIgQ2xhc3MgMyBDQSBJSTCCASIwDQYJKoZIhvcNAQEBBQAD
ggEPADCCAQoCggEBALTgu1G7OVyLBMVMeRwjhjEQY0NVJz/GRcekPewJDRoeIMJW
Ht4bNwcwIi9v8Qbxq63WyKthoy9DxLCyLfzDlml7forkzMA5EpBCYMnMNWju2l+Q
Vl/NHE1bWEnrDgFPZPosPIlY2C8u4rBo6SI7dYnWRBpl8huXJh0obazovVkdKyT2
1oQDZogkAHhg8fir/gKya/si+zXmFtGt9i4S5Po1auUZuV3bOx4a+9P/FRQI2Alq
ukWdFHlgfa9Aigdzs5OW03Q0jTo3Kd5c7PXuLjHCINy+8U9/I1LZW+Jk2ZyqBwi1
Rb3R0DHBq1SfqdLDYmAD8bs5SpJKPQq5ncWg/jcCAwEAAaOCATQwggEwMA8GA1Ud
EwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMB0GA1UdDgQWBBTUovyfs8PYA9NX
XAek0CSnwPIA1DCB7QYDVR0fBIHlMIHiMIHfoIHcoIHZhjVodHRwOi8vd3d3LnRy
dXN0Y2VudGVyLmRlL2NybC92Mi90Y19jbGFzc18zX2NhX0lJLmNybIaBn2xkYXA6
Ly93d3cudHJ1c3RjZW50ZXIuZGUvQ049VEMlMjBUcnVzdENlbnRlciUyMENsYXNz
JTIwMyUyMENBJTIwSUksTz1UQyUyMFRydXN0Q2VudGVyJTIwR21iSCxPVT1yb290
Y2VydHMsREM9dHJ1c3RjZW50ZXIsREM9ZGU/Y2VydGlmaWNhdGVSZXZvY2F0aW9u
TGlzdD9iYXNlPzANBgkqhkiG9w0BAQUFAAOCAQEANmDkcPcGIEPZIxpC8vijsrlN
irTzwppVMXzEO2eatN9NDoqTSheLG43KieHPOh6sHfGcMrSOWXaiQYUlN6AT0PV8
TtXqluJucsG7Kv5sbviRmEb8yRtXW+rIGjs/sFGYPAfaLFkB2otE6OF0/ado3VS6
g0bsyEa1+K+XwDsJHI/OcpY9M1ZwvJbL2NV9IJqDnxrcOfHFcqMRA/07QlIp2+gB
95tejNaNhk4Z+rwcvsUhpYeeeC422wlxo3I0+GzjBgnyXlal092Y+tTmBvTwtiBj
S+opvaqCZh77gaqnN60TGOaSw4HBM7uIHqHn4rS9MWwOUT1v+5ZWgOI2F9Hc5A==
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/21.crl Normal file
View file

Binary file not shown.

27
unikernel/duniverse/ocaml-x509/tests/crl/21.pem Normal file
View file

@ -0,0 +1,27 @@
-----BEGIN CERTIFICATE-----
MIIEXjCCA0agAwIBAgIQRL4Mi1AAIbQR0ypoBqmtaTANBgkqhkiG9w0BAQUFADCB
kzELMAkGA1UEBhMCVVMxCzAJBgNVBAgTAlVUMRcwFQYDVQQHEw5TYWx0IExha2Ug
Q2l0eTEeMBwGA1UEChMVVGhlIFVTRVJUUlVTVCBOZXR3b3JrMSEwHwYDVQQLExho
dHRwOi8vd3d3LnVzZXJ0cnVzdC5jb20xGzAZBgNVBAMTElVUTiAtIERBVEFDb3Jw
IFNHQzAeFw05OTA2MjQxODU3MjFaFw0xOTA2MjQxOTA2MzBaMIGTMQswCQYDVQQG
EwJVUzELMAkGA1UECBMCVVQxFzAVBgNVBAcTDlNhbHQgTGFrZSBDaXR5MR4wHAYD
VQQKExVUaGUgVVNFUlRSVVNUIE5ldHdvcmsxITAfBgNVBAsTGGh0dHA6Ly93d3cu
dXNlcnRydXN0LmNvbTEbMBkGA1UEAxMSVVROIC0gREFUQUNvcnAgU0dDMIIBIjAN
BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA3+5YEKIrblXEjr8uRgnn4AgPLit6
E5Qbvfa2gI5lBZMAHryv4g+OGQ0SR+ysraP6LnD43m77VkIVni5c7yPeIbkFdicZ
D0/Ww5y0vpQZY/KmEQrrU0icvvIpOxboGqBMpsn0GFlowHDyUwDAXlCCpVZvNvlK
4ESGoE1O1kduSUrLZ9emxAW5jh70/P/N5zbgnAVssjMiFdC04MwXwLLA9P4yPykq
lXvY8qdOD1R8oQ2AswkDwf9c3V6aPryuvEeKaq5xyh+xKrhfQgUL7EYw0XILyulW
bfXv33i+Ybqypa4ETLyorGkVl73v67SMvzX41MPRKA5cOp9wGDMgd8SirwIDAQAB
o4GrMIGoMAsGA1UdDwQEAwIBxjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBRT
MtGzz3/64PGgXYVOktKeRR20TzA9BgNVHR8ENjA0MDKgMKAuhixodHRwOi8vY3Js
LnVzZXJ0cnVzdC5jb20vVVROLURBVEFDb3JwU0dDLmNybDAqBgNVHSUEIzAhBggr
BgEFBQcDAQYKKwYBBAGCNwoDAwYJYIZIAYb4QgQBMA0GCSqGSIb3DQEBBQUAA4IB
AQAnNZcAiosovcYzMB4p/OL31ZjUQLtgyr+rFywJNn9Q+kHcrpY6CiM+iVnJowft
Gzet/Hy+UUla3joKVAgWRcKZsYfNjGjgaQPpxE6YsjuMFrMOoAyYUJuTqXAJyCyj
j98C5OBxOvG0I3KgqgHf35g+FFCgMSa9KOlaMCZ1+XtgHI3zzVAmbQQnmt/VDUVH
KWss5nbZqSl9Mt3JNjy9rjXxEZ4du5A/EkdOjtd+D2JzHVImOBwYSf0wdJrE5SIv
2MCN7ZF6TACPcn9d2t0bi0Vr591pl6jFVkwPDPafepE39peC4N1xaf92P2BNPM/3
mfnGV/TJVTl4uix5yaaIK/QI
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/3.crl Normal file
View file

Binary file not shown.

23
unikernel/duniverse/ocaml-x509/tests/crl/3.pem Normal file
View file

@ -0,0 +1,23 @@
-----BEGIN CERTIFICATE-----
MIIDkjCCAnqgAwIBAgIRAIW9S/PY2uNp9pTXX8OlRCMwDQYJKoZIhvcNAQEFBQAw
PTELMAkGA1UEBhMCRlIxETAPBgNVBAoTCENlcnRwbHVzMRswGQYDVQQDExJDbGFz
cyAyIFByaW1hcnkgQ0EwHhcNOTkwNzA3MTcwNTAwWhcNMTkwNzA2MjM1OTU5WjA9
MQswCQYDVQQGEwJGUjERMA8GA1UEChMIQ2VydHBsdXMxGzAZBgNVBAMTEkNsYXNz
IDIgUHJpbWFyeSBDQTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBANxQ
ltAS+DXSCHh6tlJw/W/uz7kRy1134ezpfgSN1sxvc0NXYKwzCkTsA18cgCSR5aiR
VhKC9+Ar9NuuYS6JEI1rbLqzAr3VNsVINyPi8Fo3UjMXEuLRYE2+L0ER4/YXJQyL
kcAbmXuZVg2v7tK8R1fjeUl7NIknJITesezpWE7+Tt9avkGtrAjFGA7v0lPubNCd
EgETjdyAYveVqUSISnFOYFWe2yMZeVYHDD9jC1yw4r5+FfyUM1hBOHTE4Y+L3yas
H7WLO7dDWWuwJKZtkIvEcupdM5i3y95ee++U8Rs+yskhwcWYAqqi9lt3m/V+llU0
HGdpwPFC40es/CgcZlUCAwEAAaOBjDCBiTAPBgNVHRMECDAGAQH/AgEKMAsGA1Ud
DwQEAwIBBjAdBgNVHQ4EFgQU43Mt38sOKAze3bOkynm4jrvoMIkwEQYJYIZIAYb4
QgEBBAQDAgEGMDcGA1UdHwQwMC4wLKAqoCiGJmh0dHA6Ly93d3cuY2VydHBsdXMu
Y29tL0NSTC9jbGFzczIuY3JsMA0GCSqGSIb3DQEBBQUAA4IBAQCnVM+IRBnL39R/
AN9WM2K191EBkOvDP9GIROkkXe/nFL0gt5o8AP5tn9uQ3Nf0YtaLcF3n5QRIqWh8
yfFC82x/xXp8HVGIutIKPidd3i1RTtMTZGnkLuPT55sJmabglZvOGtd/vjzOUrMR
FcEPF80Du5wlFbqidon8BvEY0JNLDnyCt6X09l/+7UCmnYR0ObncHoUW2ikbhiMA
ybuJfm6AiB4vFLQDJKgybwOaRywwvlbGp0ICcBvqQNi6BQNwB6SW//1IMwrh3KWB
kJtN3X3n57LNXMhqlfil9o3EXXgIvnsG1knPGTZQIy4I5p4FTUcY1Rbpsda2ENW7
l7+ijrRU
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/4.crl Normal file
View file

Binary file not shown.

26
unikernel/duniverse/ocaml-x509/tests/crl/4.pem Normal file
View file

@ -0,0 +1,26 @@
-----BEGIN CERTIFICATE-----
MIIEMjCCAxqgAwIBAgIBATANBgkqhkiG9w0BAQUFADB7MQswCQYDVQQGEwJHQjEb
MBkGA1UECAwSR3JlYXRlciBNYW5jaGVzdGVyMRAwDgYDVQQHDAdTYWxmb3JkMRow
GAYDVQQKDBFDb21vZG8gQ0EgTGltaXRlZDEhMB8GA1UEAwwYQUFBIENlcnRpZmlj
YXRlIFNlcnZpY2VzMB4XDTA0MDEwMTAwMDAwMFoXDTI4MTIzMTIzNTk1OVowezEL
MAkGA1UEBhMCR0IxGzAZBgNVBAgMEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4GA1UE
BwwHU2FsZm9yZDEaMBgGA1UECgwRQ29tb2RvIENBIExpbWl0ZWQxITAfBgNVBAMM
GEFBQSBDZXJ0aWZpY2F0ZSBTZXJ2aWNlczCCASIwDQYJKoZIhvcNAQEBBQADggEP
ADCCAQoCggEBAL5AnfRu4ep2hxxNRUSOvkbIgwadwSr+GB+O5AL686tdUIoWMQua
BtDFcCLNSS1UY8y2bmhGC1Pqy0wkwLxyTurxFa70VJoSCsN6sjNg4tqJVfMiWPPe
3M/vg4aijJRPn2jymJBGhCfHdr/jzDUsi14HZGWCwEiwqJH5YZ92IFCokcdmtet4
YgNW8IoaE+oxox6gmf049vYnMlhvB/VruPsUK6+3qszWY19zjNoFmag4qMsXeDZR
rOme9Hg6jc8P2ULimAyrL58OAd7vn5lJ8S3frHRNG5i1R8XlKdH5kBjHYpy+g8cm
ez6KJcfA3Z3mNWgQIJ2P2N7Sw4ScDV7oL8kCAwEAAaOBwDCBvTAdBgNVHQ4EFgQU
oBEKIz6W8Qfs4q8p74Klf9AwpLQwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQF
MAMBAf8wewYDVR0fBHQwcjA4oDagNIYyaHR0cDovL2NybC5jb21vZG9jYS5jb20v
QUFBQ2VydGlmaWNhdGVTZXJ2aWNlcy5jcmwwNqA0oDKGMGh0dHA6Ly9jcmwuY29t
b2RvLm5ldC9BQUFDZXJ0aWZpY2F0ZVNlcnZpY2VzLmNybDANBgkqhkiG9w0BAQUF
AAOCAQEACFb8AvCb6P+k+tZ7xkSAzk/ExfYAWMymtrwUSWgEdujm7l3sAg9g1o1Q
GE8mTgHj5rCl7r+8dFRBv/38ErjHT1r0iWAFf2C3BUrz9vHCv8S5dIa2LX1rzNLz
Rt0vxuBqw8M0Ayx9lt1awg6nCpnBBYurDC/zXDrPbDdVCYfeU0BsWO/8tqtlbgT2
G9w84FoVxp7Z8VlIMCFlA2zs6SFz7JsDoeA3raAVGI/6ugLOpyypEBMs1OUIJqsi
l2D4kF501KKaU73yqWjgom7C12yxow+ev+to51byrvLjKzg6CYG1a4XXvi3tPxq3
smPi9WIsgtRqAEFQ8TmDn5XpNpaYbg==
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/5.crl Normal file
View file

Binary file not shown.

26
unikernel/duniverse/ocaml-x509/tests/crl/5.pem Normal file
View file

@ -0,0 +1,26 @@
-----BEGIN CERTIFICATE-----
MIIEMDCCAxigAwIBAgIQUJRs7Bjq1ZxN1ZfvdY+grTANBgkqhkiG9w0BAQUFADCB
gjELMAkGA1UEBhMCVVMxHjAcBgNVBAsTFXd3dy54cmFtcHNlY3VyaXR5LmNvbTEk
MCIGA1UEChMbWFJhbXAgU2VjdXJpdHkgU2VydmljZXMgSW5jMS0wKwYDVQQDEyRY
UmFtcCBHbG9iYWwgQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkwHhcNMDQxMTAxMTcx
NDA0WhcNMzUwMTAxMDUzNzE5WjCBgjELMAkGA1UEBhMCVVMxHjAcBgNVBAsTFXd3
dy54cmFtcHNlY3VyaXR5LmNvbTEkMCIGA1UEChMbWFJhbXAgU2VjdXJpdHkgU2Vy
dmljZXMgSW5jMS0wKwYDVQQDEyRYUmFtcCBHbG9iYWwgQ2VydGlmaWNhdGlvbiBB
dXRob3JpdHkwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCYJB69FbS6
38eMpSe2OAtp87ZOqCwuIR1cRN8hXX4jdP5efrRKt6atH67gBhbim1vZZ3RrXYCP
KZ2GG9mcDZhtdhAoWORlsH9KmHmf4MMxfoArtYzAQDsRhtDLooY2YKTVMIJt2W7Q
DxIEM5dfT2Fa8OT5kavnHTu86M/0ay00fOJIYRyO82FEzG+gSqmUsE3a56k0enI4
qEHMPJQRfevIpoy3hsvKMzvZPTeL+3o+hiznc9cKV6xkmxnr9A8ECIqsAxcZZPRa
JSKNNCyy9mgdEm3Tih4U2sSPpuIjhdV6Db1q4Ons7Be7QhtnqiXtRYMh/MHJfNVi
PvryxS3T/dRlAgMBAAGjgZ8wgZwwEwYJKwYBBAGCNxQCBAYeBABDAEEwCwYDVR0P
BAQDAgGGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFMZPoj0GY4QJnM5i5ASs
jVy16bYbMDYGA1UdHwQvMC0wK6ApoCeGJWh0dHA6Ly9jcmwueHJhbXBzZWN1cml0
eS5jb20vWEdDQS5jcmwwEAYJKwYBBAGCNxUBBAMCAQEwDQYJKoZIhvcNAQEFBQAD
ggEBAJEVOQMBG2f7Shz5CmBbodpNl2L5JFMn14JkTpAuw0kbK5rc/Kh4ZzXxHfAR
vbdI4xD2Dd8/0sm2qlWkSLoC295ZLhVbO50WfUfXN+pfTXYSNrsf16GBBEYgoyxt
qZ4Bfj8pzgCT3/3JknOJiWSe5yvkHJEs0rnOfc5vMZnT5r7SHpDwCRR5XCOrTdLa
IR9NmXmd4c8nnxCbHIgNsIpkQTG4DmyQJKSbXHGPurt+HBvbaoAPIbzp26a3QPSy
i6mx5O+aGtA9aZnuqCij4Tyz8LIRnM98QObd50N9otg6tamN8jSZxNQQ4Qb9CYQQ
O+7ETPTsJ3xCwnR8gooJybQDJbw=
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/6.crl Normal file
View file

Binary file not shown.

26
unikernel/duniverse/ocaml-x509/tests/crl/6.pem Normal file
View file

@ -0,0 +1,26 @@
-----BEGIN CERTIFICATE-----
MIIEHTCCAwWgAwIBAgIQToEtioJl4AsC7j41AkblPTANBgkqhkiG9w0BAQUFADCB
gTELMAkGA1UEBhMCR0IxGzAZBgNVBAgTEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4G
A1UEBxMHU2FsZm9yZDEaMBgGA1UEChMRQ09NT0RPIENBIExpbWl0ZWQxJzAlBgNV
BAMTHkNPTU9ETyBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTAeFw0wNjEyMDEwMDAw
MDBaFw0yOTEyMzEyMzU5NTlaMIGBMQswCQYDVQQGEwJHQjEbMBkGA1UECBMSR3Jl
YXRlciBNYW5jaGVzdGVyMRAwDgYDVQQHEwdTYWxmb3JkMRowGAYDVQQKExFDT01P
RE8gQ0EgTGltaXRlZDEnMCUGA1UEAxMeQ09NT0RPIENlcnRpZmljYXRpb24gQXV0
aG9yaXR5MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA0ECLi3LjkRv3
UcEbVASY06m/weaKXTuH+7uIzg3jLz8GlvCiKVCZrts7oVewdFFxze1CkU1B/qnI
2GqGd0S7WWaXUF601CxwRM/aN5VCaTwwxHGzUvAhTaHYujl8HJ6jJJ3ygxaYqhZ8
Q5sVW7euNJH+1GImGEaaP+vB+fGQV+useg2L23IwambV4EajcNxo2f8ESIl33rXp
+2dtQem8Ob0y2WIC8bGoPW43nOIv4tOiJovGuFVDiOEjPqXSJDlqR6sA1KGzqSX+
DT+nHbrTUcELpNqsOO9VUCQFZUaTNE8tja3G1CEZ0o7KBWFxB3NH5YoZEr0ETc5O
nKVIrLsm9wIDAQABo4GOMIGLMB0GA1UdDgQWBBQLWOWLxkwVN6RAqTCpIb5HNlpW
/zAOBgNVHQ8BAf8EBAMCAQYwDwYDVR0TAQH/BAUwAwEB/zBJBgNVHR8EQjBAMD6g
PKA6hjhodHRwOi8vY3JsLmNvbW9kb2NhLmNvbS9DT01PRE9DZXJ0aWZpY2F0aW9u
QXV0aG9yaXR5LmNybDANBgkqhkiG9w0BAQUFAAOCAQEAPpiem/Yb6dc5t3iuHXIY
SdOH5EOC6z/JqvWote9VfCFSZfnVDeFs9D6Mk3ORLgLETgdxb8CPOGEIqB6BCsAv
IC9Bi5HcSEW88cbeunZrM8gALTFGTO3nnc+IlP8zwFboJIYmuNg4ON8qa90SzMc/
RxdMosIGlgnW2/4/PEZB31jiVg88O8EckzXZOFKs7sjsLjBOlDW0JB9LeGna8gI4
zJVSk/BwJVmcIGfE7vmLV2H0knZ9P4SNVbfo5azV8fUZVqZa+5Acr5Pr5RzUZ5dd
BA6+C4OmF4O5MBKgxTMVBbkN+8cFduPYSo38NBejxiEovjBFMR7HeL5YYTisO+IB
ZQ==
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/7.crl Normal file
View file

Binary file not shown.

26
unikernel/duniverse/ocaml-x509/tests/crl/7.pem Normal file
View file

@ -0,0 +1,26 @@
-----BEGIN CERTIFICATE-----
MIIEPzCCAyegAwIBAgIBATANBgkqhkiG9w0BAQUFADB+MQswCQYDVQQGEwJHQjEb
MBkGA1UECAwSR3JlYXRlciBNYW5jaGVzdGVyMRAwDgYDVQQHDAdTYWxmb3JkMRow
GAYDVQQKDBFDb21vZG8gQ0EgTGltaXRlZDEkMCIGA1UEAwwbU2VjdXJlIENlcnRp
ZmljYXRlIFNlcnZpY2VzMB4XDTA0MDEwMTAwMDAwMFoXDTI4MTIzMTIzNTk1OVow
fjELMAkGA1UEBhMCR0IxGzAZBgNVBAgMEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4G
A1UEBwwHU2FsZm9yZDEaMBgGA1UECgwRQ29tb2RvIENBIExpbWl0ZWQxJDAiBgNV
BAMMG1NlY3VyZSBDZXJ0aWZpY2F0ZSBTZXJ2aWNlczCCASIwDQYJKoZIhvcNAQEB
BQADggEPADCCAQoCggEBAMBxM4KK0HDrc4eCQNUd5MvJDkKQ+d40uaG6EfQlhfPM
cm3ye5drswfxdySRXyWP9nQ95IDC+DwN879A6vfIUtFyb+/Iq0G4bi4XKpVpDM3S
HpR7LZQdqnXXs5jLrLxkU0C8j6ysNstcrbvd4JQX7NFc0L/vpZXJkMWwrPsbQ996
CF23uPJAGysnnlDOXmWCiIxe004MeuoIkbY2qitC++rCoznl2yY4rYsK7hljxxwk
3wN42ubqwUcaCwtGCd0C/N7Lh1/XMGNooa7cMqG6vv5Eq2i2pRcV/b3Vp6ea5EQz
6YiO/O1R65NxTq0B50SOqy3LqP4BSUjwwN3HaNiS/j0CAwEAAaOBxzCBxDAdBgNV
HQ4EFgQUPNiTiMLAggnMAZkGkyDpnnAJY08wDgYDVR0PAQH/BAQDAgEGMA8GA1Ud
EwEB/wQFMAMBAf8wgYEGA1UdHwR6MHgwO6A5oDeGNWh0dHA6Ly9jcmwuY29tb2Rv
Y2EuY29tL1NlY3VyZUNlcnRpZmljYXRlU2VydmljZXMuY3JsMDmgN6A1hjNodHRw
Oi8vY3JsLmNvbW9kby5uZXQvU2VjdXJlQ2VydGlmaWNhdGVTZXJ2aWNlcy5jcmww
DQYJKoZIhvcNAQEFBQADggEBAIcBbSMdflsXfcFhMs+P5/OKlFlm4J4oqF7Tt/Q0
5qo5spcWxYJvMqTpjOev/e/C6LlLqqP05tqNZSH7uoDrJiiFGv45jN5bBAS0VPmj
Z55B+glSzAVIqMk/IQQezkhr/IXownuvf7fM+F86/TXGDe+X3EyrEeFryzHRbPtI
gKvcnDe4IRRLDXE97IMzbtFuMhbsmMcWi1mmNKsFVy2T96oTy9IT4rcuO81rUBcJ
aD61JlfutuC23bkpgHl9j6PwpCikFcSF9CfUa7/lXORlAnZUtOM3ZiTTGWHIUhDl
izeauan5Hb/qmZJhlv8BzaFfDbxxvA6sCx1HRR3B7Hzs/Sk=
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/8.crl Normal file
View file

Binary file not shown.

26
unikernel/duniverse/ocaml-x509/tests/crl/8.pem Normal file
View file

@ -0,0 +1,26 @@
-----BEGIN CERTIFICATE-----
MIIEQzCCAyugAwIBAgIBATANBgkqhkiG9w0BAQUFADB/MQswCQYDVQQGEwJHQjEb
MBkGA1UECAwSR3JlYXRlciBNYW5jaGVzdGVyMRAwDgYDVQQHDAdTYWxmb3JkMRow
GAYDVQQKDBFDb21vZG8gQ0EgTGltaXRlZDElMCMGA1UEAwwcVHJ1c3RlZCBDZXJ0
aWZpY2F0ZSBTZXJ2aWNlczAeFw0wNDAxMDEwMDAwMDBaFw0yODEyMzEyMzU5NTla
MH8xCzAJBgNVBAYTAkdCMRswGQYDVQQIDBJHcmVhdGVyIE1hbmNoZXN0ZXIxEDAO
BgNVBAcMB1NhbGZvcmQxGjAYBgNVBAoMEUNvbW9kbyBDQSBMaW1pdGVkMSUwIwYD
VQQDDBxUcnVzdGVkIENlcnRpZmljYXRlIFNlcnZpY2VzMIIBIjANBgkqhkiG9w0B
AQEFAAOCAQ8AMIIBCgKCAQEA33FvNlhTWvI2VFeAxHQIIO0Yfyod5jWaHiWsnOWW
fnJSoBVC21ndZHoa0Lh73TkVvFVIxO06AOoxEbrycXQaZ7jPM8yoMa+j49d/vzMt
TGo87IvDktJTdyR0nAducPy9C1t2ul/y/9c3S0pgePfw+spwtOpZqqPOSC+pw7IL
fhdyFgymBwwbOM/JYrc/oJOlh0Hyt3BAd9i+FHzjqMB6juljatEPmsbS9Is6FARW
1O24zG71++IsWL1/T2sr92AkWCTOJu80kTrV44HQsvAEAtdbtz6SrGsSivnkBbA7
kUlcsutT6vifR4buv5XAwAaf0lteERv0xwQ1KdJVXOTt6wIDAQABo4HJMIHGMB0G
A1UdDgQWBBTFe1i97doladL3WRaoszLAeydb9DAOBgNVHQ8BAf8EBAMCAQYwDwYD
VR0TAQH/BAUwAwEB/zCBgwYDVR0fBHwwejA8oDqgOIY2aHR0cDovL2NybC5jb21v
ZG9jYS5jb20vVHJ1c3RlZENlcnRpZmljYXRlU2VydmljZXMuY3JsMDqgOKA2hjRo
dHRwOi8vY3JsLmNvbW9kby5uZXQvVHJ1c3RlZENlcnRpZmljYXRlU2VydmljZXMu
Y3JsMA0GCSqGSIb3DQEBBQUAA4IBAQDIk4E7ibSvuIQSTI3S8NtwuleGFTQQuS9/
HrCoiWChisJ3DFBKmwCL2Iv0QeLQg4pKHBQGsKNoBXAxMKdTmw7pSqBYaWcOrp32
pSxBvzwGa+RZzG0Q8ZZvH9/0BAKkn0U+yNj6NkZEUD+Cl5EfKNsYEYwq5GWDVxIS
jBc/lDb+XbDABHcTuPQV1T84zJQ6VdCsmPW6AF/ghhmBeC8owH7TzEIK9a5QoNE+
xqFx7D+gIIxmOom0jtTYsU0lR+4viMi14QVFwL4Ucd56/Y57fU0IlqUSc/Atyjcn
dBInTMu2l+nZrghtWjlA3QVHdWpaIbOjGM9O9y5Xt5hwXsjEeLBi
-----END CERTIFICATE-----

BIN
unikernel/duniverse/ocaml-x509/tests/crl/9.crl Normal file
View file

Binary file not shown.

23
unikernel/duniverse/ocaml-x509/tests/crl/9.pem Normal file
View file

@ -0,0 +1,23 @@
-----BEGIN CERTIFICATE-----
MIIDkzCCAnugAwIBAgIQFBOWgxRVjOp7Y+X8NId3RDANBgkqhkiG9w0BAQUFADA0
MRMwEQYDVQQDEwpDb21TaWduIENBMRAwDgYDVQQKEwdDb21TaWduMQswCQYDVQQG
EwJJTDAeFw0wNDAzMjQxMTMyMThaFw0yOTAzMTkxNTAyMThaMDQxEzARBgNVBAMT
CkNvbVNpZ24gQ0ExEDAOBgNVBAoTB0NvbVNpZ24xCzAJBgNVBAYTAklMMIIBIjAN
BgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA8ORUaSvTx49qROR+WCf4C9DklBKK
8Rs4OC8fMZwG1Cyn3gsqrhqg455qv588x26i+YtkbDqthVVRVKU4VbirgwTyP2Q2
98CNQ0NqZtH3FyrV7zb6MBBC11PN+fozc0yz6YQgitZBJzXkOPqUm7h65HkfM/sb
2CEJKHxNGGleZIp6GZPKfuzzcuc3B1hZKKxC+cX/zT/npfo4sdAMx9lSGlPWgcxC
ejVb7Us6eva1jsz/D3zkYDaHL63woSV9/9JLEYhwVKZBqGdTUkJe5DSe5L6j7Kpi
Xd3DTKaCQeQzC6zJMw9kglcq/QytNuEMrkvF7zuZ2SOzW120V+x0cAwqTwIDAQAB
o4GgMIGdMAwGA1UdEwQFMAMBAf8wPQYDVR0fBDYwNDAyoDCgLoYsaHR0cDovL2Zl
ZGlyLmNvbXNpZ24uY28uaWwvY3JsL0NvbVNpZ25DQS5jcmwwDgYDVR0PAQH/BAQD
AgGGMB8GA1UdIwQYMBaAFEsBmz5WGmU2dst7l6qSBe4y5ygxMB0GA1UdDgQWBBRL
AZs+VhplNnbLe5eqkgXuMucoMTANBgkqhkiG9w0BAQUFAAOCAQEA0Nmlfv4pYEWd
foPPbrxHbvUanlR2QnG0PFg/LUAlQvaBnPGJEMgOqnhPOAlXsDzACPw1jvFIUY0M
cXS6hMTXcpuEfDhOZAYnKuGntewImbQKDdSFc8gS4TXt8QUxHXOZDOuWyt3T5oWq
8Ir7dcHyCTxlZWTzTNity4hp8+SDtwy9F1qWF8pb/627HOkthIDYIb6FUtnUdLlp
hbpN7Sgy6/lhSuTENh4Z3G+EER+V9YMoGKgzkkMn3V0TBEVPh9VGzT2ouvDzuFYk
Res3x+F2T3I5GN9+dHLHcy056mDmrRGiVod7w2ia/viMcKjfZTL0pECMocJEAw6U
AGegcQCCSA==
-----END CERTIFICATE-----

61
unikernel/duniverse/ocaml-x509/tests/crltests.ml Normal file
View file

@ -0,0 +1,61 @@
open X509
let of_ic ic =
let ln = in_channel_length ic in
let rs = Bytes.create ln in
really_input ic rs 0 ln;
Bytes.unsafe_to_string rs
let with_loaded_files file ~f =
let pre = "./crl/" in
let fullpath1 = pre ^ file ^ ".pem"
and fullpath2 = pre ^ file ^ ".crl"
in
let fd1 = open_in fullpath1
and fd2 = open_in fullpath2
in
let buf1 = of_ic fd1
and buf2 = of_ic fd2
in
try let r = f buf1 buf2 in close_in fd1 ; close_in fd2 ;
match r with
| Ok x -> x
| Error (`Msg e) -> Alcotest.failf "decoding error %s" e
with e -> close_in fd1 ; close_in fd2 ;
Alcotest.failf "exception %s" (Printexc.to_string e)
let allowed_hashes = [ `SHA1 ; `SHA256 ; `SHA384 ; `SHA512 ]
let one f () =
with_loaded_files f ~f:(fun cert crl ->
let ( let* ) = Result.bind in
let* cert = Certificate.decode_pem cert in
let pubkey = Certificate.public_key cert in
let* crl = CRL.decode_der crl in
Result.map_error
(fun e -> `Msg (Fmt.to_to_string Validation.pp_signature_error e))
(CRL.validate crl ~allowed_hashes pubkey))
let crl_tests = [
"CRL 1 is good", `Quick, one "1" ;
"CRL 2 is good", `Quick, one "2" ;
"CRL 3 is good", `Quick, one "3" ;
"CRL 4 is good", `Quick, one "4" ;
"CRL 5 is good", `Quick, one "5" ;
"CRL 6 is good", `Quick, one "6" ;
"CRL 7 is good", `Quick, one "7" ;
"CRL 8 is good", `Quick, one "8" ;
"CRL 9 is good", `Quick, one "9" ;
"CRL 10 is good", `Quick, one "10" ;
"CRL 11 is good", `Quick, one "11" ;
"CRL 12 is good", `Quick, one "12" ;
"CRL 13 is good", `Quick, one "13" ;
"CRL 14 is good", `Quick, one "14" ;
"CRL 15 is good", `Quick, one "15" ;
"CRL 16 is good", `Quick, one "16" ;
"CRL 17 is good", `Quick, one "17" ;
"CRL 18 is good", `Quick, one "18" ;
"CRL 19 is good", `Quick, one "19" ;
"CRL 20 is good", `Quick, one "20" ;
"CRL 21 is good", `Quick, one "21" ;
]

17
unikernel/duniverse/ocaml-x509/tests/csr/wild-bar.pem Normal file
View file

@ -0,0 +1,17 @@
-----BEGIN CERTIFICATE REQUEST-----
MIICrDCCAZQCAQAwEjEQMA4GA1UEAwwHZm9vLmNvbTCCASIwDQYJKoZIhvcNAQEB
BQADggEPADCCAQoCggEBAMQibfgxbLeWXHbhy9olGapJd7zUQXWmbMkVUF0BWWaI
2BmdYHJYhupoK3kY5NQL/ghz3TwHU+K8lKMzQt0sX0w44VzHv8hG8wYHEjKvyL81
o97c/eYxT703oGu1h9WwtwtRVOcZB+hHaQej/KYBJ3Npsy/gtMwnkCMIZrNziBR/
6OHH2DmZ/k02tMdFGkcAuUFpnHQoRUr7xdh204lXbb6vvg7dnntZpW79Q3e2CZSZ
Sbb3Q5AD2jQ+qO8A/78hExnpesH8vl9AjGNdM/XUlRwXmkj2SRsKd8RBg75GC8nr
xyjCb3EmUAWJaQwDaaj4Wsqtu48D1QLDGfXjdjC2qvMCAwEAAaBVMFMGCSqGSIb3
DQEJDjFGMEQwQgYDVR0RBDswOYITeW91ci1uZXctZG9tYWluLmNvbYIXd3d3Lnlv
dXItbmV3LWRvbWFpbi5jb22CCSouYmFyLmNvbTANBgkqhkiG9w0BAQsFAAOCAQEA
iKYGNYylPp0qMdxYvS1tIlzGSLs8NA2H9vzohlBPaqU0yYrUh7YwDoDtWjkofBax
fxJsZlO9wBCGNMaTwNxx3uvJ0mPhlQDJvBFcTeOaUwH7Fys2/DKI5JylXEnGbzzk
pw4SqOblw+yGoossvpSWEaXvwX+XiLa3JpMWOT6E+qSqRUUKoJz8tHXBel1T0tL3
SSpSeTBELAkwXV/BWmY8HmsphKGGUKVvdIRrgR7YWMGEU3TR3VhTayc5EO1HpEB7
gZqaVwT29OnQYRfM9EbXRYnqX2guiM/KoouSoLy9NhyVawoOqfAaf6Ysl5JayNL9
QFkrH58zDK3hkOVni7NQ4g==
-----END CERTIFICATE REQUEST-----

15
unikernel/duniverse/ocaml-x509/tests/csr/wild-foo-cn.pem Normal file
View file

@ -0,0 +1,15 @@
-----BEGIN CERTIFICATE REQUEST-----
MIICWTCCAUECAQAwFDESMBAGA1UEAwwJKi5mb28uY29tMIIBIjANBgkqhkiG9w0B
AQEFAAOCAQ8AMIIBCgKCAQEA1IoUG5fJRRxiYDxhZa5BPv7SWN9LDVD6DJ3F4cLx
rbcXOooeCbbAIbBdmeVDa/kuHdFDb0ug69w+qRehi1NSJE2Q7JDAWg7hxWFnWKjB
BD3Dlv6RJ90ClFUXhkJsoZbgOQaMAq4O6sC6YhGTw6L4QrkgZS+1xyERfQqa951q
QHbXLFBsi/Ek/DGzphDuuSA7vbIwHKYQ4UXQTcPmCs+i/FxHd3bMkV0iHVD6xS6h
la3k4YYi7Kr0QRbRxEvqGbVOqivPP4IFg3ZCItASLTbKGUFCgKvB9gspbFpc0eUH
sr+NNoRuRq5mjaGmcHMLfY8KH2nxxKTQFh+cE6z30YQfHwIDAQABoAAwDQYJKoZI
hvcNAQELBQADggEBAFHU22XEkexb31Wug07xi/QvNjDapeuhO+pzhSQ5lt3E2arU
eQJqaMcl3Kzon93u8Hp5vcc48rBFe69xl/VTlwPTW4wt98MQKu7jgv2QDeH+Sq3+
b1wmMAslc+ORXlRFAk7U9bjHHMP6BN7l2C2ujBw6iK3OmiBfI4M3Si2PxCzVXReJ
IMgUZOwa6BBmQ5D1a6njJiJCSMY2T0ttXU4e1/KxURYcvtzLxySxlbyvfwCtqNSY
EMIiBxrfjIaLZ8CG4ybF9STqQP9B9s3NdiDJ7RQsXF1xlQrtXH88/YpW8Pf5u9O/
Ajf2IL7UZnriamhlAV3hofWiDJbqmh4n/9u14qs=
-----END CERTIFICATE REQUEST-----

21
unikernel/duniverse/ocaml-x509/tests/csr/your-new-domain-raw.pem Normal file
View file

@ -0,0 +1,21 @@
-----BEGIN CERTIFICATE REQUEST-----
MIIDYDCCAkgCAQAwgdAxCzAJBgNVBAYTAlVTMREwDwYDVQQIDAhOZXcgWW9yazES
MBAGA1UEBwwJUm9jaGVzdGVyMRIwEAYDVQQKDAlFbmQgUG9pbnQxFzAVBgNVBAsM
DlRlc3RpbmcgRG9tYWluMUswSQYJKoZIhvcNAQkBFjx5b3VyLWFkbWluaXN0cmF0
aXZlLWFkZHJlc3NAeW91ci1hd2Vzb21lLWV4aXN0aW5nLWRvbWFpbi5jb20xIDAe
BgNVBAMMF3d3dy55b3VyLW5ldy1kb21haW4uY29tMIIBIjANBgkqhkiG9w0BAQEF
AAOCAQ8AMIIBCgKCAQEAzARXVEb2i5eR/bhyFrO34kQ4tdFK72j3hUMTRs2hdvUw
LxKQPcRA+XeXdbJHiLXEJHHn0cd+7FQB1DPMCzEZY6eJGDi3iwaeZ/ybiHEcoNqH
5xV4QSNUaDfNzrSOnTRvhfg8Bn/YTCRaDhwxVZt0nU8p4ntrFieCyMD0Js70uFAM
KAo4HWjd576jhL3fYROBWiwttP3JPJPzYjsvF7kgYeckfw88ORkrFxxxKaLZCtmr
chDKZRQa6qu6Pd9KQFw2W+F9JzbYVTwiR2RmS9kqP7iajpNvKJTWVDM7Ixdw/lTd
jOHYzoPFqbgVtjbNRwo1eNvqJbTcV/NCYJvj3s/KfQIDAQABoEowSAYJKoZIhvcN
AQkOMTswOTA3BgNVHREEMDAughN5b3VyLW5ldy1kb21haW4uY29tghd3d3cueW91
ci1uZXctZG9tYWluLmNvbTANBgkqhkiG9w0BAQsFAAOCAQEAss2p+UK+ZygWtiKm
HBKTqjRHwUKO485uNG2XBIQJzKOYjvRj2vA7qCi2Hb1Pr1ReWY29oqMXN1RdMrcb
Ic+Wt4Jxipg8Pu5O/+cQNc49D8U2umpY99nO/DMkjKVAhbOOFwTqahcPfrKuTOpb
UC7KzVcYi3HFoSdRRJ7Cf3bpxKIJjl2ju/8Tay4+zEYsJgdBEqTcMw4RhaD8T0vB
h0n1Bt5cE6Meic2+gaz4sIhAiFH9oH4lJutcWoRxXEAwMorFk7DlzrGzc1XB2oqI
KXczg1QAUmAGNq4gyQ1F3czq94XYtNGsUT644lS3Fh8hGIQUI7gYNAGY7Niba1YM
KfAccQ==
-----END CERTIFICATE REQUEST-----

17
unikernel/duniverse/ocaml-x509/tests/csr/your-new-domain.pem Normal file
View file

@ -0,0 +1,17 @@
-----BEGIN CERTIFICATE REQUEST-----
MIICsTCCAZkCAQAwIjEgMB4GA1UEAwwXd3d3LnlvdXItbmV3LWRvbWFpbi5jb20w
ggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQD55xIzpxhQ5Jgz7mc5kZzQ
OiRRuOAx392yBlr0T36rYSpOObwmQtdNou4ireQXIQ27U/t4Kiw4n2xStCSOK2EP
mxgC0JrlL7w7dRDfy4kChzzxoyRVR55VOejhR5XGLy67BchyMCI+pt/0cWCpECrK
UorOgm5eHLDt0djtqaPtdqjwSiiPX/bK3+8vg8NwRvyBekC41znWoTwMNH1FDCHa
/mOQT75c3gmIaUVYBD/yEM5EWEgpkQSSsIi6XynbeAZCeDodNJQt2c7z1iYPHw1Q
wJqLBKrGsGfKlnfF0THf9hzndBEh+RSF1uvt5NbsPHMD5AZEClOwBoJ34IltR1wV
AgMBAAGgSjBIBgkqhkiG9w0BCQ4xOzA5MDcGA1UdEQQwMC6CE3lvdXItbmV3LWRv
bWFpbi5jb22CF3d3dy55b3VyLW5ldy1kb21haW4uY29tMA0GCSqGSIb3DQEBCwUA
A4IBAQDBaQbBgdtWV2+Xzd6AvfnCl1lE8NNyZBNOmhL5yotJhPqKgByzHjCd1pBV
guGd941hVNDqPbrKWbeUf1zgaX/oN2HbbedisH2ntocs4UWsAD2cDzh3P8aE3ixX
JgjnqmMKwLQHupFVIFHOY/9UgFcc+fgvQkOGiJWpB1AYds/++Ucn5SmPEIbJmXBN
9+tL2vCH0Dd4rV22SfpENqKf1whFjJEDrrvwwlj9eQjkaqm7APi2ypiTiMDQvzr1
nDszGkTwXQCRto4NSNSexAWQhH00iI/jqssjVVhrwCTfJfEMP8BIf2+ONAWmAoxC
ttuCrpcG94ErCLrrCHpMRiy5iLKO
-----END CERTIFICATE REQUEST-----

10
unikernel/duniverse/ocaml-x509/tests/custom_pp/custom_pp.expected Normal file
View file

@ -0,0 +1,10 @@
Certificate: X.509 certificate
version 3
serial 00d7 9549 bd1a 6717 51
algorithm ECDSA-SHA256
issuer /CN=FT FIDO 0200
valid from 2019-02-26 00:00:00 +00:00 until 2034-02-25 23:59:59 +00:00
subject /CN=FT FIDO P2047001341412
extensions id-fido-u2f-ce-transports NFC,USB,BluetoothLowEnergy
subjectKeyIdentifier 525e a96c 47b9 a479 33a0 9b48 71c3 98df 6407 aaa4

58
unikernel/duniverse/ocaml-x509/tests/custom_pp/custom_pp.ml Normal file
View file

@ -0,0 +1,58 @@
let fido_u2f_transport_oid =
Asn.OID.(base 1 3 <| 6 <| 1 <| 4 <| 1 <| 45724 <| 2 <| 1 <| 1)
let fido_u2f_transport_oid_name = "id-fido-u2f-ce-transports"
type transport = [
| `Bluetooth_classic
| `Bluetooth_low_energy
| `Usb
| `Nfc
| `Usb_internal
]
let pp_transport ppf = function
| `Bluetooth_classic -> Fmt.string ppf "BluetoothClassic"
| `Bluetooth_low_energy -> Fmt.string ppf "BluetoothLowEnergy"
| `Usb -> Fmt.string ppf "USB"
| `Nfc -> Fmt.string ppf "NFC"
| `Usb_internal -> Fmt.string ppf "USBInternal"
let transports =
let opts = [
(0, `Bluetooth_classic);
(1, `Bluetooth_low_energy);
(2, `Usb);
(3, `Nfc);
(4, `Usb_internal);
] in
Asn.S.bit_string_flags opts
let decode_transports cs =
match Asn.decode (Asn.codec Asn.der transports) cs with
| Ok (a, cs) ->
if String.length cs = 0 then Ok a else Error (`Msg "trailing bytes")
| Error (`Parse msg) -> Error (`Msg msg)
let custom_pp ppf (oid, data) =
if Asn.OID.equal oid fido_u2f_transport_oid then
match decode_transports data with
| Error `Msg _e ->
Fmt.pf ppf "%s invalid-data" fido_u2f_transport_oid_name
| Ok transports ->
Fmt.pf ppf "%s %a" fido_u2f_transport_oid_name Fmt.(list ~sep:(any ",") pp_transport) transports
else
Fmt.pf ppf "unsupported %a: %a" Asn.OID.pp oid (Ohex.pp_hexdump ()) data
let () =
let fullpath = "../testcertificates/fido.pem" in
let fd = open_in fullpath in
let ln = in_channel_length fd in
let buf = Bytes.create ln in
really_input fd buf 0 ln;
close_in_noerr fd;
let buf = Bytes.unsafe_to_string buf in
match X509.Certificate.decode_pem buf with
| Error `Msg e -> failwith e
| Ok cert ->
Format.printf "Certificate: %a\n" (X509.Certificate.pp' custom_pp) cert

12
unikernel/duniverse/ocaml-x509/tests/custom_pp/dune Normal file
View file

@ -0,0 +1,12 @@
(executable
(name custom_pp)
(modules custom_pp)
(libraries x509 asn1-combinators fmt))
(rule
(with-stdout-to custom_pp.output (run ./custom_pp.exe)))
(rule
(alias runtest)
(deps (source_tree ../testcertificates))
(action (diff custom_pp.expected custom_pp.output)))

4
unikernel/duniverse/ocaml-x509/tests/dune Normal file
View file

@ -0,0 +1,4 @@
(test
(name tests)
(deps (source_tree regression) (source_tree testcertificates) (source_tree crl) (source_tree csr) (source_tree pkcs12) (source_tree ocsp))
(libraries x509 alcotest ptime.clock.os mirage-crypto-pk mirage-crypto-ec mirage-crypto-rng.unix))

128
unikernel/duniverse/ocaml-x509/tests/ocsp.ml Normal file
View file

@ -0,0 +1,128 @@
open X509
(*
How files for test1 were generated:
key.pem:
openssl genpkey -algorithm RSA -out key.pem -outform PEM
certificate.pem:
openssl req -new -x509 -days 3650 -key key.pem -out certificate.pem -subj '/CN=example.com/' -sha256
test1.pem:
openssl req -new -key key.pem -nodes -out test1.csr \
-subj '/CN=test1.example.com/'
openssl x509 -req -days 3650 -in test1.csr -CA certificate.pem \
-CAkey key.pem -set_serial 10000 -out test1.pem
openssl x509 -in test1.pem -noout -text
request.der:
openssl ocsp -issuer certificate.pem \
-cert test1.pem \
-no_nonce -reqout request.der
openssl ocsp -reqin request.der -text
response.der:
openssl ocsp -index index.txt -rsigner certificate.pem \
-rkey key.pem -CA certificate.pem \
-reqin request.der -respout response.der
openssl ocsp -respin response.der -CAfile certificate.pem -text
*)
let mmap file =
let ic = open_in file in
let ln = in_channel_length ic in
let rs = Bytes.create ln in
really_input ic rs 0 ln;
close_in ic;
Bytes.unsafe_to_string rs
let data file = mmap ("./ocsp/" ^ file)
let responder_cert = match Certificate.decode_pem (data "certificate.pem") with
| Ok c -> c
| Error _ -> assert false
let responder_dn = Certificate.subject responder_cert
let test1_serial = "\x27\x10"
let responder_key = match Private_key.decode_pem (data "key.pem") with
| Ok k -> k
| Error _ -> assert false
let cert_dn_testable = Alcotest.testable Distinguished_name.pp Distinguished_name.equal
let test_request () =
let open OCSP.Request in
match decode_der (data "request.der") with
| Error _ -> Alcotest.fail "could not decode OCSP request"
| Ok request ->
(* Fmt.pr "request=%a" pp request; *)
(* TODO: verify *)
match cert_ids request with
| [certid] ->
let serialNumber = OCSP.cert_id_serial certid in
Alcotest.(check string __LOC__ test1_serial serialNumber)
| _ -> Alcotest.fail "something wrong with OCSP request"
let test_response () =
let open OCSP.Response in
match decode_der (data "response.der") with
| Error e ->
Alcotest.failf "could not decode OCSP response: %a" Asn.pp_error e
| Ok response ->
(* Fmt.pr "response=%a" pp response; *)
(match validate response (Private_key.public responder_key) with
| Ok () -> ()
| Error _ -> Alcotest.fail "cannot verify the signature of OCSP response");
let responder = match responder_id response with
| Ok (`ByName r) -> r
| Ok _ -> Alcotest.fail "expected responder identifyed by name"
| Error (`Msg e) -> Alcotest.fail e
in
let response = match responses response with
| Ok [r] -> r
| Ok _ -> Alcotest.fail "must be exactly one response"
| Error (`Msg e) -> Alcotest.fail e
in
let certid = single_response_cert_id response in
let serialNumber = OCSP.cert_id_serial certid in
Alcotest.(check string __LOC__ test1_serial serialNumber);
Alcotest.(check cert_dn_testable __LOC__ responder responder_dn)
let test_simple_responder () =
match OCSP.Request.decode_der (data "request.der") with
| Error _ -> Alcotest.fail "could not decode OCSP request"
| Ok request ->
let certids = OCSP.Request.cert_ids request in
let now = Ptime_clock.now () in
let response_logic cert_id =
let serial = OCSP.cert_id_serial cert_id in
let cert_status =
if String.equal test1_serial serial then
`Revoked (now, None)
else
`Good
in
OCSP.Response.create_single_response cert_id cert_status now
in
let responses = List.map response_logic certids in
let responder_id = `ByName responder_dn in
(* Fmt.pr "keytype = %a" Key_type.pp (Private_key.key_type responder_key); *)
match OCSP.Response.create_success ~certs:[responder_cert] responder_key responder_id now responses with
| Error (`Msg e) -> Alcotest.fail e
| Ok resp ->
match OCSP.Response.validate resp (Private_key.public responder_key) with
| Ok () -> ()
| Error e ->
let pp_e ppf = function
| #Validation.signature_error as e -> X509.Validation.pp_signature_error ppf e
| `No_signature -> Fmt.string ppf "no signature"
| `Time_invalid -> Fmt.string ppf "time invalid"
in
Alcotest.failf "cannot verify the signature of OCSP response: %a" pp_e e
let tests = [
"OpenSSL request", `Quick, test_request ;
"OpenSSL response", `Quick, test_response ;
"Simple OCSP responder", `Quick, test_simple_responder ;
]

14
unikernel/duniverse/ocaml-x509/tests/ocsp/certificate.pem Normal file
View file

@ -0,0 +1,14 @@
-----BEGIN CERTIFICATE-----
MIICDDCCAW+gAwIBAgIIQcOa7kqxp9cwCgYIKoZIzj0EAwQwFjEUMBIGA1UEAwwL
ZXhhbXBsZS5jb20wHhcNMjEwNDA0MTcwMTU3WhcNMjIwNDA0MTcwMTU3WjAWMRQw
EgYDVQQDDAtleGFtcGxlLmNvbTCBmzAQBgcqhkjOPQIBBgUrgQQAIwOBhgAEAXIK
VyKRhKOJjxXQtKJiTX9nM3lZs6qy632NYmG9BwJ74FidW1NYlT0eiN71nMHU9FOH
BZ76AH0ISrbo3hjG7uFzAPMplhTwTlA7IcQoR8FOGjrN0w+H5YJZRtkfYU0hFETU
F4quomVmbrxtcIgFRWLJdf7qciYYJyYc8ZlTZoHpZY02o2QwYjAdBgNVHQ4EFgQU
nku+GxZTewB6/D2bJFQcOkBN4QMwDwYDVR0PAQH/BAUDAwfGADAPBgNVHRMBAf8E
BTADAQH/MB8GA1UdIwQYMBaAFJ5LvhsWU3sAevw9myRUHDpATeEDMAoGCCqGSM49
BAMEA4GKADCBhgJBfZBX4o5Df/fJUnzmQKo6KFFWlc70VkO3hXH6lUhVRLcT+Ame
6gJUjgYy65GryW4Tx/pFTI7tdX19UDm+kBvgv1sCQRIgxgt/eJ74VsRgt7Br3Smm
px1uULyS4PIGBKT4O4C4bWS1wdzw8ZOlegss1+pkxYYrfJFNJYyBaqY0ScTpvE4F
-----END CERTIFICATE-----
----

1
unikernel/duniverse/ocaml-x509/tests/ocsp/index.txt Normal file
View file

@ -0,0 +1 @@
V 260517090452Z 2710 unknown /CN=test1.example.com/

5
unikernel/duniverse/ocaml-x509/tests/ocsp/key.pem Normal file
View file

@ -0,0 +1,5 @@
-----BEGIN PRIVATE KEY-----
MGACAQAwEAYHKoZIzj0CAQYFK4EEACMESTBHAgEBBEIAtmFgIVel9k9Ivp7S5Mlc
adxdv3KvDHc1j787n4avTUpzk+Aj7g0zxen7UsBOk2q/EGbZbtVFsO4zdOvPqP1+
m94=
-----END PRIVATE KEY-----

BIN
unikernel/duniverse/ocaml-x509/tests/ocsp/request.der Normal file
View file

Binary file not shown.

BIN
unikernel/duniverse/ocaml-x509/tests/ocsp/response.der Normal file
View file

Binary file not shown.

11
unikernel/duniverse/ocaml-x509/tests/ocsp/test1.pem Normal file
View file

@ -0,0 +1,11 @@
-----BEGIN CERTIFICATE-----
MIIBozCCAQQCAicQMAoGCCqGSM49BAMCMBYxFDASBgNVBAMMC2V4YW1wbGUuY29t
MB4XDTIxMDUxOTE0NDIxMFoXDTMxMDUxNzE0NDIxMFowHDEaMBgGA1UEAwwRdGVz
dDEuZXhhbXBsZS5jb20wgZswEAYHKoZIzj0CAQYFK4EEACMDgYYABAFyClcikYSj
iY8V0LSiYk1/ZzN5WbOqsut9jWJhvQcCe+BYnVtTWJU9Hoje9ZzB1PRThwWe+gB9
CEq26N4Yxu7hcwDzKZYU8E5QOyHEKEfBTho6zdMPh+WCWUbZH2FNIRRE1BeKrqJl
Zm68bXCIBUViyXX+6nImGCcmHPGZU2aB6WWNNjAKBggqhkjOPQQDAgOBjAAwgYgC
QgCAu0cwvmP9SIfsbv17zFpoEPvBRc6UH4La7iVmq/un8N5qcBnTNsY3CNzXkT68
P9XQhBzqZOvUIkjw0UgVPk8uvwJCAWXwCHa3nw0C/4qrlm3IIRjWAwygXojPHOxu
Y+XLaPIpLLja2BzfP4uHWlyJAvZW/1SiMuFFv19ICbGmnRQdQyDY
-----END CERTIFICATE-----

64
unikernel/duniverse/ocaml-x509/tests/pkcs12.ml Normal file
View file

@ -0,0 +1,64 @@
open X509
let mmap file =
let ic = open_in file in
let ln = in_channel_length ic in
let rs = Bytes.create ln in
really_input ic rs 0 ln;
close_in ic;
Bytes.unsafe_to_string rs
let data file = mmap ("./pkcs12/" ^ file)
let cert = match Certificate.decode_pem (data "certificate.pem") with
| Ok c -> c
| Error _ -> assert false
let key = match Private_key.decode_pem (data "key.pem") with
| Ok k -> k
| Error _ -> assert false
let pass = "1234"
let cert_and_key xs =
match xs with
| [ `Certificate c ; `Decrypted_private_key k ] ->
Alcotest.(check bool __LOC__ true (c = cert && k = key))
| _ -> Alcotest.fail "expected certificate and key"
let openssl1 () =
match PKCS12.decode_der (data "ossl.p12") with
| Error `Msg m -> Alcotest.fail ("failed to decode ossl.p12: " ^ m)
| Ok data ->
match PKCS12.verify pass data with
| Ok xs -> cert_and_key xs
| Error `Msg m -> Alcotest.fail ("failed to verify ossl.p12: " ^ m)
let openssl2 () =
match PKCS12.decode_der (data "ossl_aes.p12") with
| Error _ -> Alcotest.fail "failed to decode ossl_aes.p12"
| Ok data ->
match PKCS12.verify pass data with
| Ok xs -> cert_and_key xs
| Error _ -> Alcotest.fail "failed to verify ossl_aes.p12"
let ours () =
match PKCS12.decode_der (data "ours.p12") with
| Error _ -> Alcotest.fail "failed to decode ours.p12"
| Ok data ->
match PKCS12.verify pass data with
| Ok xs -> cert_and_key xs
| Error _ -> Alcotest.fail "failed to verify ours.p12"
let roundtrip () =
let p12 = PKCS12.create pass [ cert ] key in
match PKCS12.verify pass p12 with
| Ok xs -> cert_and_key xs
| Error _ -> Alcotest.fail "failed roundtrip"
let tests = [
"OpenSSL basic", `Quick, openssl1 ;
"OpenSSL AES 256", `Quick, openssl2 ;
"OCaml-X509 AES 256", `Quick, ours ;
"OCaml-X509 create and verify", `Quick, roundtrip ;
]

14
unikernel/duniverse/ocaml-x509/tests/pkcs12/certificate.pem Normal file
View file

@ -0,0 +1,14 @@
-----BEGIN CERTIFICATE-----
MIICDDCCAW+gAwIBAgIIQcOa7kqxp9cwCgYIKoZIzj0EAwQwFjEUMBIGA1UEAwwL
ZXhhbXBsZS5jb20wHhcNMjEwNDA0MTcwMTU3WhcNMjIwNDA0MTcwMTU3WjAWMRQw
EgYDVQQDDAtleGFtcGxlLmNvbTCBmzAQBgcqhkjOPQIBBgUrgQQAIwOBhgAEAXIK
VyKRhKOJjxXQtKJiTX9nM3lZs6qy632NYmG9BwJ74FidW1NYlT0eiN71nMHU9FOH
BZ76AH0ISrbo3hjG7uFzAPMplhTwTlA7IcQoR8FOGjrN0w+H5YJZRtkfYU0hFETU
F4quomVmbrxtcIgFRWLJdf7qciYYJyYc8ZlTZoHpZY02o2QwYjAdBgNVHQ4EFgQU
nku+GxZTewB6/D2bJFQcOkBN4QMwDwYDVR0PAQH/BAUDAwfGADAPBgNVHRMBAf8E
BTADAQH/MB8GA1UdIwQYMBaAFJ5LvhsWU3sAevw9myRUHDpATeEDMAoGCCqGSM49
BAMEA4GKADCBhgJBfZBX4o5Df/fJUnzmQKo6KFFWlc70VkO3hXH6lUhVRLcT+Ame
6gJUjgYy65GryW4Tx/pFTI7tdX19UDm+kBvgv1sCQRIgxgt/eJ74VsRgt7Br3Smm
px1uULyS4PIGBKT4O4C4bWS1wdzw8ZOlegss1+pkxYYrfJFNJYyBaqY0ScTpvE4F
-----END CERTIFICATE-----
----

5
unikernel/duniverse/ocaml-x509/tests/pkcs12/key.pem Normal file
View file

@ -0,0 +1,5 @@
-----BEGIN PRIVATE KEY-----
MGACAQAwEAYHKoZIzj0CAQYFK4EEACMESTBHAgEBBEIAtmFgIVel9k9Ivp7S5Mlc
adxdv3KvDHc1j787n4avTUpzk+Aj7g0zxen7UsBOk2q/EGbZbtVFsO4zdOvPqP1+
m94=
-----END PRIVATE KEY-----

BIN
unikernel/duniverse/ocaml-x509/tests/pkcs12/ossl.p12 Normal file
View file

Binary file not shown.

BIN
unikernel/duniverse/ocaml-x509/tests/pkcs12/ossl_aes.p12 Normal file
View file

Binary file not shown.

BIN
unikernel/duniverse/ocaml-x509/tests/pkcs12/ours.p12 Normal file
View file

Binary file not shown.

40
unikernel/duniverse/ocaml-x509/tests/priv.ml Normal file
View file

@ -0,0 +1,40 @@
open X509
let pk_equal a b =
String.equal
Digestif.SHA256.(to_raw_string (digest_string (Private_key.encode_der a)))
Digestif.SHA256.(to_raw_string (digest_string (Private_key.encode_der b)))
let generate_rsa () =
let seed = "Test1234" in
let pk = Private_key.generate ~seed `RSA in
let pk' = Result.get_ok (Private_key.of_string `RSA seed) in
let pk'' = Result.get_ok (Private_key.of_string ~seed_or_data:`Seed `RSA seed) in
Alcotest.(check bool "generate and of_string" true (pk_equal pk pk'));
Alcotest.(check bool "generate and of_string ~seed" true (pk_equal pk pk''));
match Private_key.of_string ~seed_or_data:`Data `RSA seed with
| Error _ -> ()
| Ok _ -> Alcotest.fail "expected failure (of_string `Data `RSA)"
let b64_dec s = Base64.decode_exn s
let test_ec (key_type, data) () =
let pk = Result.get_ok (Private_key.of_octets (b64_dec data) key_type) in
let pk' = Result.get_ok (Private_key.of_string key_type data) in
let pk'' = Result.get_ok (Private_key.of_string ~seed_or_data:`Data key_type data) in
Alcotest.(check bool "generate and of_string" true (pk_equal pk pk'));
Alcotest.(check bool "generate and of_string ~data" true (pk_equal pk pk''));
match Private_key.of_string ~seed_or_data:`Seed key_type data with
| Error _ -> Alcotest.fail "expected ok (of_string `Seed)"
| Ok pk''' -> Alcotest.(check bool "generate and of_String ~seed" false (pk_equal pk pk'''))
let ec_data = [
`ED25519, "W0p4c4tBHtSaTj4zij4oARCjhFbIi8voYg+65bl7wLU=" ;
`P256, "arvDmHpdTdzbc0uo+KCXoArmrmAs2GAvfk14D8gi6gM=" ;
`P384, "UEZz/xVx2f3s7W8/cFy/w38LkjAq0xfMYJiXamdwgW9zwSK18+vrhKzgE23sFnyq" ;
`P521, "AVb4DIpMO5hzyfX1n4qi4xtj/JBDCTCwyOLasKnnVS6FHW2hEZbGwd1c2J4rwpNKZqTKNsKu3dVJAmlp3EFhqv5T" ;
]
let tests =
("Generate RSA", `Quick, generate_rsa) ::
List.map (fun d -> Key_type.to_string (fst d), `Quick, test_ec d) ec_data

412
unikernel/duniverse/ocaml-x509/tests/regression.ml Normal file
View file

@ -0,0 +1,412 @@
open X509
let mmap file =
let ic = open_in file in
let ln = in_channel_length ic in
let rs = Bytes.create ln in
really_input ic rs 0 ln;
close_in ic;
Bytes.unsafe_to_string rs
let regression file =
mmap ("./regression/" ^ file ^ ".pem")
let cert file =
match Certificate.decode_pem (regression file) with
| Ok cert -> cert
| Error (`Msg m) -> Alcotest.failf "certificate %s decoding error %s" file m
let jc = cert "jabber.ccc.de"
let cacert = cert "cacert"
let time () = None
let host str = Some (Domain_name.host_exn (Domain_name.of_string_exn str))
let test_jc_jc () =
match Validation.verify_chain_of_trust ~host:(host "jabber.ccc.de") ~time ~anchors:[jc] [jc] with
| Error `InvalidChain -> ()
| Error e -> Alcotest.failf "something went wrong with jc_jc (expected invalid_chain, got %a"
Validation.pp_validation_error e
| Ok _ -> Alcotest.fail "chain validated when it shouldn't"
let test_jc_ca_fail () =
match Validation.verify_chain_of_trust ~host:(host "jabber.ccc.de") ~time ~anchors:[cacert] [jc ; cacert] with
| Error `InvalidChain -> ()
| _ -> Alcotest.fail "something went wrong with jc_ca"
let test_jc_ca_all_hashes () =
match Validation.verify_chain_of_trust ~allowed_hashes:[`SHA1] ~host:(host "jabber.ccc.de") ~time ~anchors:[cacert] [jc ; cacert] with
| Ok _ -> ()
| _ -> Alcotest.fail "something went wrong with jc_ca"
let telesec = cert "telesec"
let jfd = [ cert "jabber.fu-berlin.de" ; cert "fu-berlin" ; cert "dfn" ]
let test_jfd_ca () =
match Validation.verify_chain_of_trust ~host:(host "jabber.fu-berlin.de") ~time ~anchors:[telesec] (jfd@[telesec]) with
| Ok _ -> ()
| _ -> Alcotest.fail "something went wrong with jfd_ca"
let test_jfd_ca' () =
match Validation.verify_chain_of_trust ~host:(host "jabber.fu-berlin.de") ~time ~anchors:[telesec] jfd with
| Ok _ -> ()
| _ -> Alcotest.fail "something went wrong with jfd_ca'"
let test_izenpe () =
let crt = cert "izenpe" in
let _, san = Extension.(get Subject_alt_name (Certificate.extensions crt)) in
Alcotest.(check int "two SAN (mail + dir)" 2 (General_name.cardinal san));
Alcotest.(check (list string) "mail in SAN is correct" [ "info@izenpe.com" ]
General_name.(get Rfc_822 san));
let dir = General_name.(get Directory san) in
Alcotest.(check int "directory san len is 1" 1 (List.length dir));
let data = Fmt.to_to_string Distinguished_name.pp (List.hd dir) in
let expected = "/O=IZENPE S.A. - CIF A01337260-RMerc.Vitoria-Gasteiz T1055 F62 S8/Street=Avda del Mediterraneo Etorbidea 14 - 01010 Vitoria-Gasteiz" in
Alcotest.(check string "directory in SAN is correct" expected data)
let test_name_constraints () =
ignore (cert "name-constraints")
let check_dn =
(module Distinguished_name: Alcotest.TESTABLE with type t = Distinguished_name.t)
let test_distinguished_name () =
let open Distinguished_name in
let crt = cert "PostaCARoot" in
let expected = [
Relative_distinguished_name.singleton (DC "rs") ;
Relative_distinguished_name.singleton (DC "posta") ;
Relative_distinguished_name.singleton (DC "ca") ;
Relative_distinguished_name.singleton (CN "Configuration") ;
Relative_distinguished_name.singleton (CN "Services") ;
Relative_distinguished_name.singleton (CN "Public Key Services") ;
Relative_distinguished_name.singleton (CN "AIA") ;
Relative_distinguished_name.singleton (CN "Posta CA Root")
] in
Alcotest.(check check_dn "complex issuer is good"
expected (Certificate.issuer crt)) ;
Alcotest.(check check_dn "complex subject is good"
expected (Certificate.subject crt))
let test_distinguished_name_pp () =
let module Dn = struct
include Distinguished_name
let cn s = Relative_distinguished_name.singleton (CN s)
let o s = Relative_distinguished_name.singleton (O s)
let initials s = Relative_distinguished_name.singleton (Initials s)
let (+) = Relative_distinguished_name.union
end in
let dn1 = "DN1", Dn.[o "Blanc";
cn "John Doe" + initials "J.D." + initials "N.N."] in
let dn2 = "DN2", Dn.[o " Escapist"; cn "# 2"; cn " \"+,;/<>\\ "] in
let pp1 = "RFC4514", Fmt.hbox (Dn.make_pp ~format:`RFC4514 ()) in
let pp2 = "RFC4514-spacy",
Fmt.hbox (Dn.make_pp ~format:`RFC4514 ~spacing:`Loose ()) in
let pp3 = "OpenSSL", Fmt.hbox (Dn.make_pp ~format:`OpenSSL ()) in
let pp4 = "OSF", Fmt.hbox (Dn.make_pp ~format:`OSF ()) in
let pp5 = "RFC4514-vbox", Fmt.vbox (Dn.make_pp ~format:`RFC4514 ()) in
let check (pp_desc, pp) (dn_desc, dn) expected =
Alcotest.(check string) (Printf.sprintf "%s %s" pp_desc dn_desc)
expected (Fmt.to_to_string pp dn)
in
check pp1 dn1 {|CN=John Doe+Initials=J.D.+Initials=N.N.,O=Blanc|} ;
check pp1 dn2 {|CN=\ \"\+\,\;/\<\>\\ \ ,CN=\# 2,O=\ Escapist|} ;
check pp2 dn1 {|CN = John Doe + Initials = J.D. + Initials = N.N., O = Blanc|} ;
check pp2 dn2 {|CN = \ \"\+\,\;/\<\>\\ \ , CN = \# 2, O = \ Escapist|} ;
check pp3 dn1 {|O = Blanc, CN = John Doe + Initials = J.D. + Initials = N.N.|} ;
check pp3 dn2 {|O = \ Escapist, CN = \# 2, CN = \ \"\+\,\;/\<\>\\ \ |} ;
check pp4 dn1 {|/O=Blanc/CN=John Doe+Initials=J.D.+Initials=N.N.|} ;
check pp4 dn2 {|/O=\ Escapist/CN=\# 2/CN=\ \"\+,;\/\<\>\\ \ |} ;
check pp5 dn1 "CN=John Doe+\nInitials=J.D.+\nInitials=N.N.,\nO=Blanc"
let test_yubico () =
ignore (cert "yubico")
let test_frac_s () =
let file = "until_frac_s" in
match Certificate.decode_pem (regression file) with
| Ok _ -> Alcotest.failf "certificate %s, expected decoding error" file
| Error (`Msg _) -> ()
let decode_valid_pem file =
let data = regression file in
match Private_key.decode_pem data with
| Ok _ -> ()
| Error (`Msg _) ->
Alcotest.failf "private key %s failed to be verified" file
let test_gcloud_key () =
(* discussion in https://github.com/mirage/mirage-crypto/issues/62 *)
let file = "gcloud" in
decode_valid_pem file
let test_openssl_2048_key () =
(* this key has a d > lcm (p - 1) (q - 1) *)
let file = "openssl_2048" in
decode_valid_pem file
let ed25519_priv =
Ohex.decode "D4EE72DBF913584AD5B6D8F1F769F8AD3AFE7C28CBF1D4FBE097A88F44755842"
let ed25519_priv_key () =
let data =
{|-----BEGIN PRIVATE KEY-----
MC4CAQAwBQYDK2VwBCIEINTuctv5E1hK1bbY8fdp+K06/nwoy/HU++CXqI9EdVhC
-----END PRIVATE KEY-----
|}
in
match Private_key.decode_pem data with
| Ok (`ED25519 k as ke) when String.equal ed25519_priv (Mirage_crypto_ec.Ed25519.priv_to_octets k) ->
let encoded = Private_key.encode_pem ke in
if not (String.equal encoded data) then
Alcotest.failf "ED25519 encoding failed"
| Ok (`ED25519 _) -> Alcotest.failf "wrong ED25519 private key"
| Ok _ | Error (`Msg _) -> Alcotest.failf "ED25519 private key decode failure"
let ed25519_pub_key () =
let data =
{|-----BEGIN PUBLIC KEY-----
MCowBQYDK2VwAyEAGb9ECWmEzf6FQbrBZ9w7lshQhqowtrbLDFw4rXAxZuE=
-----END PUBLIC KEY-----
|}
and pub =
match Mirage_crypto_ec.Ed25519.priv_of_octets ed25519_priv with
| Error _ -> Alcotest.fail "couldn't decode private Ed25519 key"
| Ok p ->
match Private_key.public (`ED25519 p) with
| `ED25519 p -> p
| _ -> Alcotest.fail "couldn't convert private Ed25519 key to public"
in
let to_cs = Mirage_crypto_ec.Ed25519.pub_to_octets in
match Public_key.decode_pem data with
| Ok (`ED25519 k) when String.equal (to_cs pub) (to_cs k) ->
let encoded = Public_key.encode_pem (`ED25519 k) in
if not (String.equal encoded data) then
Alcotest.failf "ED25519 public key encoding failure"
| _ -> Alcotest.failf "bad ED25519 public key"
let p384_key () =
let priv_data = {|-----BEGIN PRIVATE KEY-----
MIG2AgEAMBAGByqGSM49AgEGBSuBBAAiBIGeMIGbAgEBBDDzBTbwp91ON4CNuDE+
pjKsehNV7I3eTpyKpMlSUqHAguO8hK+t28A/730TP2L0rPyhZANiAATZbEoUICtu
yXyN4G6DDHaUHwwe2bfcsTvY9LnlLCPvu24JTuGjf7pT2faiuvjGb49jk8C2KJWt
0DISTEJ945y41DY0cIPl1okaN+E3yJ66kKpJ0XeKoOJ0rTTopazzjzI=
-----END PRIVATE KEY-----
|}
and pub_data = {|-----BEGIN PUBLIC KEY-----
MHYwEAYHKoZIzj0CAQYFK4EEACIDYgAE2WxKFCArbsl8jeBugwx2lB8MHtm33LE7
2PS55Swj77tuCU7ho3+6U9n2orr4xm+PY5PAtiiVrdAyEkxCfeOcuNQ2NHCD5daJ
GjfhN8ieupCqSdF3iqDidK006KWs848y
-----END PUBLIC KEY-----
|}
in
match
Private_key.decode_pem priv_data,
Public_key.decode_pem pub_data
with
| Ok (`P384 priv), Ok (`P384 pub) ->
let to_cs = Mirage_crypto_ec.P384.Dsa.pub_to_octets in
let pub' = Mirage_crypto_ec.P384.Dsa.pub_of_priv priv in
Alcotest.(check bool __LOC__ true (String.equal (to_cs pub) (to_cs pub')));
let pub_data' = Public_key.encode_pem (`P384 pub) in
Alcotest.(check bool __LOC__ true
(String.equal pub_data pub_data'));
let priv_data' = Private_key.encode_pem (`P384 priv) in
begin match Private_key.decode_pem priv_data' with
| Ok (`P384 priv) ->
let pub' = Mirage_crypto_ec.P384.Dsa.pub_of_priv priv in
Alcotest.(check bool __LOC__ true
(String.equal (to_cs pub) (to_cs pub')))
| _ -> Alcotest.failf "cannot decode re-encoded P384 private key"
end
| _ -> Alcotest.failf "bad P384 key"
let ed25519_cert () =
let file = "example-25519" in
match Certificate.decode_pem (regression file) with
| Error (`Msg msg) ->
Alcotest.failf "ED25519 certificate %s, decoding error %s" file msg
| Ok cert ->
match Validation.valid_ca cert with
| Error e ->
Alcotest.failf "verifying 25519 ca certificate failed %a"
Validation.pp_ca_error e
| Ok () ->
match Validation.verify_chain ~host:(host "www.example.com") ~time ~anchors:[cert] [cert] with
| Ok _ -> ()
| Error e ->
Alcotest.failf "verifying 25519 certificate failed %a"
Validation.pp_chain_error e
let le_p384_root () =
let file = "letsencrypt-root-x2" in
match Certificate.decode_pem (regression file) with
| Error (`Msg msg) ->
Alcotest.failf "let's encrypt P384 certificate %s, decoding error %s"
file msg
| Ok cert ->
match Validation.valid_ca cert with
| Error e ->
Alcotest.failf "verifying P384 ca certificate failed %a"
Validation.pp_ca_error e
| Ok () -> ()
let p256_key () =
let file = "priv_p256" in
match Private_key.decode_pem (regression file) with
| Error (`Msg msg) ->
Alcotest.failf "private P256 key %s decoding error %s" file msg
| Ok _ -> ()
let ip_address () =
let c = cert "1.1.1.1" in
let ta = cert "digicert" in
match
Validation.verify_chain ~ip:(Ipaddr.of_string_exn "1.1.1.1")
~host:None ~time:(fun () -> None) ~anchors:[ta] [c]
with
| Ok _ -> ()
| Error ce -> Alcotest.failf "validation of IP address failed: %a"
Validation.pp_chain_error ce
let alternate_sha1rsa_oid () =
let file = "alternate-sha1rsa-oid" in
match Certificate.decode_pem (regression file) with
| Error (`Msg msg) ->
Alcotest.failf "alternate SHA1RSA OID certificate %s, decoding error %s" file msg
| Ok _cert -> ()
let p256_sha384 () =
let file = "p256_sha384" in
match Certificate.decode_pem (regression file) with
| Error (`Msg msg) ->
Alcotest.failf "P256 certificate with SHA384 %s, decoding error %s"
file msg
| Ok cert ->
match Validation.valid_ca cert with
| Error e ->
Alcotest.failf "verifying P256 certificate failed %a"
Validation.pp_ca_error e
| Ok () -> ()
let rsa_pub () =
let file = "rsa_pub" in
let data = regression file in
match Public_key.decode_pem data with
| Error (`Msg msg) ->
Alcotest.failf "RSA public key %s, decoding error %s" file msg
| Ok pub ->
let pem = Public_key.encode_pem pub in
Alcotest.(check string "PEM encoding of RSA public key is identical"
data pem)
let rsa_priv () =
let file = "rsa_priv" in
let data = regression file in
match Private_key.decode_pem data with
| Error (`Msg msg) ->
Alcotest.failf "RSA private key %s, decoding error %s" file msg
| Ok priv ->
let pem = Private_key.encode_pem priv in
Alcotest.(check string "PEM encoding of RSA private key is identical"
data pem);
let pub = regression "rsa_pub" in
Alcotest.(check string "PEM encoding of RSA public key (derived from private key) is identical"
pub (Public_key.encode_pem (Private_key.public priv)))
let ec_pub file () =
let data = regression file in
match Public_key.decode_pem data with
| Error (`Msg msg) ->
Alcotest.failf "EC public key %s, decoding error %s" file msg
| Ok pub ->
let pem = Public_key.encode_pem pub in
Alcotest.(check string "PEM encoding of EC public key is identical"
data pem)
let ec_priv file pub_file () =
let data = regression file in
match Private_key.decode_pem data with
| Error (`Msg msg) ->
Alcotest.failf "EC private key %s, decoding error %s" file msg
| Ok priv ->
let pem = Private_key.encode_pem priv in
Alcotest.(check string "PEM encoding of EC private key is identical"
data pem);
let pub = regression pub_file in
Alcotest.(check string "PEM encoding of EC public key (derived from private key) is identical"
pub (Public_key.encode_pem (Private_key.public priv)))
let regression_tests = [
"RSA: key too small (jc_jc)", `Quick, test_jc_jc ;
"jc_ca", `Quick, test_jc_ca_fail ;
"jc_ca", `Quick, test_jc_ca_all_hashes ;
"jfd_ca", `Quick, test_jfd_ca ;
"jfd_ca'", `Quick, test_jfd_ca' ;
"SAN dir explicit or implicit", `Quick, test_izenpe ;
"name constraint parsing (DNS: .gr)", `Quick, test_name_constraints ;
"complex distinguished name", `Quick, test_distinguished_name ;
"distinguished name pp", `Quick, test_distinguished_name_pp ;
"algorithm without null", `Quick, test_yubico ;
"valid until generalized_time with fractional seconds", `Quick, test_frac_s ;
"parse valid key where 1 <> d * e mod (p - 1) * (q - 1)", `Quick, test_gcloud_key ;
"parse valid key where d <> e ^ -1 mod lcm ((p - 1) (q - 1))", `Quick, test_openssl_2048_key ;
"ed25519 private key", `Quick, ed25519_priv_key ;
"ed25519 public key", `Quick, ed25519_pub_key ;
"p384 key", `Quick, p384_key ;
"ed25519 certificate", `Quick, ed25519_cert ;
"p384 certificate", `Quick, le_p384_root ;
"p256 key", `Quick, p256_key ;
"ip_address", `Quick, ip_address ;
"alternative SHA1RSA OID", `Quick, alternate_sha1rsa_oid;
"p256 with sha384", `Quick, p256_sha384 ;
"rsa public key", `Quick, rsa_pub ;
"rsa private key", `Quick, rsa_priv ;
] @ List.flatten (List.map (fun file ->
[ "public " ^ file, `Quick, ec_pub ("pub_" ^ file) ;
"private " ^ file, `Quick, ec_priv ("priv_" ^ file) ("pub_" ^ file)
]) [ "p521" ; "p384" ; "p256_2" ])
let host_set_test =
let module M = struct
type t = Host.Set.t
let pp ppf hs =
let pp_one ppf (typ, name) =
Fmt.pf ppf "%s%a"
(match typ with `Strict -> "" | `Wildcard -> "*.")
Domain_name.pp name
in
Fmt.(list ~sep:(any ", ") pp_one) ppf (Host.Set.elements hs)
let equal = Host.Set.equal
end in (module M: Alcotest.TESTABLE with type t = M.t)
let cert_hostnames cert names () =
Alcotest.check host_set_test __LOC__ (Certificate.hostnames cert) names
let csr file =
let data = mmap ("./csr/" ^ file ^ ".pem") in
match Signing_request.decode_pem data with
| Ok csr -> csr
| Error (`Msg m) ->
Alcotest.failf "signing request %s decoding error %s" file m
let csr_hostnames cert names () =
Alcotest.check host_set_test __LOC__ (Signing_request.hostnames cert) names
let host_set xs =
Host.Set.of_list
(List.map (fun n -> `Strict, Domain_name.(host_exn (of_string_exn n))) xs)
let hostname_tests = [
"cacert hostnames", `Quick, cert_hostnames cacert Host.Set.empty;
"izenpe hostnames", `Quick, cert_hostnames (cert "izenpe") (host_set ["izenpe.com"]);
"jabber.ccc.de hostnames", `Quick, cert_hostnames jc (host_set [ "jabber.ccc.de" ; "conference.jabber.ccc.de" ; "jabberd.jabber.ccc.de" ; "pubsub.jabber.ccc.de" ; "vjud.jabber.ccc.de" ]);
"jaber.fu-berlin.de hostnames", `Quick, cert_hostnames (cert "jabber.fu-berlin.de") (host_set [ "jabber.fu-berlin.de" ; "conference.jabber.fu-berlin.de" ; "proxy.jabber.fu-berlin.de" ; "echo.jabber.fu-berlin.de" ; "file.jabber.fu-berlin.de" ; "jitsi-videobridge.jabber.fu-berlin.de" ; "multicast.jabber.fu-berlin.de" ; "pubsub.jabber.fu-berlin.de" ]);
"pads.ccc.de hostnames", `Quick, cert_hostnames (cert "pads.ccc.de") (Host.Set.add (`Wildcard, Domain_name.(host_exn (of_string_exn "pads.ccc.de"))) (host_set ["pads.ccc.de"]));
"first hostnames", `Quick, cert_hostnames (cert "../testcertificates/first/first") (host_set ["foo.foobar.com"; "foobar.com"]);
"CSR your_new_domain hostnames", `Quick, csr_hostnames (csr "your-new-domain") (host_set ["your-new-domain.com" ; "www.your-new-domain.com"]);
"CSR your_new_domain_raw hostnames", `Quick, csr_hostnames (csr "your-new-domain-raw") (host_set ["your-new-domain.com" ; "www.your-new-domain.com"]);
"CSR bar.com hostnames", `Quick, csr_hostnames (csr "wild-bar") (Host.Set.add (`Wildcard, Domain_name.(host_exn (of_string_exn "bar.com"))) (host_set ["your-new-domain.com" ; "www.your-new-domain.com"]));
"CSR foo.com hostnames", `Quick, csr_hostnames (csr "wild-foo-cn") (Host.Set.singleton (`Wildcard, Domain_name.(host_exn (of_string_exn "foo.com"))));
]

32
unikernel/duniverse/ocaml-x509/tests/regression/1.1.1.1.pem Normal file
View file

@ -0,0 +1,32 @@
-----BEGIN CERTIFICATE-----
MIIFhjCCBQ2gAwIBAgIQBQdvZtEbaSJWzKzVRv/sUzAKBggqhkjOPQQDAzBWMQsw
CQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMTAwLgYDVQQDEydEaWdp
Q2VydCBUTFMgSHlicmlkIEVDQyBTSEEzODQgMjAyMCBDQTEwHhcNMjEwMTExMDAw
MDAwWhcNMjIwMTE4MjM1OTU5WjByMQswCQYDVQQGEwJVUzETMBEGA1UECBMKQ2Fs
aWZvcm5pYTEWMBQGA1UEBxMNU2FuIEZyYW5jaXNjbzEZMBcGA1UEChMQQ2xvdWRm
bGFyZSwgSW5jLjEbMBkGA1UEAxMSY2xvdWRmbGFyZS1kbnMuY29tMFkwEwYHKoZI
zj0CAQYIKoZIzj0DAQcDQgAEF60f6DWvcNONnJ5k/UceW5cMCtEQqCYyETZmTRKZ
w+Exu/UhY3PdpcHBoPBtpMRe4cLb2vkNNIAa97ngOvLVdKOCA58wggObMB8GA1Ud
IwQYMBaAFAq8CCkXjKU5bXoOzjPHLrPt+8N6MB0GA1UdDgQWBBThtvwG+bmLBfTB
4kibArkLwbU9eTCBpgYDVR0RBIGeMIGbghJjbG91ZGZsYXJlLWRucy5jb22CFCou
Y2xvdWRmbGFyZS1kbnMuY29tgg9vbmUub25lLm9uZS5vbmWHBAEBAQGHBAEAAAGH
BKKfJAGHBKKfLgGHECYGRwBHAAAAAAAAAAAAERGHECYGRwBHAAAAAAAAAAAAEAGH
ECYGRwBHAAAAAAAAAAAAAGSHECYGRwBHAAAAAAAAAAAAZAAwDgYDVR0PAQH/BAQD
AgeAMB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjCBlwYDVR0fBIGPMIGM
MESgQqBAhj5odHRwOi8vY3JsMy5kaWdpY2VydC5jb20vRGlnaUNlcnRUTFNIeWJy
aWRFQ0NTSEEzODQyMDIwQ0ExLmNybDBEoEKgQIY+aHR0cDovL2NybDQuZGlnaWNl
cnQuY29tL0RpZ2lDZXJ0VExTSHlicmlkRUNDU0hBMzg0MjAyMENBMS5jcmwwSwYD
VR0gBEQwQjA2BglghkgBhv1sAQEwKTAnBggrBgEFBQcCARYbaHR0cDovL3d3dy5k
aWdpY2VydC5jb20vQ1BTMAgGBmeBDAECAjCBgwYIKwYBBQUHAQEEdzB1MCQGCCsG
AQUFBzABhhhodHRwOi8vb2NzcC5kaWdpY2VydC5jb20wTQYIKwYBBQUHMAKGQWh0
dHA6Ly9jYWNlcnRzLmRpZ2ljZXJ0LmNvbS9EaWdpQ2VydFRMU0h5YnJpZEVDQ1NI
QTM4NDIwMjBDQTEuY3J0MAwGA1UdEwEB/wQCMAAwggEEBgorBgEEAdZ5AgQCBIH1
BIHyAPAAdgApeb7wnjk5IfBWc59jpXflvld9nGAK+PlNXSZcJV3HhAAAAXby6BKo
AAAEAwBHMEUCIQDRsvaM+FOVneTUUwY0ggKKCuqKp7wnHvtWHtEUZB+uZwIgJbGG
3Rsq548BxED2wxZ4q2G/9jo0/EeIEwdl9GC7NEIAdgAiRUUHWVUkVpY/oS/x922G
4CMmY63AS39dxoNcbuIPAgAAAXby6BMPAAAEAwBHMEUCIQCV3RpnSizsrJ1vi/48
/qT1PoclZYI3N51mveRdD2gkWQIgdWX+MLuAa8ziuKGIlqjoAiaOvs/4IfqthaAN
h6HW8TQwCgYIKoZIzj0EAwMDZwAwZAIwJMLPbL32rtHJ1R9KdC48PdHAPtzXG9OU
cVv+pYYWJoIBItMKbvyYtdLiueUHaXeWAjBFe2+Cpn22YsMxhdW1NV1PTISIrBoA
PQyEQNywp8ocEycVHjf5RsOu2f35uSOLfyo=
-----END CERTIFICATE-----

41
unikernel/duniverse/ocaml-x509/tests/regression/PostaCARoot.pem Normal file
View file

@ -0,0 +1,41 @@
-----BEGIN CERTIFICATE-----
MIIHHzCCBgegAwIBAgIESPx+9TANBgkqhkiG9w0BAQUFADCBrjESMBAGCgmSJomT
8ixkARkWAnJzMRUwEwYKCZImiZPyLGQBGRYFcG9zdGExEjAQBgoJkiaJk/IsZAEZ
FgJjYTEWMBQGA1UEAxMNQ29uZmlndXJhdGlvbjERMA8GA1UEAxMIU2VydmljZXMx
HDAaBgNVBAMTE1B1YmxpYyBLZXkgU2VydmljZXMxDDAKBgNVBAMTA0FJQTEWMBQG
A1UEAxMNUG9zdGEgQ0EgUm9vdDAeFw0wODEwMjAxMjIyMDhaFw0yODEwMjAxMjUy
MDhaMIGuMRIwEAYKCZImiZPyLGQBGRYCcnMxFTATBgoJkiaJk/IsZAEZFgVwb3N0
YTESMBAGCgmSJomT8ixkARkWAmNhMRYwFAYDVQQDEw1Db25maWd1cmF0aW9uMREw
DwYDVQQDEwhTZXJ2aWNlczEcMBoGA1UEAxMTUHVibGljIEtleSBTZXJ2aWNlczEM
MAoGA1UEAxMDQUlBMRYwFAYDVQQDEw1Qb3N0YSBDQSBSb290MIIBIjANBgkqhkiG
9w0BAQEFAAOCAQ8AMIIBCgKCAQEAqPK9iL7Ar0S+m0qiYxzWVqsdKbIcqhUeRdGs
naBh1TX55FqDNmND3jhXFfzwlGL0B4BXg1eosxW8+00jeF/a9seBFr6r3+fcg1Nz
K7bdY4iNRfMN3X2/6IiwZsFDXTfSbaGcmkbDsz/QwqCKlC6DpjzDYL0szB6LY4J2
QSjkFWtcDGE5VThByshm6Me4l1IQJnC3B7cJHqYTXq6ZWiZvZD3sxNOluVx2ZK1j
fYiD4kvMDd7UxtMIQvVbF/Vx4ZEtA5+eHNyLcqToR2QQh2Qwc9jytPFXJpNXy7bH
DYiLHc8FMF0E1nY36CAyV78PnDPGCIz2tMKpBrBbMKEeLRK6PwIDAQABo4IDQTCC
Az0wDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwgboGA1UdIASBsjCB
rzCBrAYLKwYBBAH6OAoKAQEwgZwwMAYIKwYBBQUHAgEWJGh0dHA6Ly93d3cuY2Eu
cG9zdGEucnMvZG9rdW1lbnRhY2lqYTBoBggrBgEFBQcCAjBcGlpPdm8gamUgZWxl
a3Ryb25za2kgc2VydGlmaWthdCBST09UIENBIHNlcnZlcmEgU2VydGlmaWthY2lv
bm9nIHRlbGEgUG9zdGU6ICJQb3N0YSBDQSBSb290Ii4wEQYJYIZIAYb4QgEBBAQD
AgAHMIIBvAYDVR0fBIIBszCCAa8wgcmggcaggcOkgcAwgb0xEjAQBgoJkiaJk/Is
ZAEZFgJyczEVMBMGCgmSJomT8ixkARkWBXBvc3RhMRIwEAYKCZImiZPyLGQBGRYC
Y2ExFjAUBgNVBAMTDUNvbmZpZ3VyYXRpb24xETAPBgNVBAMTCFNlcnZpY2VzMRww
GgYDVQQDExNQdWJsaWMgS2V5IFNlcnZpY2VzMQwwCgYDVQQDEwNBSUExFjAUBgNV
BAMTDVBvc3RhIENBIFJvb3QxDTALBgNVBAMTBENSTDEwgeCggd2ggdqGgaNsZGFw
Oi8vbGRhcC5jYS5wb3N0YS5ycy9jbj1Qb3N0YSUyMENBJTIwUm9vdCxjbj1BSUEs
Y249UHVibGljJTIwS2V5JTIwU2VydmljZXMsY249U2VydmljZXMsY249Q29uZmln
dXJhdGlvbixkYz1jYSxkYz1wb3N0YSxkYz1ycz9jZXJ0aWZpY2F0ZVJldm9jYXRp
b25MaXN0JTNCYmluYXJ5hjJodHRwOi8vc2VydGlmaWthdGkuY2EucG9zdGEucnMv
Y3JsL1Bvc3RhQ0FSb290LmNybDArBgNVHRAEJDAigA8yMDA4MTAyMDEyMjIwOFqB
DzIwMjgxMDIwMTI1MjA4WjAfBgNVHSMEGDAWgBTyy43iNe8QQ8Tae8r664kDoSKv
uDAdBgNVHQ4EFgQU8suN4jXvEEPE2nvK+uuJA6Eir7gwHQYJKoZIhvZ9B0EABBAw
DhsIVjcuMTo0LjADAgSQMA0GCSqGSIb3DQEBBQUAA4IBAQBwRqHI5BcFZg+d4kMx
SB2SkBnEhQGFFm74ks57rlIWxJeNCih91cts49XlDjJPyGgtNAg9c6iTQikzRgxE
Z/HQmpxpAeWR8Q3JaTwzS04Zk2MzBSkhodj/PlSrnvahegLX3P+lPlR4+dPByhKV
+YmeFOLyoUSyy+ktdTXMllW7OAuIJtrWrO/TUqILSzpT2ksiU8zKKiSaYqrEMpp+
3MzBsmzNj9m0wM/1AsCMK4RbG0C8ENBQ4WHWZlaaBJGl49W9oC4igbHZONrkqIdf
PEYElt7Jmju/rXhsHUlJtGm5cA8Fkla2/a+u+CAtRyPPthzNxJuATvm/McBUvrsx
f/M+
-----END CERTIFICATE-----

12
unikernel/duniverse/ocaml-x509/tests/regression/alternate-sha1rsa-oid.pem Normal file
View file

@ -0,0 +1,12 @@
-----BEGIN CERTIFICATE-----
MIIBwjCCAS+gAwIBAgIQj2d4hVEz0L1DYFVhA9CxCzAJBgUrDgMCHQUAMA8xDTAL
BgNVBAMTBFZQUzEwHhcNMDcwODE4MDkyODUzWhcNMDgwODE3MDkyODUzWjAPMQ0w
CwYDVQQDEwRWUFMxMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDaqKn40uaU
DbFL1NXXZ8/b4ZqDJ6eSI5lysMZHfZDs60G3ocbNKofBvURIutabrFuBCB2S5f/z
ICan0LR4uFpGuZ2I/PuVaU8X5fT8gBh7L636cWzHPPScYts00OyywEq381UB7XwX
YuWpM5kUW5rkbq1JV3ystTR/4YnLl48YtQIDAQABoycwJTATBgNVHSUEDDAKBggr
BgEFBQcDATAOBgNVHQ8EBwMFALAAAAAwCQYFKw4DAh0FAAOBgQBuUrU+J2Z5WKcO
VNjJHFUKo8qpbn8jKQZDl2nvVaXCTXQZblz/qxOm4FaGGzJ/m3GybVZNVfdyHg+U
lmDpFpOITkvcyNc3xjJCf2GVBo/VvdtVt7Myq0IQtAi/CXRK22BRNhSt9uu2EcRu
HIXdFWHEzi6eD4PpNw/0X3ID6Gxk4A==
-----END CERTIFICATE-----

41
unikernel/duniverse/ocaml-x509/tests/regression/cacert.pem Normal file
View file

@ -0,0 +1,41 @@
-----BEGIN CERTIFICATE-----
MIIHPTCCBSWgAwIBAgIBADANBgkqhkiG9w0BAQQFADB5MRAwDgYDVQQKEwdSb290
IENBMR4wHAYDVQQLExVodHRwOi8vd3d3LmNhY2VydC5vcmcxIjAgBgNVBAMTGUNB
IENlcnQgU2lnbmluZyBBdXRob3JpdHkxITAfBgkqhkiG9w0BCQEWEnN1cHBvcnRA
Y2FjZXJ0Lm9yZzAeFw0wMzAzMzAxMjI5NDlaFw0zMzAzMjkxMjI5NDlaMHkxEDAO
BgNVBAoTB1Jvb3QgQ0ExHjAcBgNVBAsTFWh0dHA6Ly93d3cuY2FjZXJ0Lm9yZzEi
MCAGA1UEAxMZQ0EgQ2VydCBTaWduaW5nIEF1dGhvcml0eTEhMB8GCSqGSIb3DQEJ
ARYSc3VwcG9ydEBjYWNlcnQub3JnMIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIIC
CgKCAgEAziLA4kZ97DYoB1CW8qAzQIxL8TtmPzHlawI229Z89vGIj053NgVBlfkJ
8BLPRoZzYLdufujAWGSuzbCtRRcMY/pnCujW0r8+55jE8Ez64AO7NV1sId6eINm6
zWYyN3L69wj1x81YyY7nDl7qPv4coRQKFWyGhFtkZip6qUtTefWIonvuLwphK42y
fk1WpRPs6tqSnqxEQR5YYGUFZvjARL3LlPdCfgv3ZWiYUQXw8wWRBB0bF4LsyFe7
w2t6iPGwcswlWyCR7BYCEo8y6RcYSNDHBS4CMEK4JZwFaz+qOqfrU0j36NK2B5jc
G8Y0f3/JHIJ6BVgrCFvzOKKrF11myZjXnhCLotLddJr3cQxyYN/Nb5gznZY0dj4k
epKwDpUeb+agRThHqtdB7Uq3EvbXG4OKDy7YCbZZ16oE/9KTfWgu3YtLq1i6L43q
laegw1SJpfvbi1EinbLDvhG+LJGGi5Z4rSDTii8aP8bQUWWHIbEZAWV/RRyH9XzQ
QUxPKZgh/TMfdQwEUfoZd9vUFBzugcMd9Zi3aQaRIt0AUMyBMawSB3s42mhb5ivU
fslfrejrckzzAeVLIL+aplfKkQABi6F1ITe1Yw1nPkZPcCBnzsXWWdsC4PDSy826
YreQQejdIOQpvGQpQsgi3Hia/0PsmBsJUUtaWsJx8cTLc6nloQsCAwEAAaOCAc4w
ggHKMB0GA1UdDgQWBBQWtTIb1Mfz4OaO873SsDrusjkY0TCBowYDVR0jBIGbMIGY
gBQWtTIb1Mfz4OaO873SsDrusjkY0aF9pHsweTEQMA4GA1UEChMHUm9vdCBDQTEe
MBwGA1UECxMVaHR0cDovL3d3dy5jYWNlcnQub3JnMSIwIAYDVQQDExlDQSBDZXJ0
IFNpZ25pbmcgQXV0aG9yaXR5MSEwHwYJKoZIhvcNAQkBFhJzdXBwb3J0QGNhY2Vy
dC5vcmeCAQAwDwYDVR0TAQH/BAUwAwEB/zAyBgNVHR8EKzApMCegJaAjhiFodHRw
czovL3d3dy5jYWNlcnQub3JnL3Jldm9rZS5jcmwwMAYJYIZIAYb4QgEEBCMWIWh0
dHBzOi8vd3d3LmNhY2VydC5vcmcvcmV2b2tlLmNybDA0BglghkgBhvhCAQgEJxYl
aHR0cDovL3d3dy5jYWNlcnQub3JnL2luZGV4LnBocD9pZD0xMDBWBglghkgBhvhC
AQ0ESRZHVG8gZ2V0IHlvdXIgb3duIGNlcnRpZmljYXRlIGZvciBGUkVFIGhlYWQg
b3ZlciB0byBodHRwOi8vd3d3LmNhY2VydC5vcmcwDQYJKoZIhvcNAQEEBQADggIB
ACjH7pyCArpcgBLKNQodgW+JapnM8mgPf6fhjViVPr3yBsOQWqy1YPaZQwGjiHCc
nWKdpIevZ1gNMDY75q1I08t0AoZxPuIrA2jxNGJARjtT6ij0rPtmlVOKTV39O9lg
18p5aTuxZZKmxoGCXJzN600BiqXfEVWqFcofN8CCmHBh22p8lqOOLlQ+TyGpkO/c
gr/c6EWtTZBzCDyUZbAEmXZ/4rzCahWqlwQ3JNgelE5tDlG+1sSPypZt90Pf6DBl
Jzt7u0NDY8RD97LsaMzhGY4i+5jhe1o+ATc7iwiwovOVThrLm82asduycPAtStvY
sONvRUgzEv/+PDIqVPfE94rwiCPCR/5kenHA0R6mY7AHfqQv0wGP3J8rtsYIqQ+T
SCX8Ev2fQtzzxD72V7DX3WnRBnc0CkvSyqD/HMaMyRa+xMwyN2hzXwj7UfdJUzYF
CpUCTPJ5GhD22Dp1nPMd8aINcGeGG7MW9S/lpOt5hvk9C8JzC6WZrG/8Z7jlLwum
GCSNe9FINSkYQKyTYOGWhlC0elnYjyELn8+CkcY7v2vcB5G5l1YjqrZslMZIBjzk
zk6q5PYvCdxTby78dOs6Y5nCpqyJvKeyRKANihDjbPIky/qbn3BHLt4Ui9SyIAmW
omTxJBzcoTWcFbLUvFUufQb1nA5V9FrWk9p2rSVzTMVD
-----END CERTIFICATE-----

29
unikernel/duniverse/ocaml-x509/tests/regression/dfn.pem Normal file
View file

@ -0,0 +1,29 @@
-----BEGIN CERTIFICATE-----
MIIE1TCCA72gAwIBAgIIUE7G9T0RtGQwDQYJKoZIhvcNAQELBQAwcTELMAkGA1UE
BhMCREUxHDAaBgNVBAoTE0RldXRzY2hlIFRlbGVrb20gQUcxHzAdBgNVBAsTFlQt
VGVsZVNlYyBUcnVzdCBDZW50ZXIxIzAhBgNVBAMTGkRldXRzY2hlIFRlbGVrb20g
Um9vdCBDQSAyMB4XDTE0MDcyMjEyMDgyNloXDTE5MDcwOTIzNTkwMFowWjELMAkG
A1UEBhMCREUxEzARBgNVBAoTCkRGTi1WZXJlaW4xEDAOBgNVBAsTB0RGTi1QS0kx
JDAiBgNVBAMTG0RGTi1WZXJlaW4gUENBIEdsb2JhbCAtIEcwMTCCASIwDQYJKoZI
hvcNAQEBBQADggEPADCCAQoCggEBAOmbw2eF+Q2u9Y1Uw5ZQNT1i6W5M7ZTXAFuV
InTUIOs0j9bswDEEC5mB4qYU0lKgKCOEi3SJBF5b4OJ4wXjLFssoNTl7LZBF0O2g
AHp8v0oOGwDDhulcKzERewzzgiRDjBw4i2poAJru3E94q9LGE5t2re7eJujvAa90
D8EJovZrzr3TzRQwT/Xl46TIYpuCGgMnMA0CZWBN7dEJIyqWNVgn03bGcbaQHcTt
/zWGfW8zs9sPxRHCioOhlF1Ba9jSEPVM/cpRrNm975KDu9rrixZWVkPP4dUTPaYf
JzDNSVTbyRM0mnF1xWzqpwuY+SGdJ68+ozk5SGqMrcmZ+8MS8r0CAwEAAaOCAYYw
ggGCMA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQUSbfGz+g9H3/qRHsTKffxCnA+
3mQwHwYDVR0jBBgwFoAUMcN5G7r1U9cX4Il6LRdsCrMrnTMwEgYDVR0TAQH/BAgw
BgEB/wIBAjBiBgNVHSAEWzBZMBEGDysGAQQBga0hgiwBAQQCAjARBg8rBgEEAYGt
IYIsAQEEAwAwEQYPKwYBBAGBrSGCLAEBBAMBMA8GDSsGAQQBga0hgiwBAQQwDQYL
KwYBBAGBrSGCLB4wPgYDVR0fBDcwNTAzoDGgL4YtaHR0cDovL3BraTAzMzYudGVs
ZXNlYy5kZS9ybC9EVF9ST09UX0NBXzIuY3JsMHgGCCsGAQUFBwEBBGwwajAsBggr
BgEFBQcwAYYgaHR0cDovL29jc3AwMzM2LnRlbGVzZWMuZGUvb2NzcHIwOgYIKwYB
BQUHMAKGLmh0dHA6Ly9wa2kwMzM2LnRlbGVzZWMuZGUvY3J0L0RUX1JPT1RfQ0Ff
Mi5jZXIwDQYJKoZIhvcNAQELBQADggEBAGMgKP2cIYZyvjlGWTkyJbypAZsNzMp9
QZyGbQpuLLMTWXWxM5IbYScW/8Oy1TWC+4QqAUm9ZrtmL7LCBl1uP27jAVpbykNj
XJW24TGnH9UHX03mZYJOMvnDfHpLzU1cdO4h8nUC7FI+0slq05AjbklnNb5/TVak
7Mwvz7ehl6hyPsm8QNZapAg91ryCw7e3Mo6xLI5qbbc1AhnP9TlEWGOnJAAQsLv8
Tq9uLzi7pVdJP9huUG8sl5bcHUaaZYnPrszy5dmfU7M+oS+SqdgLxoQfBMbrHuif
fbV7pQLxJMUkYxE0zFqTICp5iDolQpCpZTt8htMSFSMp/CzazDlbVBc=
-----END CERTIFICATE-----

25
unikernel/duniverse/ocaml-x509/tests/regression/digicert.pem Normal file
View file

@ -0,0 +1,25 @@
-----BEGIN CERTIFICATE-----
MIIEQzCCAyugAwIBAgIQCidf5wTW7ssj1c1bSxpOBDANBgkqhkiG9w0BAQwFADBh
MQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3
d3cuZGlnaWNlcnQuY29tMSAwHgYDVQQDExdEaWdpQ2VydCBHbG9iYWwgUm9vdCBD
QTAeFw0yMDA5MjMwMDAwMDBaFw0zMDA5MjIyMzU5NTlaMFYxCzAJBgNVBAYTAlVT
MRUwEwYDVQQKEwxEaWdpQ2VydCBJbmMxMDAuBgNVBAMTJ0RpZ2lDZXJ0IFRMUyBI
eWJyaWQgRUNDIFNIQTM4NCAyMDIwIENBMTB2MBAGByqGSM49AgEGBSuBBAAiA2IA
BMEbxppbmNmkKaDp1AS12+umsmxVwP/tmMZJLwYnUcu/cMEFesOxnYeJuq20ExfJ
qLSDyLiQ0cx0NTY8g3KwtdD3ImnI8YDEe0CPz2iHJlw5ifFNkU3aiYvkA8ND5b8v
c6OCAa4wggGqMB0GA1UdDgQWBBQKvAgpF4ylOW16Ds4zxy6z7fvDejAfBgNVHSME
GDAWgBQD3lA1VtFMu2bwo+IbG8OXsj3RVTAOBgNVHQ8BAf8EBAMCAYYwHQYDVR0l
BBYwFAYIKwYBBQUHAwEGCCsGAQUFBwMCMBIGA1UdEwEB/wQIMAYBAf8CAQAwdgYI
KwYBBQUHAQEEajBoMCQGCCsGAQUFBzABhhhodHRwOi8vb2NzcC5kaWdpY2VydC5j
b20wQAYIKwYBBQUHMAKGNGh0dHA6Ly9jYWNlcnRzLmRpZ2ljZXJ0LmNvbS9EaWdp
Q2VydEdsb2JhbFJvb3RDQS5jcnQwewYDVR0fBHQwcjA3oDWgM4YxaHR0cDovL2Ny
bDMuZGlnaWNlcnQuY29tL0RpZ2lDZXJ0R2xvYmFsUm9vdENBLmNybDA3oDWgM4Yx
aHR0cDovL2NybDQuZGlnaWNlcnQuY29tL0RpZ2lDZXJ0R2xvYmFsUm9vdENBLmNy
bDAwBgNVHSAEKTAnMAcGBWeBDAEBMAgGBmeBDAECATAIBgZngQwBAgIwCAYGZ4EM
AQIDMA0GCSqGSIb3DQEBDAUAA4IBAQDeOpcbhb17jApY4+PwCwYAeq9EYyp/3YFt
ERim+vc4YLGwOWK9uHsu8AjJkltz32WQt960V6zALxyZZ02LXvIBoa33llPN1d9R
JzcGRvJvPDGJLEoWKRGC5+23QhST4Nlg+j8cZMsywzEXJNmvPlVv/w+AbxsBCMqk
BGPI2lNM8hkmxPad31z6n58SXqJdH/bYF462YvgdgbYKOytobPAyTgr3mYI5sUje
CzqJx1+NLyc8nAK8Ib2HxnC+IrrWzfRLvVNve8KaN9EtBH7TuMwNW4SpDCmGr6fY
1h3tDjHhkTb9PA36zoaJzu0cIw265vZt6hCmYWJC+/j+fgZwcPwL
-----END CERTIFICATE-----

8
unikernel/duniverse/ocaml-x509/tests/regression/example-25519.pem Normal file
View file

@ -0,0 +1,8 @@
-----BEGIN CERTIFICATE-----
MIIBCDCBuwIURHJlLlP4SM/dDu22B8MqFTMZ5uAwBQYDK2VwMCcxCzAJBgNVBAYT
AkRFMRgwFgYDVQQDDA93d3cuZXhhbXBsZS5jb20wHhcNMjAxMTE2MTYwMzAxWhcN
MjIxMDE3MTYwMzAxWjAnMQswCQYDVQQGEwJERTEYMBYGA1UEAwwPd3d3LmV4YW1w
bGUuY29tMCowBQYDK2VwAyEAygKTwKSBIgaBMrYlbm7ib5HIWVppEazdP+MOPvud
gpgwBQYDK2VwA0EArdE+8IE/aN2CCd/QEBCsvIGbf+l2JvctYjZ8GGmbBvSzYOKZ
v4USO7H+2weZmbIWqqAVtrEKG0bk2GB4+61fCA==
-----END CERTIFICATE-----

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