[From REQ-477] Cherry-pick a few miscellaneous changes

ocaml/tests/suite_init.ml

@@ -17,6 +17,7 @@ let start_server handlers =
   Xapi.listen_unix_socket "/tmp/xapi-test/xapi-unit-test-socket"
 
 let harness_init () =
+  Debug.log_to_stdout ();
   Printexc.record_backtrace true;
   Inventory.inventory_filename :=
     Filename.concat Test_common.working_area "xcp-inventory";

ocaml/xapi/message_forwarding.ml

@@ -555,26 +555,6 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
   module Pool = struct
     include Local.Pool
 
-    (** Add to the Pool's current operations, call a function and then remove from the
-        			current operations. Ensure the allowed_operations are kept up to date. *)
-    let with_pool_operation ~__context ~self ~doc ~op f =
-      let task_id = Ref.string_of (Context.get_task_id __context) in
-      Helpers.retry_with_global_lock ~__context ~doc
-        (fun () ->
-           Xapi_pool_helpers.assert_operation_valid ~__context ~self ~op;
-           Db.Pool.add_to_current_operations ~__context ~self ~key:task_id ~value:op);
-      Xapi_pool_helpers.update_allowed_operations ~__context ~self;
-      (* Then do the action with the lock released *)
-      finally f
-        (* Make sure to clean up at the end *)
-        (fun () ->
-           try
-             Db.Pool.remove_from_current_operations ~__context ~self ~key:task_id;
-             Xapi_pool_helpers.update_allowed_operations ~__context ~self;
-             Helpers.Early_wakeup.broadcast (Datamodel_common._pool, Ref.string_of self);
-           with
-             _ -> ())
-
     let eject ~__context ~host =
       info "Pool.eject: pool = '%s'; host = '%s'" (current_pool_uuid ~__context) (host_uuid ~__context host);
       let local_fn = Local.Pool.eject ~host in
@@ -597,15 +577,15 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
         (String.concat ", " (List.map Ref.string_of heartbeat_srs))
         (String.concat "; " (List.map (fun (k, v) -> k ^ "=" ^ v) configuration));
       let pool = Helpers.get_pool ~__context in
-      with_pool_operation ~__context ~doc:"Pool.ha_enable" ~self:pool ~op:`ha_enable
+      Xapi_pool_helpers.with_pool_operation ~__context ~doc:"Pool.ha_enable" ~self:pool ~op:`ha_enable
         (fun () ->
            Local.Pool.enable_ha __context heartbeat_srs configuration
         )
 
     let disable_ha ~__context =
       info "Pool.disable_ha: pool = '%s'" (current_pool_uuid ~__context);
       let pool = Helpers.get_pool ~__context in
-      with_pool_operation ~__context ~doc:"Pool.ha_disable" ~self:pool ~op:`ha_disable
+      Xapi_pool_helpers.with_pool_operation ~__context ~doc:"Pool.ha_disable" ~self:pool ~op:`ha_disable
         (fun () ->
            Local.Pool.disable_ha __context
         )
@@ -4252,5 +4232,4 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
       info "VUSB.destroy: VUSB = '%s'" (vusb_uuid ~__context self);
       Local.VUSB.destroy ~__context ~self
   end
-
 end

ocaml/xapi/storage_impl.ml

@@ -974,12 +974,3 @@ module Local_domain_socket = struct
     let str = Xmlrpc.string_of_response result in
     Http_svr.response_str req s str
 end
-
-open Xmlrpc_client
-let local_url = Http.Url.(File { path = Filename.concat "/var/lib/xcp" "storage" }, { uri = "/"; query_params = [] })
-
-let rpc ~srcstr ~dststr url call =
-  XMLRPC_protocol.rpc ~transport:(transport_of_url url)
-    ~srcstr ~dststr ~http:(xmlrpc ~version:"1.0" ?auth:(Http.Url.auth_of url) ~query:(Http.Url.get_query_params url) (Http.Url.get_uri url)) call
-
-module Local = Client(struct let rpc = rpc ~srcstr:"smapiv2" ~dststr:"smapiv2" local_url end)

ocaml/xapi/xapi_ha.ml

@@ -558,6 +558,7 @@ module Monitor = struct
                 end
               end
             with e ->
+              log_backtrace ();
               debug "Exception in HA monitor thread: %s" (ExnHelper.string_of_exn e);
               Thread.delay !Xapi_globs.ha_monitor_interval
           done;

ocaml/xapi/xapi_pool_helpers.ml

@@ -76,6 +76,26 @@ let update_allowed_operations ~__context ~self : unit =
   let keys = Hashtbl.fold (fun k v acc -> if v = None then k :: acc else acc) valid [] in
   Db.Pool.set_allowed_operations ~__context ~self ~value:keys
 
+(** Add to the Pool's current operations, call a function and then remove from the
+    current operations. Ensure the allowed_operations are kept up to date. *)
+let with_pool_operation ~__context ~self ~doc ~op f =
+  let task_id = Ref.string_of (Context.get_task_id __context) in
+  Helpers.retry_with_global_lock ~__context ~doc
+    (fun () ->
+       assert_operation_valid ~__context ~self ~op;
+       Db.Pool.add_to_current_operations ~__context ~self ~key:task_id ~value:op);
+  update_allowed_operations ~__context ~self;
+  (* Then do the action with the lock released *)
+  Stdext.Pervasiveext.finally f
+    (* Make sure to clean up at the end *)
+    (fun () ->
+       try
+         Db.Pool.remove_from_current_operations ~__context ~self ~key:task_id;
+         update_allowed_operations ~__context ~self;
+         Helpers.Early_wakeup.broadcast (Datamodel_common._pool, Ref.string_of self);
+       with
+         _ -> ())
+
 (* Checks whether HA enable is in progress *)
 let ha_enable_in_progress ~__context =
   let pool = Helpers.get_pool ~__context in

ocaml/xapi/xapi_pool_helpers.mli

@@ -19,6 +19,9 @@ val assert_operation_valid : __context:Context.t ->
 
 val update_allowed_operations : __context:Context.t -> self:API.ref_pool -> unit
 
+val with_pool_operation : __context:Context.t -> self:API.ref_pool ->
+  doc:string -> op:API.pool_allowed_operations -> (unit -> 'a) -> 'a
+
 val ha_disable_in_progress : __context:Context.t -> bool
 
 val ha_enable_in_progress : __context:Context.t -> bool

ocaml/xapi/xapi_sr.ml

@@ -360,6 +360,8 @@ let update ~__context ~sr =
     (fun () ->
        let sr' = Db.SR.get_uuid ~__context ~self:sr in
        let sr_info = C.SR.stat ~dbg:(Ref.string_of task) ~sr:sr' in
+       Db.SR.set_name_label ~__context ~self:sr ~value:sr_info.name_label;
+       Db.SR.set_name_description ~__context ~self:sr ~value:sr_info.name_description;
        Db.SR.set_physical_size ~__context ~self:sr ~value:sr_info.total_space;
        Db.SR.set_physical_utilisation ~__context ~self:sr ~value:(Int64.sub sr_info.total_space sr_info.free_space);
        Db.SR.set_clustered ~__context ~self:sr ~value:sr_info.clustered;