Merge pull request xapi-project#3132 from gaborigloi/honolulu_backport_CA-253489_and_CA-226886

Backport CA-253489 and CA-226886 to Honolulu

Author: gaborigloi

ocaml/xapi/cli_frontend.ml

@@ -855,7 +855,7 @@ let rec cmdtable_data : (string*cmd_spec) list =
     {
       reqd=["file-name"];
       optn=["sr-uuid"];
-      help="Stream new update to the server.";
+      help="Stream new update to the server. The update will be uploaded to the SR <sr-uuid>, or, if it is not specified, to the pool's default SR.";
       implementation=With_fd Cli_operations.update_upload;
       flags=[];
     };

ocaml/xapi/cli_operations.ml

@@ -4306,7 +4306,16 @@ let update_upload fd printer rpc session_id params =
     let sr =
       if List.mem_assoc "sr-uuid" params
       then Client.SR.get_by_uuid rpc session_id (List.assoc "sr-uuid" params)
-      else Client.Pool.get_default_SR ~rpc ~session_id ~self:(List.hd pools)
+      else begin
+        let sr = Client.Pool.get_default_SR ~rpc ~session_id ~self:(List.hd pools) in
+        let ref_is_valid = Server_helpers.exec_with_new_task
+            ~session_id "Checking default SR validity"
+            (fun __context -> Db.is_valid_ref __context sr) in
+        if ref_is_valid then sr
+        else failwith "No sr-uuid parameter was given, and the pool's default SR \
+                       is unspecified or invalid. Please explicitly specify the SR to use \
+                       in the sr-uuid parameter, or set the pool's default SR."
+      end
   in
     let uri = Printf.sprintf "%s%s?session_id=%s&sr_id=%s&task_id=%s"
         prefix Constants.import_raw_vdi_uri (Ref.string_of session_id) (Ref.string_of sr)(Ref.string_of task_id) in

ocaml/xapi/import_raw_vdi.ml

@@ -26,6 +26,9 @@ open Unixext
 open Pervasiveext
 open Client
 
+let fail_task_in_request (req: Request.t) (s: Unix.file_descr) e =
+  ignore(Xapi_http.ref_param_of_req req "task_id"|> Stdext.Opt.map (fun task_id -> TaskHelper.failed ~__context:(Context.from_forwarded_task task_id) e));
+  Http_svr.headers s (Http.http_400_badrequest ())
 
 exception HandleError of exn * (string list) (* Exception to put into the task * headers to return to the client *)
 
@@ -98,32 +101,37 @@ let import vdi (req: Request.t) (s: Unix.file_descr) _ =
 
   (* Perform the SR reachability check using a fresh context/task because
      	   we don't want to complete the task in the forwarding case *)
+
   Server_helpers.exec_with_new_task "VDI.import"
     (fun __context ->
-       Helpers.call_api_functions ~__context
-         (fun rpc session_id ->
-            let sr_opt = match vdi, sr_of_req ~__context req with
-              | Some vdi, _ -> Some (Db.VDI.get_SR ~__context ~self:vdi)
-              | None, Some sr -> Some sr
-              | None, None -> None
-            in
-            match sr_opt with
-            | Some sr ->
-              debug "Checking whether localhost can see SR: %s" (Ref.string_of sr);
-              if (Importexport.check_sr_availability ~__context sr)
-              then localhost_handler rpc session_id vdi req s
-              else
-                let host = Importexport.find_host_for_sr ~__context sr in
-                let address = Db.Host.get_address ~__context ~self:host in
-                return_302_redirect req s address;
+       try
+         Helpers.call_api_functions ~__context
+           (fun rpc session_id ->
+              let sr_opt = match vdi, sr_of_req ~__context req with
+                | Some vdi, _ -> Some (Db.VDI.get_SR ~__context ~self:vdi)
+                | None, Some sr -> Some sr
+                | None, None -> None
+              in
+              match sr_opt with
+              | Some sr ->
+                debug "Checking whether localhost can see SR: %s" (Ref.string_of sr);
+                if (Importexport.check_sr_availability ~__context sr)
+                then localhost_handler rpc session_id vdi req s
+                else
+                  let host = Importexport.find_host_for_sr ~__context sr in
+                  let address = Db.Host.get_address ~__context ~self:host in
+                  return_302_redirect req s address;
+                  None
+              | None ->
+                error "Require an SR or VDI to import";
+                fail_task_in_request req s Api_errors.(Server_error(vdi_missing,[]));
                 None
-            | None ->
-              error "Require an SR or VDI to import";
-              TaskHelper.failed ~__context Api_errors.(Server_error(vdi_missing,[]));
-              Http_svr.headers s (Http.http_400_badrequest ());
-              None
+           )
+       with e ->
+         error "Caught exception in import handler: %s" (ExnHelper.string_of_exn e);
+         fail_task_in_request req s e;
+         raise e
 
-         )
     )
 
 

ocaml/xapi/xapi_http.ml

@@ -29,7 +29,7 @@ let inet_rpc xml =
   let version = "1.1" and path = "/" in
   let http = 80 and https = !Xapi_globs.https_port in
   (* Bypass SSL for localhost, this works even if the management interface
-     	   is disabled. *)
+     is disabled. *)
   let open Xmlrpc_client in
   let transport =
     if Pool_role.is_master ()
@@ -44,6 +44,12 @@ open Http
 
 exception NoAuth
 
+let ref_param_of_req (req: Http.Request.t) param_name =
+  let all = Http.Request.(req.cookie @ req.query) in
+  try Some (Ref.of_string (List.assoc param_name all))
+  with Not_found -> None
+
+
 let get_session_id (req: Request.t) =
   let all = req.Request.cookie @ req.Request.query in
   if List.mem_assoc "session_id" all
@@ -88,15 +94,8 @@ let rbac_audit_params_of (req: Request.t) =
 let assert_credentials_ok realm ?(http_action=realm) ?(fn=Rbac.nofn) (req: Request.t) ic =
   let http_permission = Datamodel.rbac_http_permission_prefix ^ http_action in
   let all = req.Request.cookie @ req.Request.query in
-  let subtask_of =
-    if List.mem_assoc "subtask_of" all
-    then Some (Ref.of_string (List.assoc "subtask_of" all))
-    else None in
-  let task_id =
-    if List.mem_assoc "task_id" all
-    then Some (Ref.of_string (List.assoc "task_id" all))
-    else None
-  in
+  let subtask_of = ref_param_of_req req "subtask_of" in
+  let task_id = ref_param_of_req req "task_id" in
   let rbac_raise permission msg exc =
     (match task_id with
      | None -> ()
@@ -163,14 +162,8 @@ let assert_credentials_ok realm ?(http_action=realm) ?(fn=Rbac.nofn) (req: Reque
 
 let with_context ?(dummy=false) label (req: Request.t) (s: Unix.file_descr) f =
   let all = req.Request.cookie @ req.Request.query in
-  let task_id =
-    if List.mem_assoc "task_id" all
-    then Some (Ref.of_string (List.assoc "task_id" all))
-    else None in
-  let subtask_of =
-    if List.mem_assoc "subtask_of" all
-    then Some (Ref.of_string (List.assoc "subtask_of" all))
-    else None in
+  let task_id = ref_param_of_req req "task_id" in
+  let subtask_of = ref_param_of_req req "subtask_of" in
   let localhost = Server_helpers.exec_with_new_task "with_context" (fun __context -> Helpers.get_localhost ~__context) in
   try
     let session_id,must_logout =
@@ -240,7 +233,7 @@ let bind inetaddr =
     | Unix.ADDR_INET(ip, port) -> Printf.sprintf "INET %s:%d" (Unix.string_of_inet_addr ip) port
     | Unix.ADDR_UNIX path -> Printf.sprintf "UNIX %s" path in
   (* Sometimes we see failures which we hope are transient. If this
-     	   happens then we'll retry a couple of times before failing. *)
+     happens then we'll retry a couple of times before failing. *)
   let start = Unix.gettimeofday () in
   let timeout = 30.0 in (* 30s *)
   let rec bind' () =
@@ -315,4 +308,3 @@ let add_handler (name, handler) =
       | Datamodel.Connect -> Http.Connect
       | Datamodel.Options -> Http.Options
     in Http_svr.Server.add_handler server ty uri h
-