Implement VDI.get_nbd_info XenAPI call

Forward the call to master, because this call only does database
accesses, but it does many of them, so it's more efficient to do this on
the master.

I have skipped empty IPs, because the IPs can be temporarily empty if
they are configured via DHCP. And PIFs may not even have an IP, in which
case it is the empty string again.

In order to correctly format the IPv6 addresses in the output URIs and
conform to the RFC3986 specification of URI syntax, which says that IPv6
addresses should be enclosed in square brackets, I had to construct the
URIs by hand. I could not use the Uri library, because it would
incorrectly escape the colon in the IPv6 addresses using a URL escape
code.

Signed-off-by: Gabor Igloi <[email protected]>

Author: gaborigloi

ocaml/idl/datamodel.ml

@@ -6617,6 +6617,17 @@ let vdi_export_changed_blocks = call
     ~allowed_roles:_R_VM_OP
     ()
 
+let vdi_get_nbd_info = call
+    ~name:"get_nbd_info"
+    ~in_oss_since:None
+    ~in_product_since:rel_inverness
+    ~params:[Ref _vdi, "self", "The VDI to access via NBD."]
+    ~errs: [Api_errors.vdi_incompatible_type]
+    ~result:(Set String, "The list of URIs.")
+    ~doc:"Get a list of URIs specifying how to access this VDI via the NBD server of XenServer. A URI will be returned for each PIF of each host that is connected to the VDI's SR. An empty list is returned in case no network has a PIF on a host with access to the relevant SR. To access the given VDI, any of the returned URIs can be passed to the NBD server running at the IP address and port specified by that URI as the export name."
+    ~allowed_roles:_R_VM_ADMIN
+    ()
+
 (** A virtual disk *)
 let vdi =
   create_obj ~in_db:true ~in_product_since:rel_rio ~in_oss_since:oss_since_303 ~internal_deprecated_since:None ~persist:PersistEverything ~gen_constructor_destructor:true ~name:_vdi ~descr:"A virtual disk image"
@@ -6653,6 +6664,7 @@ let vdi =
                vdi_disable_cbt;
                vdi_data_destroy;
                vdi_export_changed_blocks;
+               vdi_get_nbd_info;
               ]
     ~contents:
       ([ uid _vdi;

ocaml/xapi/message_forwarding.ml

@@ -3615,6 +3615,10 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
            forward_vdi_op ~local_fn ~__context ~self:vdi_to
              (fun session_id rpc -> Client.VDI.export_changed_blocks ~rpc ~session_id ~vdi_from ~vdi_to))
 
+    let get_nbd_info ~__context ~self =
+      info "VDI.get_nbd_info: vdi  = '%s'" (vdi_uuid ~__context self);
+      Local.VDI.get_nbd_info ~__context ~self
+
   end
   module VBD = struct
 

ocaml/xapi/test_common.ml

@@ -378,3 +378,7 @@ let make_pool_update ~__context
     } in
   Xapi_pool_update.create_update_record ~__context ~update:ref ~update_info ~vdi;
   ref
+
+let make_session ~__context ?(ref=Ref.make ()) ?(uuid=make_uuid ()) ?(this_host=Ref.null) ?(this_user=Ref.null) ?(last_active=API.Date.never) ?(pool=false) ?(other_config=[]) ?(is_local_superuser=false) ?(subject=Ref.null) ?(validation_time=API.Date.never) ?(auth_user_sid="") ?(auth_user_name="") ?(rbac_permissions=[]) ?(parent=Ref.null) ?(originator="test") () =
+  Db.Session.create ~__context ~ref ~uuid ~this_host ~this_user ~last_active ~pool ~other_config ~is_local_superuser ~subject ~validation_time ~auth_user_sid ~auth_user_name ~rbac_permissions ~parent ~originator;
+  ref

ocaml/xapi/test_vdi_cbt.ml

@@ -94,10 +94,108 @@ let test_clone_and_snapshot_correctly_sets_cbt_enabled_field () =
   let clone = Xapi_vdi.clone ~__context ~vdi ~driver_params:[] in
   assert_cbt_enabled_field_is ~vdi:clone ~value:false ~msg:"CBT should always be disabled on the VDI created by VDI.clone"
 
