Skip to content

Commit

Permalink
Merge pull request #5476 from minglumlu/private/mingl/CA-389206
Browse files Browse the repository at this point in the history 
CA-389206: Revert more changes in CLI protocol
  • Loading branch information
@robhoes
robhoes authored Feb 28, 2024
2 parents b5a76a3 + cfc5b63 commit 28e711f
Show file tree
Hide file tree
Showing 5 changed files with 191 additions and 180 deletions.
10 changes: 1 addition & 9 deletions ocaml/xapi-cli-protocol/cli_protocol.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,6 @@ type command =
| Debug of string (* debug message to optionally display *)
| Load of string (* filename *)
| HttpGet of string * string (* filename * path *)
| PrintHttpGetJson of string (* path *)
| HttpPut of string * string (* filename * path *)
| HttpConnect of string (* path *)
| Prompt (* request the user enter some text *)
Expand Down Expand Up @@ -74,8 +73,6 @@ let string_of_command = function
"Load " ^ x
| HttpGet (filename, path) ->
"HttpGet " ^ path ^ " -> " ^ filename
| PrintHttpGetJson path ->
"PrintHttpGetJson " ^ path ^ " -> stdout"
| HttpPut (filename, path) ->
"HttpPut " ^ path ^ " -> " ^ filename
| HttpConnect path ->
Expand Down Expand Up @@ -165,7 +162,7 @@ let unmarshal_list pos f =
(*****************************************************************************)
(* Marshal/Unmarshal higher-level messages *)

(* Highest command id: 18 *)
(* Highest command id: 17 *)

let marshal_command = function
| Print x ->
Expand All @@ -176,8 +173,6 @@ let marshal_command = function
marshal_int 1 ^ marshal_string x
| HttpGet (a, b) ->
marshal_int 12 ^ marshal_string a ^ marshal_string b
| PrintHttpGetJson a ->
marshal_int 18 ^ marshal_string a
| HttpPut (a, b) ->
marshal_int 13 ^ marshal_string a ^ marshal_string b
| HttpConnect a ->
Expand Down Expand Up @@ -228,9 +223,6 @@ let unmarshal_command pos =
| 16 ->
let body, pos = unmarshal_string pos in
(PrintStderr body, pos)
| 18 ->
let a, pos = unmarshal_string pos in
(PrintHttpGetJson a, pos)
| n ->
raise (Unknown_tag ("command", n))

