Created
September 9, 2021 16:32
-
-
Save dinosaure/76109ee955b736e00fe936707719c618 to your computer and use it in GitHub Desktop.
certificate in the flight
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
open Rresult | |
let prefix = X509.Distinguished_name.[Relative_distinguished_name.singleton (CN "PTT")] | |
let cacert_dn = X509.Distinguished_name.(prefix @ [Relative_distinguished_name.singleton (CN "Ephemeral CA for PTT") ]) | |
let cacert_lifetime = Ptime.Span.v (365, 0L) | |
let cacert_serial_number = Z.zero | |
let run domain_name seed = | |
Domain_name.of_string domain_name >>= Domain_name.host >>= fun domain_name -> | |
let private_key = | |
let seed = Cstruct.of_string (Base64.decode_exn ~pad:false seed) in | |
let g = Mirage_crypto_rng.(create ~seed (module Fortuna)) in | |
Mirage_crypto_pk.Rsa.generate ~g ~bits:2048 () in | |
let valid_from = Ptime.v (Ptime_clock.now_d_ps ()) in | |
Ptime.add_span valid_from cacert_lifetime | |
|> Option.to_result ~none:(R.msgf "End time out of range") >>= fun valid_until -> | |
X509.Signing_request.create cacert_dn (`RSA private_key) >>= fun ca_csr -> | |
let extensions = | |
let open X509.Extension in | |
let key_id = X509.Public_key.id X509.Signing_request.((info ca_csr).public_key) in | |
let authority_key_id = | |
(Some key_id, X509.General_name.(singleton Directory [ cacert_dn ]), Some cacert_serial_number) in | |
empty | |
|> add Subject_alt_name (true, X509.General_name.(singleton DNS [ Domain_name.to_string domain_name ])) | |
|> add Basic_constraints (true, (false, None)) | |
|> add Key_usage (true, [ `Digital_signature; `Content_commitment; `Key_encipherment ]) | |
|> add Subject_key_id (false, key_id) | |
|> add Authority_key_id (false, authority_key_id) in | |
X509.Signing_request.sign ~valid_from ~valid_until ~extensions | |
~serial:cacert_serial_number ca_csr (`RSA private_key) cacert_dn | |
|> R.reword_error (R.msgf "%a" X509.Validation.pp_signature_error) >>= fun certificate -> | |
let fingerprint = X509.Certificate.fingerprint `SHA256 certificate in | |
Fmt.pr "%a:SHA256:%s\n%!" Domain_name.pp domain_name (Base64.encode_string (Cstruct.to_string fingerprint)) ; | |
Fmt.pr "%s\n%!" (Base64.encode_string (Cstruct.to_string (X509.Certificate.encode_der certificate))) ; | |
Ok () | |
let () = | |
Mirage_crypto_rng_unix.initialize () ; | |
R.failwith_error_msg (run Sys.argv.(1) Sys.argv.(2)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment