Skip to content
Permalink
Browse files

adapt to X509 0.7.0 API

  • Loading branch information...
hannesm committed May 3, 2019
1 parent a8ab219 commit dc53518f46310f384c9526b1d96a8e8f815a09c7
Showing with 41 additions and 49 deletions.
  1. +1 −1 bin/oacmel.ml
  2. +1 −1 letsencrypt.opam
  3. +9 −9 src/acme_client.ml
  4. +2 −2 src/acme_client.mli
  5. +16 −22 src/acme_common.ml
  6. +2 −2 src/letsencrypt.mli
  7. +9 −11 src/primitives.ml
  8. +1 −1 src/primitives.mli
@@ -47,7 +47,7 @@ let main _ rsa_pem csr_pem _acme_dir ip key endpoint cert zone =
| Error e -> Error e
| Ok t ->
Logs.info (fun m -> m "Certificate downloaded");
Bos.OS.File.write cert (Cstruct.to_string @@ X509.Encoding.Pem.Certificate.to_pem_cstruct1 t)
Bos.OS.File.write cert (Cstruct.to_string @@ X509.Certificate.encode_pem t)
in
match r with
| Ok _ -> `Ok ()
@@ -24,7 +24,7 @@ depends: [
"fmt"
"lwt" {>= "2.6.0"}
"nocrypto"
"x509"
"x509" {>= "0.7.0"}
"yojson" {>= "1.6.0"}
"ounit" {with-test}
"dns"
@@ -2,8 +2,6 @@ open Lwt.Infix

open Acme_common

module Pem = X509.Encoding.Pem

type t = {
account_key : Nocrypto.Rsa.priv ;
mutable next_nonce : string ;
@@ -329,13 +327,14 @@ let rec poll_until ?ctx sleep cli challenge =

let body_to_certificate der =
let der = Cstruct.of_string der in
match X509.Encoding.parse der with
| Some crt -> Ok crt
| None -> Error (`Msg "I got gibberish while trying to decode the new certificate.")
match X509.Certificate.decode_der der with
| Ok crt -> Ok crt
| Error (`Msg e) ->
Error (`Msg ("I got gibberish while trying to decode the new certificate: " ^ e))

let new_cert ?ctx cli csr =
let url = cli.d.new_cert in
let der = X509.Encoding.cs_of_signing_request csr |> Cstruct.to_string |> B64u.urlencode in
let der = X509.Signing_request.encode_der csr |> Cstruct.to_string |> B64u.urlencode in
let data = Printf.sprintf {|{"resource": "new-cert", "csr": "%s"}|} der in
http_post_jws ?ctx cli data url >|= function
| Error e -> Error e
@@ -352,12 +351,13 @@ let sign_certificate ?ctx ?(solver = default_http_solver) cli sleep csr =
(fun r domain ->
match r with
| Ok () ->
new_authz ?ctx cli domain solver.get_challenge >>= fun challenge ->
solver.solve_challenge sleep cli challenge domain >>= fun () ->
let name = Domain_name.to_string domain in
new_authz ?ctx cli name solver.get_challenge >>= fun challenge ->
solver.solve_challenge sleep cli challenge name >>= fun () ->
challenge_met ?ctx cli solver.name challenge >>= fun () ->
poll_until ?ctx sleep cli challenge
| Error r -> Lwt.return_error r)
(Ok ()) domains >>= fun () ->
(Ok ()) (Domain_name.Set.elements domains) >>= fun () ->
new_cert ?ctx cli csr >>= fun pem ->
Lwt.return_ok pem

@@ -22,6 +22,6 @@ module Make (Client : Cohttp_lwt.S.Client) : sig

val sign_certificate : ?ctx:Client.ctx ->
?solver:solver_t -> t -> (unit -> unit Lwt.t) ->
X509.CA.signing_request ->
(X509.t, [ `Msg of string ]) result Lwt.t
X509.Signing_request.t ->
(X509.Certificate.t, [ `Msg of string ]) result Lwt.t
end
@@ -7,31 +7,25 @@ type directory_t = {
}