Expand Down
9 changes: 0 additions & 9 deletions ocaml/xapi-cli-server/cli_frontend.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1047,15 +1047,6 @@ let rec cmdtable_data : (string * cmd_spec) list =
; flags= [Neverforward]
}
)
; ( "host-updates-show-available"
, {
reqd= []
; optn= []
; help= "Show available updates for a specified host."
; implementation= With_fd Cli_operations.host_updates_show_available
; flags= [Host_selectors]
}
)
; ( "patch-upload"
, {
reqd= ["file-name"]
Expand Down
228 changes: 131 additions & 97 deletions ocaml/xapi-cli-server/cli_operations.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5462,37 +5462,6 @@ let wait_for_task_complete rpc session_id task_id =
Thread.delay 1.0
done

let check_task_status ?(quiet_on_success = false) ~rpc ~session_id ~task ~fd
~label ~ok () =
(* if the client thinks it's ok, check that the server does too *)
match Client.Task.get_status ~rpc ~session_id ~self:task with
| `success when ok && not quiet_on_success ->
marshal fd (Command (Print (Printf.sprintf "%s succeeded" label)))
| `success when ok && quiet_on_success ->
()
| `success ->
marshal fd
(Command
(PrintStderr (Printf.sprintf "%s failed, unknown error.\n" label))
) ;
raise (ExitWithError 1)
| `failure ->
let result = Client.Task.get_error_info ~rpc ~session_id ~self:task in
if result = [] then
marshal fd
(Command
(PrintStderr (Printf.sprintf "%s failed, unknown error\n" label))
)
else
raise (Api_errors.Server_error (List.hd result, List.tl result))
| `cancelled ->
marshal fd (Command (PrintStderr (Printf.sprintf "%s cancelled\n" label))) ;
raise (ExitWithError 1)
| _ ->
marshal fd (Command (PrintStderr "Internal error\n")) ;
(* should never happen *)
raise (ExitWithError 1)

let download_file rpc session_id task fd filename uri label =
marshal fd (Command (HttpGet (filename, uri))) ;
let response = ref (Response Wait) in
Expand All @@ -5515,8 +5484,34 @@ let download_file rpc session_id task fd filename uri label =
wait_for_task_complete rpc session_id task ;
(* Check the server status -- even if the client thinks it's ok, we need
to check that the server does too. *)
let quiet_on_success = if filename = "" then true else false in
check_task_status ~rpc ~session_id ~task ~fd ~label ~ok ~quiet_on_success ()
match Client.Task.get_status ~rpc ~session_id ~self:task with
| `success ->
if ok then (
if filename <> "" then
marshal fd (Command (Print (Printf.sprintf "%s succeeded" label)))
) else (
marshal fd
(Command
(PrintStderr (Printf.sprintf "%s failed, unknown error.\n" label))
) ;
raise (ExitWithError 1)
)
| `failure ->
let result = Client.Task.get_error_info ~rpc ~session_id ~self:task in
if result = [] then
marshal fd
(Command
(PrintStderr (Printf.sprintf "%s failed, unknown error\n" label))
)
else
raise (Api_errors.Server_error (List.hd result, List.tl result))
| `cancelled ->
marshal fd (Command (PrintStderr (Printf.sprintf "%s cancelled\n" label))) ;
raise (ExitWithError 1)
| _ ->
marshal fd (Command (PrintStderr "Internal error\n")) ;
(* should never happen *)
raise (ExitWithError 1)

let download_file_with_task fd rpc session_id filename uri query label task_name
=
Expand Down Expand Up @@ -5680,17 +5675,24 @@ let vm_import fd _printer rpc session_id params =
in
marshal fd (Command (Print (String.concat "," uuids)))

let command_in_task ~rpc ~session_id ~fd ~obj ~label ~quiet_on_success f =
let task =
let blob_get fd _printer rpc session_id params =
let blob_uuid = List.assoc "uuid" params in
let blob_ref = Client.Blob.get_by_uuid ~rpc ~session_id ~uuid:blob_uuid in
let filename = List.assoc "filename" params in
let blobtask =
Client.Task.create ~rpc ~session_id
~label:(Printf.sprintf "%s (ref=%s)" label (Ref.string_of obj))
~label:(Printf.sprintf "Obtaining blob, ref=%s" (Ref.string_of blob_ref))
~description:""
in
Client.Task.set_progress ~rpc ~session_id ~self:task ~value:(-1.0) ;
let command = f session_id task obj in
Client.Task.set_progress ~rpc ~session_id ~self:blobtask ~value:(-1.0) ;
let bloburi =
Printf.sprintf "%s?session_id=%s&task_id=%s&ref=%s" Constants.blob_uri
(Ref.string_of session_id) (Ref.string_of blobtask)
(Ref.string_of blob_ref)
in
finally
(fun () ->
marshal fd (Command command) ;
marshal fd (Command (HttpGet (filename, bloburi))) ;
let response = ref (Response Wait) in
while !response = Response Wait do
response := unmarshal fd
Expand All @@ -5700,48 +5702,106 @@ let command_in_task ~rpc ~session_id ~fd ~obj ~label ~quiet_on_success f =
| Response OK ->
true
| Response Failed ->
(* Need to check whether the thin cli managed to contact the server
* or not. If not, we need to mark the task as failed.
*)
if Client.Task.get_progress ~rpc ~session_id ~self:task < 0.0 then
Client.Task.set_status ~rpc ~session_id ~self:task ~value:`failure ;
if Client.Task.get_progress ~rpc ~session_id ~self:blobtask < 0.0
then
Client.Task.set_status ~rpc ~session_id ~self:blobtask
~value:`failure ;
false
| _ ->
false
in
wait_for_task_complete rpc session_id task ;
check_task_status ~rpc ~session_id ~task ~fd ~label ~ok ~quiet_on_success
()
wait_for_task_complete rpc session_id blobtask ;
(* if the client thinks it's ok, check that the server does too *)
match Client.Task.get_status ~rpc ~session_id ~self:blobtask with
| `success ->
if ok then
marshal fd (Command (Print "Blob get succeeded"))
else (
marshal fd
(Command (PrintStderr "Blob get failed, unknown error.\n")) ;
raise (ExitWithError 1)
)
| `failure ->
let result =
Client.Task.get_error_info ~rpc ~session_id ~self:blobtask
in
if result = [] then
marshal fd (Command (PrintStderr "Blob get failed, unknown error\n"))
else
raise (Api_errors.Server_error (List.hd result, List.tl result))
| `cancelled ->
marshal fd (Command (PrintStderr "Blob get cancelled\n")) ;
raise (ExitWithError 1)
| _ ->
marshal fd (Command (PrintStderr "Internal error\n")) ;
(* should never happen *)
raise (ExitWithError 1)
)
(fun () -> Client.Task.destroy ~rpc ~session_id ~self:task)

let blob_uri ~session_id ~task ~blob =
let query =
[
("session_id", [Ref.string_of session_id])
; ("task_id", [Ref.string_of task])
; ("ref", [Ref.string_of blob])
]
in
Uri.make ~path:Constants.blob_uri ~query () |> Uri.to_string

let blob_get fd _printer rpc session_id params =
let blob_uuid = List.assoc "uuid" params in
let blob_ref = Client.Blob.get_by_uuid ~rpc ~session_id ~uuid:blob_uuid in
let filename = List.assoc "filename" params in
command_in_task ~rpc ~session_id ~fd ~obj:blob_ref ~label:"GET blob"
~quiet_on_success:false (fun session_id task blob ->
HttpGet (filename, blob_uri ~session_id ~task ~blob)
)
(fun () -> Client.Task.destroy ~rpc ~session_id ~self:blobtask)

let blob_put fd _printer rpc session_id params =
let blob_uuid = List.assoc "uuid" params in
let blob_ref = Client.Blob.get_by_uuid ~rpc ~session_id ~uuid:blob_uuid in
let filename = List.assoc "filename" params in
command_in_task ~rpc ~session_id ~fd ~obj:blob_ref ~label:"PUT blob"
~quiet_on_success:false (fun session_id task blob ->
HttpPut (filename, blob_uri ~session_id ~task ~blob)
)
let blobtask =
Client.Task.create ~rpc ~session_id
~label:(Printf.sprintf "Blob PUT, ref=%s" (Ref.string_of blob_ref))
~description:""
in
Client.Task.set_progress ~rpc ~session_id ~self:blobtask ~value:(-1.0) ;
let bloburi =
Printf.sprintf "%s?session_id=%s&task_id=%s&ref=%s" Constants.blob_uri
(Ref.string_of session_id) (Ref.string_of blobtask)
(Ref.string_of blob_ref)
in
finally
(fun () ->
marshal fd (Command (HttpPut (filename, bloburi))) ;
let response = ref (Response Wait) in
while !response = Response Wait do
response := unmarshal fd
done ;
let ok =
match !response with
| Response OK ->
true
| Response Failed ->
if Client.Task.get_progress ~rpc ~session_id ~self:blobtask < 0.0
then
Client.Task.set_status ~rpc ~session_id ~self:blobtask
~value:`failure ;
false
| _ ->
false
in
wait_for_task_complete rpc session_id blobtask ;
(* if the client thinks it's ok, check that the server does too *)
match Client.Task.get_status ~rpc ~session_id ~self:blobtask with
| `success ->
if ok then
marshal fd (Command (Print "Blob put succeeded"))
else (
marshal fd
(Command (PrintStderr "Blob put failed, unknown error.\n")) ;
raise (ExitWithError 1)
)
| `failure ->
let result =
Client.Task.get_error_info ~rpc ~session_id ~self:blobtask
in
if result = [] then
marshal fd (Command (PrintStderr "Blob put failed, unknown error\n"))
else
raise (Api_errors.Server_error (List.hd result, List.tl result))
| `cancelled ->
marshal fd (Command (PrintStderr "Blob put cancelled\n")) ;
raise (ExitWithError 1)
| _ ->
marshal fd (Command (PrintStderr "Internal error\n")) ;
(* should never happen *)
raise (ExitWithError 1)
)
(fun () -> Client.Task.destroy ~rpc ~session_id ~self:blobtask)

let blob_create printer rpc session_id params =
let name = List.assoc "name" params in
Expand Down Expand Up @@ -7624,23 +7684,6 @@ let update_resync_host _printer rpc session_id params =
let host = Client.Host.get_by_uuid ~rpc ~session_id ~uuid in
Client.Pool_update.resync_host ~rpc ~session_id ~host

let get_avail_updates_uri ~session_id ~task ~host =
let query =
[
("session_id", [Ref.string_of session_id])
; ("task_id", [Ref.string_of task])
; ("host_refs", [Ref.string_of host])
]
in
Uri.make ~path:Constants.get_updates_uri ~query () |> Uri.to_string

let print_avail_updates ~rpc ~session_id ~fd ~host =
command_in_task ~rpc ~session_id ~fd ~obj:host
~label:"Print available updates for host" ~quiet_on_success:true
(fun session_id task host ->
PrintHttpGetJson (get_avail_updates_uri ~session_id ~task ~host)
)

let host_apply_updates _printer rpc session_id params =
let hash = List.assoc "hash" params in
ignore
Expand All @@ -7655,15 +7698,6 @@ let host_apply_updates _printer rpc session_id params =
params ["hash"]
)

let host_updates_show_available fd _printer rpc session_id params =
do_host_op rpc session_id ~multiple:false
(fun _ host ->
let host = host.getref () in
print_avail_updates ~rpc ~session_id ~fd ~host
)
params []
|> ignore

module SDN_controller = struct
let introduce printer rpc session_id params =
let port =
Expand Down
Loading

0 comments on commit 28e711f

Please sign in to comment.