+let test_get_nbd_info =
+  let make_host __context sR ?(pbd_attached=true) pifs () =
+    let host = Test_common.make_host ~__context () in
+    let _: _ API.Ref.t = Test_common.make_pbd ~__context ~host ~sR ~currently_attached:pbd_attached () in
+    List.iter (function (network, iP, iPv6, attached) ->
+        let self = Test_common.make_pif ~__context ~network ~host ~iP ~iPv6 () in
+        Db.PIF.set_currently_attached ~__context ~self ~value:attached
+      ) pifs;
+    host
+  in
+
+  let setup_test () =
+    let __context = Mock.make_context_with_new_db "Mock context" in
+    let session_id = Test_common.make_session ~__context () in
+    let __context = Context.make ~__context ~session_id "test" in
+    let make_host = make_host __context in
+
+    let sr_of_vdi = Test_common.make_sr ~__context () in
+    let network = Test_common.make_network ~__context () in
+    let vdi = Test_common.make_vdi ~__context ~sR:sr_of_vdi () in
+
+    (__context, make_host, sr_of_vdi, network, vdi)
+  in
+
+  let test_returns_correct_uris () =
+    let (__context, make_host, sr_of_vdi, network_1, self) = setup_test () in
+    let uuid = Db.VDI.get_uuid ~__context ~self in
+    let other_sr = Test_common.make_sr ~__context () in
+    let network_2 = Test_common.make_network ~__context () in
+
+    (* Hosts connected to both the VDI's SR and a network *)
+    let _: _ API.Ref.t = make_host
+        sr_of_vdi
+        [(network_1, "92.40.98.91", [], true); (network_1, "92.40.98.92", [], true);
+         (* this PIF is not currently attached: *)
+         (network_2, "92.40.98.93", ["10e1:bdb8:05a3:0002:03ae:8a24:0371:0001"], false)] () in
+    let _: _ API.Ref.t = make_host
+        sr_of_vdi
+        [(network_2, "92.40.98.94", ["10e1:bdb8:05a3:0002:03ae:8a24:0371:0002";"10e1:bdb8:05a3:0002:03ae:8a24:0371:0003"], true)] () in
+    (* Hosts not connected to a network or without an IP address *)
+    let _: _ API.Ref.t = make_host sr_of_vdi [(network_1, "92.40.98.95", ["10e1:bdb8:05a3:0002:03ae:8a24:0371:0004"], false)] () in
+    let _: _ API.Ref.t = make_host sr_of_vdi [(network_1, "", [], true)] () in
+    (* Hosts not connected to the VDI's SR *)
+    let _: _ API.Ref.t = make_host sr_of_vdi ~pbd_attached:false [(network_1, "92.40.98.96", [], true)] () in
+    let _: _ API.Ref.t = make_host other_sr [(network_1, "92.40.98.97", ["10e1:bdb8:05a3:0002:03ae:8a24:0371:0005"], true)] () in
+    (* Hosts not connected to either *)
+    let _: _ API.Ref.t = make_host sr_of_vdi [] () in
+
+    let nbd_info = Xapi_vdi.get_nbd_info ~__context ~self in
+
+    let session_id = Context.get_session_id __context |> Ref.string_of in
+    let expected =
+      [ "nbd://92.40.98.91:10809/" ^ uuid ^ "?session_id=" ^ session_id
+      ; "nbd://92.40.98.92:10809/" ^ uuid ^ "?session_id=" ^ session_id
+      ; "nbd://92.40.98.94:10809/" ^ uuid ^ "?session_id=" ^ session_id
+      ; "nbd://[10e1:bdb8:05a3:0002:03ae:8a24:0371:0002]:10809/" ^ uuid ^ "?session_id=" ^ session_id
+      ; "nbd://[10e1:bdb8:05a3:0002:03ae:8a24:0371:0003]:10809/" ^ uuid ^ "?session_id=" ^ session_id
+      ]
+    in
+    let sort = List.sort String.compare in
+    OUnit.assert_equal ~printer:(String.concat ", ") (sort expected) (sort nbd_info)
+  in
+
+  let test_returns_empty_list_when_no_host_is_connected_to_sr () =
+    let (__context, make_host, sr_of_vdi, network, self) = setup_test () in
+    let _: _ API.Ref.t = make_host sr_of_vdi ~pbd_attached:false [(network, "92.40.98.93", [], true)] () in
+    OUnit.assert_equal [] (Xapi_vdi.get_nbd_info ~__context ~self);
+    Db.PBD.get_all ~__context |> List.iter (fun self -> Db.PBD.destroy ~__context ~self);
+    OUnit.assert_equal [] (Xapi_vdi.get_nbd_info ~__context ~self)
+  in
+
+  let test_returns_empty_list_when_no_host_is_connected_to_network () =
+    let (__context, make_host, sr_of_vdi, network, self) = setup_test () in
+    let _: _ API.Ref.t = make_host sr_of_vdi [(network, "92.40.98.93", [], false)] () in
+    OUnit.assert_equal [] (Xapi_vdi.get_nbd_info ~__context ~self);
+    Db.PIF.get_all ~__context |> List.iter (fun self -> Db.PIF.destroy ~__context ~self);
+    OUnit.assert_equal [] (Xapi_vdi.get_nbd_info ~__context ~self)
+  in
+
+  let test_disallowed_for_cbt_metadata_vdi () =
+    let (__context, make_host, sr_of_vdi, network, self) = setup_test () in
+    let _: _ API.Ref.t = make_host sr_of_vdi [(network, "92.40.98.93", [], true)] () in
+    Db.VDI.set_type ~__context ~self ~value:`cbt_metadata;
+    let _type = Record_util.vdi_type_to_string `cbt_metadata in
+    OUnit.assert_raises
+      Api_errors.(Server_error (vdi_incompatible_type, [Ref.string_of self; _type]))
+      (fun () -> Xapi_vdi.get_nbd_info ~__context ~self)
+  in
+
+  let open OUnit in
+  "test_get_nbd_info" >:::
+  [ "test_returns_correct_uris" >:: test_returns_correct_uris
+  ; "test_returns_empty_list_when_no_host_is_connected_to_sr" >:: test_returns_empty_list_when_no_host_is_connected_to_sr
+  ; "test_returns_empty_list_when_no_host_is_connected_to_network" >:: test_returns_empty_list_when_no_host_is_connected_to_network
+  ; "test_disallowed_for_cbt_metadata_vdi" >:: test_disallowed_for_cbt_metadata_vdi
+  ]
+
 let test =
   let open OUnit in
   "test_vdi_cbt" >:::
   [ "test_cbt_enable_disable" >:: test_cbt_enable_disable
   ; "test_set_metadata_of_pool_doesnt_allow_cbt_metadata_vdi" >:: test_set_metadata_of_pool_doesnt_allow_cbt_metadata_vdi
   ; "test_clone_and_snapshot_correctly_sets_cbt_enabled_field" >:: test_clone_and_snapshot_correctly_sets_cbt_enabled_field
+  ; test_get_nbd_info
   ]

ocaml/xapi/xapi_vdi.ml

@@ -870,6 +870,38 @@ let export_changed_blocks ~__context ~vdi_from ~vdi_to =
   Storage_access.transform_storage_exn
     (fun () ->
        C.VDI.export_changed_blocks ~dbg:(Ref.string_of task) ~sr ~vdi_from ~vdi_to
-    );
+    )
+
+let get_nbd_info ~__context ~self =
+  if (Db.VDI.get_type ~__context ~self) = `cbt_metadata then begin
+    error "VDI.get_nbd_info: called with a VDI of type cbt_metadata (at %s)" __LOC__;
+    raise (Api_errors.Server_error (Api_errors.vdi_incompatible_type, [ Ref.string_of self; Record_util.vdi_type_to_string `cbt_metadata ]))
+  end;
+
+  let sr = Db.VDI.get_SR ~__context ~self in
+  let hosts_with_attached_pbds =
+    Db.SR.get_PBDs ~__context ~self:sr
+    |> List.filter (fun pbd -> Db.PBD.get_currently_attached ~__context ~self:pbd)
+    |> List.map (fun pbd -> Db.PBD.get_host ~__context ~self:pbd)
+  in
+  let get_ips host =
+    let get_ips pif =
+      let not_empty = (<>) "" in
+      let v6_ips = Db.PIF.get_IPv6 ~__context ~self:pif |> List.filter not_empty |> List.map (fun s -> "[" ^ s ^ "]") in
+      let v4_ip = Db.PIF.get_IP ~__context ~self:pif in
+      if not_empty v4_ip then v4_ip :: v6_ips else v6_ips
+    in
+    let attached_pifs =
+      Db.Host.get_PIFs ~__context ~self:host
+      |> List.filter (fun pif -> Db.PIF.get_currently_attached ~__context ~self:pif)
+    in
+    attached_pifs |> List.map get_ips |> List.flatten
+  in
+  let ips = hosts_with_attached_pbds |> List.map get_ips |> List.flatten in
+
+  let vdi_uuid = Db.VDI.get_uuid ~__context ~self in
+  let session_id = Context.get_session_id __context |> Ref.string_of in
+  ips
+  |> List.map (fun ip -> Printf.sprintf "nbd://%s:10809/%s?session_id=%s" ip vdi_uuid session_id)
 
 (* let pool_migrate = "See Xapi_vm_migrate.vdi_pool_migrate!" *)

ocaml/xapi/xapi_vdi.mli

@@ -212,3 +212,5 @@ val disable_cbt :
   __context:Context.t -> self:API.ref_VDI -> unit
 val export_changed_blocks :
   __context:Context.t -> vdi_from:API.ref_VDI -> vdi_to:API.ref_VDI -> string
+val get_nbd_info :
+  __context:Context.t -> self:API.ref_VDI -> string list