let domains_of_csr csr =
let flat_map f xs = List.map f xs |> List.concat in
let info = X509.CA.info csr in
let open X509.Signing_request in
let info = info csr in
let subject_alt_names =
info.X509.CA.extensions
|> flat_map (function
| `Extensions extensions -> List.map snd extensions
| `Name _ | `Password _ -> [])
|> flat_map (function
| `Subject_alt_name names -> names
| _ -> [])
|> List.map (function
| `DNS name -> name
| _ -> assert false)
match Ext.(find Extensions info.extensions) with
| Some exts ->
begin match X509.Extension.(find Subject_alt_name exts) with
| None -> Domain_name.Set.empty
| Some (_, san) -> match X509.General_name.(find DNS san) with
| None -> Domain_name.Set.empty
| Some names -> names
end
| _ -> Domain_name.Set.empty
in
match subject_alt_names with
| [] ->
if Domain_name.Set.is_empty subject_alt_names then
(* XXX: I'm assuming there is always exactly one CN in a subject. *)
info.X509.CA.subject
|> List.find (function
| `CN _ -> true
| _ -> false)
|> (function
| `CN name -> [name]
| _ -> assert false)
| _ -> subject_alt_names
let cn = X509.Distinguished_name.(get CN info.subject) in
Domain_name.Set.singleton (Domain_name.of_string_exn cn)
else
subject_alt_names

let letsencrypt_url = Uri.of_string
"https://acme-v01.api.letsencrypt.org/directory"
@@ -37,8 +37,8 @@ module Client: sig

val sign_certificate : ?ctx:Client.ctx ->
?solver:solver_t -> t -> (unit -> unit Lwt.t) ->
X509.CA.signing_request ->
(X509.t, [ `Msg of string ]) result Lwt.t
X509.Signing_request.t ->
(X509.Certificate.t, [ `Msg of string ]) result Lwt.t
(** [get_crt ~directory_url ~solver sleep rsa_pem csr_pem] asks the CA identified at url
[directory] for signing [csr_pem] with account key [account_pem] for all
domains in [csr_pem]. This functions accepts an optionl argument
@@ -1,16 +1,14 @@
open Nocrypto

module Pem = X509.Encoding.Pem

let priv_of_pem rsa_pem =
try
match Pem.Private_key.of_pem_cstruct1 (Cstruct.of_string rsa_pem) with
| `RSA priv -> Ok priv
with Invalid_argument e -> Error e
match X509.Private_key.decode_pem (Cstruct.of_string rsa_pem) with
| Ok (`RSA priv) -> Ok priv
| Error (`Msg e) -> Error e

let csr_of_pem pem =
try Ok (Pem.Certificate_signing_request.of_pem_cstruct1 (Cstruct.of_string pem))
with Invalid_argument i -> Error i
match X509.Signing_request.decode_pem (Cstruct.of_string pem) with
| Ok it -> Ok it
| Error (`Msg e) -> Error e

let pub_of_priv = Rsa.pub_of_priv
let pub_of_z ~e ~n = Rsa.{e; n}
@@ -19,16 +17,16 @@ let pub_to_z (key : Rsa.pub) = Rsa.(key.e, key.n)
let rs256_sign priv data =
let data = Cstruct.of_string data in
let h = Hash.SHA256.digest data in
let pkcs1_digest = X509.Encoding.pkcs1_digest_info_to_cstruct (`SHA256, h) in
let pkcs1_digest = X509.Certificate.encode_pkcs1_digest_info (`SHA256, h) in
Rsa.PKCS1.sig_encode ~key:priv pkcs1_digest |> Cstruct.to_string

let rs256_verify pub data signature =
let data = Cstruct.of_string data in
match Rsa.PKCS1.sig_decode ~key:pub (Cstruct.of_string signature) with
| Some pkcs1_digest ->
begin
match X509.Encoding.pkcs1_digest_info_of_cstruct pkcs1_digest with
| Some (`SHA256, hash) -> hash = Hash.SHA256.digest data
match X509.Certificate.decode_pkcs1_digest_info pkcs1_digest with
| Ok (`SHA256, hash) -> hash = Hash.SHA256.digest data
| _ -> false
end
| _ -> false
@@ -2,7 +2,7 @@ open Nocrypto.Rsa

val priv_of_pem : string -> (priv, string) result

val csr_of_pem : string -> (X509.CA.signing_request, string) result
val csr_of_pem : string -> (X509.Signing_request.t, string) result

val pub_of_priv : priv -> pub
val pub_of_z : e:Z.t -> n:Z.t -> pub

0 comments on commit dc53518

Please sign in to comment.
You can’t perform that action at this time.