From ff59f05660bf32b49181bfdc9e28a09aa327c5a4 Mon Sep 17 00:00:00 2001
From: Hannes Mehnert <hannes@mehnert.org>
Date: Sun, 16 Feb 2020 16:33:19 +0100
Subject: [PATCH] compatibility with x509 0.9.0

---
 albatross.opam                    |  2 +-
 client/albatross_client_bistro.ml | 56 +++++++++++++++----------------
 provision/albatross_provision.ml  |  2 +-
 3 files changed, 30 insertions(+), 30 deletions(-)

diff --git a/albatross.opam b/albatross.opam
index ad96a3c..814dab6 100644
--- a/albatross.opam
+++ b/albatross.opam
@@ -20,7 +20,7 @@ depends: [
   "fmt"
   "astring"
   "jsonm"
-  "x509" {>= "0.8.0"}
+  "x509" {>= "0.9.0"}
   "tls" {>= "0.9.0"}
   "nocrypto"
   "asn1-combinators" {>= "0.2.0"}
diff --git a/client/albatross_client_bistro.ml b/client/albatross_client_bistro.ml
index 691c295..927c019 100644
--- a/client/albatross_client_bistro.ml
+++ b/client/albatross_client_bistro.ml
@@ -63,35 +63,35 @@ let handle (host, port) cert key ca id (cmd : Vmm_commands.t) =
       let extensions = Signing_request.Ext.(singleton Extensions extensions) in
       Signing_request.create name ~extensions (`RSA tmpkey)
     in
-    let mycert =
-      let valid_from, valid_until = timestamps 300 in
-      let extensions =
-        let capub = match key with `RSA key -> Nocrypto.Rsa.pub_of_priv key in
-        key_ids extensions Signing_request.((info csr).public_key) (`RSA capub)
-      in
-      let issuer = Certificate.subject cert in
-      Signing_request.sign csr ~valid_from ~valid_until ~extensions key issuer
+    let valid_from, valid_until = timestamps 300 in
+    let extensions =
+      let capub = match key with `RSA key -> Nocrypto.Rsa.pub_of_priv key in
+      key_ids extensions Signing_request.((info csr).public_key) (`RSA capub)
     in
-    let certificates = `Single ([ mycert ; cert ], tmpkey) in
-    X509_lwt.authenticator (`Ca_file ca) >>= fun authenticator ->
-    Lwt_unix.gethostbyname host >>= fun host_entry ->
-    let host_inet_addr = Array.get host_entry.Lwt_unix.h_addr_list 0 in
-    let sockaddr = Lwt_unix.ADDR_INET (host_inet_addr, port) in
-    Vmm_lwt.connect host_entry.h_addrtype sockaddr >>= function
-    | None ->
-      let err =
-        Rresult.R.error_msgf "connection failed to %a" Vmm_lwt.pp_sockaddr sockaddr
-      in
-      Lwt.return err
-    | Some fd ->
-      Logs.debug (fun m -> m "connecting to remote host") ;
-      (* reneg true to allow re-negotiation over the server-authenticated TLS
-         channel (to transport client certificate encrypted), once TLS 1.3 is in
-         (and required) be removed! *)
-      let client = Tls.Config.client ~reneg:true ~certificates ~authenticator () in
-      Tls_lwt.Unix.client_of_fd client (* TODO ~host *) fd >>= fun t ->
-      Logs.debug (fun m -> m "finished tls handshake") ;
-      read t
+    let issuer = Certificate.subject cert in
+    match Signing_request.sign csr ~valid_from ~valid_until ~extensions key issuer with
+    | Error _ as e -> Lwt.return e
+    | Ok mycert ->
+      let certificates = `Single ([ mycert ; cert ], tmpkey) in
+      X509_lwt.authenticator (`Ca_file ca) >>= fun authenticator ->
+      Lwt_unix.gethostbyname host >>= fun host_entry ->
+      let host_inet_addr = Array.get host_entry.Lwt_unix.h_addr_list 0 in
+      let sockaddr = Lwt_unix.ADDR_INET (host_inet_addr, port) in
+      Vmm_lwt.connect host_entry.h_addrtype sockaddr >>= function
+      | None ->
+        let err =
+          Rresult.R.error_msgf "connection failed to %a" Vmm_lwt.pp_sockaddr sockaddr
+        in
+        Lwt.return err
+      | Some fd ->
+        Logs.debug (fun m -> m "connecting to remote host") ;
+        (* reneg true to allow re-negotiation over the server-authenticated TLS
+           channel (to transport client certificate encrypted), once TLS 1.3 is in
+           (and required) be removed! *)
+        let client = Tls.Config.client ~reneg:true ~certificates ~authenticator () in
+        Tls_lwt.Unix.client_of_fd client (* TODO ~host *) fd >>= fun t ->
+        Logs.debug (fun m -> m "finished tls handshake") ;
+        read t
 
 let jump endp cert key ca name cmd =
   Lwt_main.run (handle endp cert key ca name cmd)
diff --git a/provision/albatross_provision.ml b/provision/albatross_provision.ml
index 9db33c5..67f77f1 100644
--- a/provision/albatross_provision.ml
+++ b/provision/albatross_provision.ml
@@ -52,7 +52,7 @@ let sign ?dbname ?certname extensions issuer key csr delta =
         let capub = `RSA (Nocrypto.Rsa.pub_of_priv priv) in
         key_ids extensions X509.Signing_request.((info csr).public_key) capub
   in
-  let cert = X509.Signing_request.sign csr ~valid_from ~valid_until ~extensions key issuer in
+  X509.Signing_request.sign csr ~valid_from ~valid_until ~extensions key issuer >>= fun cert ->
   (match dbname with
    | None -> Ok () (* no DB! *)
    | Some dbname ->