CP-25017: Ask xapi whether to use TLS or NOTLS. (#23)

* Remove the command-line "--no-tls" option. * Instead we make an inquiry over a XenAPI session to find out about network purposes. Signed-off-by: Thomas Sanders <[email protected]>
xapi-project · Oct 9, 2017 · 5be4a75 · 5be4a75
1 parent cd151ff
commit 5be4a75
Show file tree

Hide file tree

Showing 8 changed files with 157 additions and 56 deletions.
diff --git a/src/consts.ml → lib/consts.ml b/src/consts.ml → lib/consts.ml
diff --git a/lib/jbuild b/lib/jbuild
@@ -1,9 +1,28 @@
+(library
+ ((name consts)
+  (modules consts)
+ )
+)
+
+(library
+ ((name local_xapi_session)
+  (modules local_xapi_session)
+  (libraries
+   (consts
+    lwt
+    lwt.unix
+    xen-api-client.lwt
+   )
+  )
+ )
+)
 
 (library
  ((name vbd_store)
   (libraries
    (lwt
     lwt.unix)
   )
+  (modules vbd_store)
  )
 )
diff --git a/lib/local_xapi_session.ml b/lib/local_xapi_session.ml
@@ -0,0 +1,47 @@
+(*
+ * Copyright (C) Citrix Inc
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open Lwt.Infix
+
+module Xen_api = Xen_api_lwt_unix
+
+let wait_for_xapi_and_login () =
+  let rpc = Xen_api.make Consts.xapi_unix_domain_socket_uri in
+  let rec loop () =
+    Lwt.catch
+      (fun () -> Xen_api.Session.login_with_password ~rpc ~uname:"" ~pwd:"" ~version:"1.0" ~originator:"xapi-nbd")
+      (fun e ->
+         Lwt_log.warning_f "Failed to log in via xapi's Unix domain socket: %s; retrying in %f seconds" (Printexc.to_string e) Consts.wait_for_xapi_retry_delay_seconds >>= fun () ->
+         Lwt_unix.sleep Consts.wait_for_xapi_retry_delay_seconds >>= fun () ->
+         loop ()
+      )
+  in
+
+  let timeout () =
+    let timeout_s = Consts.wait_for_xapi_timeout_seconds in
+    Lwt_unix.sleep timeout_s >>= fun () ->
+    let msg = Printf.sprintf "Failed to log in via xapi's Unix domain socket in %f seconds" timeout_s in
+    Lwt_log.fatal msg >>= fun () ->
+    Lwt.fail_with msg
+  in
+
+  Lwt_log.notice_f "Will try to log in via xapi's Unix domain socket for %f seconds" Consts.wait_for_xapi_timeout_seconds >>= fun () ->
+  Lwt.pick [loop (); timeout ()] >|= fun session_id ->
+  (rpc, session_id)
+
+let with_session f =
+  wait_for_xapi_and_login () >>= fun (rpc, session_id) ->
+  Lwt.finalize
+    (fun () -> f rpc session_id)
+    (fun () -> Xen_api.Session.logout ~rpc ~session_id)
diff --git a/lib/local_xapi_session.mli b/lib/local_xapi_session.mli
@@ -0,0 +1,24 @@
+(*
+ * Copyright (C) Citrix Inc
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+(** [with_session f] logs in as the local superuser via xapi's local Unix
+    domain socket, and takes care to close the session when [f] finishes. It
+    keeps retrying the login requests up to
+    {!Consts.wait_for_xapi_timeout_seconds} seconds. If it does not manage to
+    log in before this timeout, it fails with an exception. It waits for
+    {!Consts.wait_for_xapi_retry_delay_seconds} seconds between subsequent
+    login attempts. *)
+val with_session :
+  ((Rpc.call -> Rpc.response Lwt.t) -> [`session] API.Ref.t -> 'a Lwt.t) ->
+  'a Lwt.t
diff --git a/src/cleanup.ml b/src/cleanup.ml
@@ -1,46 +1,21 @@
+(*
+ * Copyright (C) Citrix Inc
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
 open Lwt.Infix
 
 module Xen_api = Xen_api_lwt_unix
 
-module Local_xapi_session = struct
-  let wait_for_xapi_and_login () =
-    let rpc = Xen_api.make Consts.xapi_unix_domain_socket_uri in
-    let rec loop () =
-      Lwt.catch
-        (fun () -> Xen_api.Session.login_with_password ~rpc ~uname:"" ~pwd:"" ~version:"1.0" ~originator:"xapi-nbd")
-        (fun e ->
-           Lwt_log.warning_f "Failed to log in via xapi's Unix domain socket: %s; retrying in %f seconds" (Printexc.to_string e) Consts.wait_for_xapi_retry_delay_seconds >>= fun () ->
-           Lwt_unix.sleep Consts.wait_for_xapi_retry_delay_seconds >>= fun () ->
-           loop ()
-        )
-    in
-
-    let timeout () =
-      let timeout_s = Consts.wait_for_xapi_timeout_seconds in
-      Lwt_unix.sleep timeout_s >>= fun () ->
-      let msg = Printf.sprintf "Failed to log in via xapi's Unix domain socket in %f seconds" timeout_s in
-      Lwt_log.fatal msg >>= fun () ->
-      Lwt.fail_with msg
-    in
-
-    Lwt_log.notice_f "Will try to log in via xapi's Unix domain socket for %f seconds" Consts.wait_for_xapi_timeout_seconds >>= fun () ->
-    Lwt.pick [loop (); timeout ()] >|= fun session_id ->
-    (rpc, session_id)
-
-  (** [with_session f] logs in as the local superuser via xapi's local Unix
-      domain socket, and takes care to close the session when [f] finishes. It
-      keeps retrying the login requests up to
-      {!Consts.wait_for_xapi_timeout_seconds} seconds. If it does not manage to
-      log in before this timeout, it fails with an exception. It waits for
-      {!Consts.wait_for_xapi_retry_delay_seconds} seconds between subsequent
-      login attempts. *)
-  let with_session f =
-    wait_for_xapi_and_login () >>= fun (rpc, session_id) ->
-    Lwt.finalize
-      (fun () -> f rpc session_id)
-      (fun () -> Xen_api.Session.logout ~rpc ~session_id)
-end
-
 let ignore_exn_log_error msg t = Lwt.catch t (fun e -> Lwt_log.error (msg ^ ": " ^ (Printexc.to_string e)))
 
 module VBD = struct

diff --git a/src/cleanup.mli b/src/cleanup.mli
@@ -1,3 +1,17 @@
+(*
+ * Copyright (C) Citrix Inc
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
 (** This module provides two independent mechanisms for cleaning up leaked
     VBDs. They both work on their own, but they can also be combined for extra
     safety. *)

diff --git a/src/jbuild b/src/jbuild
@@ -5,6 +5,8 @@
   (public_name xapi-nbd)
   (libraries
    (cmdliner
+    consts
+    local_xapi_session
     lwt
     lwt.unix
     mirage-block-unix

diff --git a/src/main.ml b/src/main.ml
@@ -80,25 +80,42 @@ let handle_connection fd tls_role =
     )
 
 (* TODO use the version from nbd repository *)
-let init_tls_get_server_ctx ~certfile ~ciphersuites no_tls =
-  if no_tls then None
-  else (
-    let certfile = require_str "certfile" certfile in
-    let ciphersuites = require_str "ciphersuites" ciphersuites in
-    Some (Nbd_lwt_unix.TlsServer
-      (Nbd_lwt_unix.init_tls_get_ctx ~certfile ~ciphersuites)
-    )
+let init_tls_get_server_ctx ~certfile ~ciphersuites =
+  let certfile = require_str "certfile" certfile in
+  let ciphersuites = require_str "ciphersuites" ciphersuites in
+  Some (Nbd_lwt_unix.TlsServer
+    (Nbd_lwt_unix.init_tls_get_ctx ~certfile ~ciphersuites)
   )
 
-let main port certfile ciphersuites no_tls =
+let xapi_says_use_tls () =
+  let refuse log msg = (
+    log msg >>=
+    (fun () -> Lwt.fail_with msg)
+  ) in
+  let ask_xapi rpc session_id =
+    Xen_api.Network.get_all_records ~rpc ~session_id >>=
+    fun all_nets ->
+    let all_porpoises = List.map (fun (_str, net) -> net.API.network_purpose) all_nets |>
+    List.flatten in
+    let tls = List.mem `nbd all_porpoises in
+    let no_tls = List.mem `insecure_nbd all_porpoises in
+    match tls, no_tls with
+    | true, true -> refuse Lwt_log.error "Contradictory XenServer configuration: nbd and insecure_nbd network purposes! Refusing connection."
+    | true, false -> Lwt.return true
+    | false, true -> Lwt.return false
+    | false, false -> refuse Lwt_log.warning "Refusing connection: no network has purpose nbd or insecure_nbd:"
+  in
+  Local_xapi_session.with_session ask_xapi
+
+let main port certfile ciphersuites =
   let t () =
-    Lwt_log.notice_f "Starting xapi-nbd: port = '%d'; certfile = '%s'; ciphersuites = '%s' no_tls = '%b'" port certfile ciphersuites no_tls >>= fun () ->
+    Lwt_log.notice_f "Starting xapi-nbd: port = '%d'; certfile = '%s'; ciphersuites = '%s'" port certfile ciphersuites >>= fun () ->
     (* We keep a persistent record of the VBDs that we've created but haven't
        yet cleaned up. At startup we go through this list in case some VBDs
        got leaked after the previous run due to a crash and clean them up. *)
     Cleanup.Persistent.cleanup () >>= fun () ->
     Lwt_log.notice "Initialising TLS" >>= fun () ->
-    let tls_role = init_tls_get_server_ctx ~certfile ~ciphersuites no_tls in
+    let tls_server_role = init_tls_get_server_ctx ~certfile ~ciphersuites in
     let sock = Lwt_unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
     Lwt.finalize
       (fun () ->
@@ -117,7 +134,13 @@ let main port certfile ciphersuites no_tls =
              ignore_exn_log_error "Caught exception while handling client"
                (fun () ->
                   Lwt.finalize
-                    (fun () -> handle_connection fd tls_role)
+                    (fun () -> (
+                      xapi_says_use_tls () >>=
+                      fun tls -> (
+                        let tls_role = if tls then tls_server_role else None in
+                        handle_connection fd tls_role)
+                      )
+                    )
                     (* ignore the exception resulting from double-closing the socket *)
                     (ignore_exn_delayed (fun () -> Lwt_unix.close fd))
                )
@@ -158,22 +181,19 @@ let certfile =
 let ciphersuites =
   let doc = "Set of ciphersuites for TLS (specified in the format accepted by OpenSSL, stunnel etc.)" in
   Arg.(value & opt string "!EXPORT:RSA+AES128-SHA256" & info ["ciphersuites"] ~doc)
-let no_tls =
-  let doc = "Use NOTLS mode (refusing TLS) instead of the default FORCEDTLS." in
-  Arg.(value & flag & info ["no-tls"] ~doc)
 
 let cmd =
   let doc = "Expose VDIs over authenticated NBD connections" in
   let man = [
     `S "DESCRIPTION";
     `P "Expose all accessible VDIs over NBD. Every VDI is addressible through a URI, where the URI will be authenticated by xapi.";
   ] @ help in
-  (* TODO for port, certfile, ciphersuites and no_tls: use definitions from nbd repository. *)
+  (* TODO for port, certfile, ciphersuites: use definitions from nbd repository. *)
   (* But consider making ciphersuites mandatory here in a local definition. *)
   let port =
     let doc = "Local port to listen for connections on" in
     Arg.(value & opt int Consts.standard_nbd_port & info [ "port" ] ~doc) in
-  Term.(ret (pure main $ port $ certfile $ ciphersuites $ no_tls)),
+  Term.(ret (pure main $ port $ certfile $ ciphersuites)),
   Term.info "xapi-nbd" ~version:"1.0.0" ~doc ~man ~sdocs:_common_options
 
 let setup_logging () =