CP-48463: add parameter to skip device types on get_export_metadata #5544
Conversation
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
psafont
force-pushed
the
private/paus/chelydra
branch
from
2228822
to
3ce7acd
Compare
lindig
approved these changes
Apr 4, 2024
| @@ -2158,11 +2158,18 @@ let complete_import ~__context vmrefs = | |||
| Xapi_vm_lifecycle.update_allowed_operations ~__context ~self:vm | |||
| ) | |||
| vmrefs ; | |||
| (* We only keep VMs which are not snapshot *) | |||
| (* When only snapshots have been imported, return all of them. | |||
There was a problem hiding this comment.
I don't have the context of this - but is this a behavior that customers expect?
There was a problem hiding this comment.
Customers can export snapshots from a pool, without this change when importing this back in, their uuid/ reference can't be known for sure. This leads to uncomfortable ergonomics.
I think returning the references of snapshots just created back to the user is something they expect.
There was a problem hiding this comment.
I was more confused by the difference between when only snapshots are imported and the case were a mix of snapshots and VMs are imported - as I read the comment, the behaviour is different.
There was a problem hiding this comment.
Before this PR the export of metadata-only was blocked, so I don't think this change of behaviour affects any users :)
I am not sure where this restriction came from. It was introduced in the same commit that introduced the metadata-export feature itself, without explanation. Full exports of snapshots are already allowed. Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
This allows clients to know which snapshots they knowingly just created and act on them instead of looking again into the db and try to divine which snapshots the call created. Signed-off-by: Pau Ruiz Safont <pau.ruizsafont@cloud.com>
This allows clients to detect that the newer device type exclusions for export are available. Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
This allows to orchestrators to copy devices like VBDs from the VM, export the metadata without the disk, import the VM to any pool, and finally add the saved VBDs to the new VM before booting it. Signed-off-by: Pau Ruiz Safont <pau.ruizsafont@cloud.com>
This allows to easily test the http endpoint. Also advertises the metadata parameter on these calls Signed-off-by: Pau Ruiz Safont <pau.ruizsafont@cloud.com>
Use the helper functions to process parameters, use atomics instead of ad-hoc references for counting in possibly-parallel case Signed-off-by: Pau Ruiz Safont <pau.ruizsafont@cloud.com>
Signed-off-by: Pau Ruiz Safont <pau.ruizsafont@cloud.com>
Signed-off-by: Pau Ruiz Safont <pau.ruizsafont@cloud.com>
Signed-off-by: Pau Ruiz Safont <pau.ruizsafont@cloud.com>
Tooling complains about using 1970 as the date otherwise Signed-off-by: Pau Ruiz Safont <pau.ruizsafont@cloud.com>
psafont
force-pushed
the
private/paus/chelydra
branch
from
3ce7acd
to
0c6805f
Compare
Vincent-lau
approved these changes
Apr 9, 2024
| | 1 -> | ||
| [op (List.hd srs)] | ||
| | [sr] -> | ||
| [op sr] | ||
| | _ -> |
There was a problem hiding this comment.
can we use when here to make this more pattern matchy? like
| [sr] -> [op sr]
| srs -> when multiple && get_bool_param params ...There was a problem hiding this comment.
This file is in need of a lot of care to use sensible coding standards. I think removing the use of List.hd is enough for now. Maybe as an OIL task...
| @@ -118,15 +120,16 @@ let rec update_table ~__context ~include_snapshots ~preserve_power_state | |||
| ) | |||
| ) ; | |||
| (* add VTPMs that belong to this VM *) | |||
| vm.API.vM_VTPMs | |||
| |> List.iter (fun ref -> if Db.is_valid_ref __context ref then add ref) ; | |||
| if not (List.mem Devicetype.VTPM excluded_devices) then | |||
There was a problem hiding this comment.
Do we allow users to exclude vtpms as well (and then add them back later on)?
There was a problem hiding this comment.
Yes, this code is doing the exclusion. For adding it back to the VM, I don't think there's an easy way to export the TPM contents separately
pytype_reporter extracted 50 problem reports from pytype outputpytype_reporter: Only "Revert" commits on this PR.Checking the revert diff: gh pr checkout https://github.com/xapi-project/xen-api/pull/<PR-number>
REF=$(git rev-list -n 1 --before='4 weeks ago' HEAD)
git diff $REF diff: diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs
index 4c2762b52..d8259ca9c 100644
--- a/.git-blame-ignore-revs
+++ b/.git-blame-ignore-revs
@@ -29,6 +29,7 @@ b020cf35a1f2c274f95a4118d4596043cba6113f
ff39018fd6d91985f9c893a56928771dfe9fa48d
cbb9edb17dfd122c591beb14d1275acc39492335
d6ab15362548b8fe270bd14d5153b8d94e1b15c0
+b12cf444edea15da6274975e1b2ca6a7fce2a090
# ocp-indent
d018d26d6acd4707a23288b327b49e44f732725e
diff --git a/Makefile b/Makefile
index 991ce87c8..d7f3db993 100644
--- a/Makefile
+++ b/Makefile
@@ -117,6 +117,16 @@ sdk:
sh ocaml/sdk-gen/windows-line-endings.sh $(XAPISDK)/csharp
sh ocaml/sdk-gen/windows-line-endings.sh $(XAPISDK)/powershell
+.PHONY: sdk-build-c sdk sdksanity
+
+sdk-build-c: sdk
+ cd _build/install/default/xapi/sdk/c && make -j $(JOBS)
+
+# workaround for no .resx generation, just for compilation testing
+sdksanity: sdk
+ sed -i 's/FriendlyErrorNames.ResourceManager/null/g' ./_build/install/default/xapi/sdk/csharp/src/Failure.cs
+ cd _build/install/default/xapi/sdk/csharp/src && dotnet add package Newtonsoft.Json && dotnet build -f netstandard2.0
+
.PHONY: sdk-build-java
sdk-build-java: sdk
diff --git a/ocaml/forkexecd/lib/fe.ml b/ocaml/forkexecd/lib/fe.ml
index bbad59dbf..1a176a62b 100644
--- a/ocaml/forkexecd/lib/fe.ml
+++ b/ocaml/forkexecd/lib/fe.ml
@@ -20,11 +20,9 @@ type process_result = WEXITED of int | WSIGNALED of int | WSTOPPED of int
type ferpc =
| Setup of setup_cmd
| Setup_response of setup_response
- | Cancel
| Exec
| Execed of int
| Finished of process_result
- | Log_reopen
| Dontwaitpid
[@@deriving rpc]
diff --git a/ocaml/forkexecd/lib/forkhelpers.ml b/ocaml/forkexecd/lib/forkhelpers.ml
index d55901c3c..15fb4bca6 100644
--- a/ocaml/forkexecd/lib/forkhelpers.ml
+++ b/ocaml/forkexecd/lib/forkhelpers.ml
@@ -21,6 +21,8 @@
(* XXX: this is a work in progress *)
+module D = Debug.Make (struct let name = __MODULE__ end)
+
let default_path = ["/sbin"; "/usr/sbin"; "/bin"; "/usr/bin"]
let default_path_env_pair = [|"PATH=" ^ String.concat ":" default_path|]
@@ -72,14 +74,47 @@ let waitpid (sock, pid) =
in
failwith msg
-let waitpid_nohang ((sock, _) as x) =
+(* [waitpid_nohang] reports the status of a socket to a process. The
+ intention is to make this non-blocking. If the process is finished,
+ the socket is closed and not otherwise. *)
+let waitpid_nohang (sock, pid) =
+ let verbose = false in
+ if verbose then D.debug "%s pid=%d" __FUNCTION__ pid ;
+ let fail fmt = Printf.kprintf failwith fmt in
Unix.set_nonblock sock ;
- let r =
- try waitpid x
- with Unix.(Unix_error ((EAGAIN | EWOULDBLOCK), _, _)) ->
- (0, Unix.WEXITED 0)
- in
- Unix.clear_nonblock sock ; r
+ match Fecomms.read_raw_rpc sock with
+ | Ok Fe.(Finished (WEXITED n)) ->
+ if verbose then D.debug "%s pid=%d WEXITED" __FUNCTION__ pid ;
+ Unix.close sock ;
+ (pid, Unix.WEXITED n)
+ | Ok Fe.(Finished (WSIGNALED n)) ->
+ if verbose then D.debug "%s pid=%d WSIGNALED" __FUNCTION__ pid ;
+ Unix.close sock ;
+ (pid, Unix.WSIGNALED n)
+ | Ok Fe.(Finished (WSTOPPED n)) ->
+ if verbose then D.debug "%s pid=%d WSTOPPED" __FUNCTION__ pid ;
+ Unix.close sock ;
+ (pid, Unix.WSTOPPED n)
+ | Ok status ->
+ Unix.clear_nonblock sock ;
+ fail "%s: unexpected status received (%s)" __FUNCTION__
+ (Fe.ferpc_to_string status)
+ | Error msg ->
+ D.debug "%s pid=%d %s" __FUNCTION__ pid msg ;
+ Unix.clear_nonblock sock ;
+ fail "%s: error happened when trying to read the status. %s" __FUNCTION__
+ msg
+ (* it's a bit crazy that we have Result.t and exceptions from
+ read_raw_rpc *)
+ | exception Unix.(Unix_error ((EAGAIN | EWOULDBLOCK), _, _)) ->
+ if verbose then D.debug "%s pid=%d EAGAIN EWOULDBLOCK" __FUNCTION__ pid ;
+ Unix.clear_nonblock sock ;
+ (0, Unix.WEXITED 0) (* this a convention, see MLI *)
+ | exception exn ->
+ D.debug "%s pid=%d %s" __FUNCTION__ pid (Printexc.to_string exn) ;
+ Unix.clear_nonblock sock ;
+ fail "%s: error happened when trying to read the status. %s" __FUNCTION__
+ (Printexc.to_string exn)
let dontwaitpid (sock, _pid) =
( try
diff --git a/ocaml/forkexecd/lib/forkhelpers.mli b/ocaml/forkexecd/lib/forkhelpers.mli
index 6252f0e75..48832726c 100644
--- a/ocaml/forkexecd/lib/forkhelpers.mli
+++ b/ocaml/forkexecd/lib/forkhelpers.mli
@@ -111,8 +111,10 @@ val waitpid : pidty -> int * Unix.process_status
(** [waitpid p] returns the (pid, Unix.process_status) *)
val waitpid_nohang : pidty -> int * Unix.process_status
-(** [waitpid_nohang p] returns the (pid, Unix.process_status) if the process has already
- quit or (0, Unix.WEXITTED 0) if the process is still running. *)
+(** [waitpid_nohang p] returns the (pid, Unix.process_status) if the
+ process has already quit or (0, Unix.WEXITTED 0) if the process is
+ still running. If the process is finished, the socket is closed
+ and not otherwise. *)
val dontwaitpid : pidty -> unit
(** [dontwaitpid p]: signals the caller's desire to never call waitpid. Note that the final
diff --git a/ocaml/forkexecd/src/child.ml b/ocaml/forkexecd/src/child.ml
index f6ede6c60..197f3b91f 100644
--- a/ocaml/forkexecd/src/child.ml
+++ b/ocaml/forkexecd/src/child.ml
@@ -49,8 +49,6 @@ let handle_fd_sock fd_sock state =
let handle_comms_sock comms_sock state =
let call = Fecomms.read_raw_rpc comms_sock in
match call with
- | Ok Fe.Cancel ->
- debug "Cancel" ; raise Cancelled
| Ok Fe.Exec ->
debug "Exec" ;
{state with finished= true}
diff --git a/ocaml/forkexecd/test/fe_test.ml b/ocaml/forkexecd/test/fe_test.ml
index bb740d94d..1df62eadc 100644
--- a/ocaml/forkexecd/test/fe_test.ml
+++ b/ocaml/forkexecd/test/fe_test.ml
@@ -140,6 +140,10 @@ let fail x =
Printf.fprintf stderr "%s\n" x ;
assert false
+let expect expected s =
+ if s <> expected ^ "\n" then
+ fail (Printf.sprintf "output %s expected %s" s expected)
+
let test_exitcode () =
let run_expect cmd expected =
try Forkhelpers.execute_command_get_output cmd [] |> ignore
@@ -150,15 +154,39 @@ let test_exitcode () =
in
run_expect "/bin/false" 1 ;
run_expect "/bin/xe-fe-test-no-command" 127 ;
+ run_expect "/bin/xe-fe-no-path/xe-fe-test-no-command" 127 ;
run_expect "/etc/hosts" 126 ;
Printf.printf "\nCompleted exitcode tests\n"
+let test_output () =
+ let exe = Printf.sprintf "/proc/%d/exe" (Unix.getpid ()) in
+ let expected_out = "output string" in
+ let expected_err = "error string" in
+ let args = ["echo"; expected_out; expected_err] in
+ let out, err = Forkhelpers.execute_command_get_output exe args in
+ expect expected_out out ;
+ expect expected_err err ;
+ print_endline "Completed output tests"
+
+let test_input () =
+ let exe = Printf.sprintf "/proc/%d/exe" (Unix.getpid ()) in
+ let input = "input string" in
+ let args = ["replay"] in
+ let out, _ =
+ Forkhelpers.execute_command_get_output_send_stdin exe args input
+ in
+ expect input out ;
+ print_endline "Completed input tests"
+
let master fds =
Printf.printf "\nPerforming timeout tests\n%!" ;
test_delay () ;
test_notimeout () ;
Printf.printf "\nCompleted timeout test\n%!" ;
test_exitcode () ;
+ Printf.printf "\nPerforming input/output tests\n%!" ;
+ test_output () ;
+ test_input () ;
let combinations = shuffle (all_combinations fds) in
Printf.printf "Starting %d tests\n%!" (List.length combinations) ;
let i = ref 0 in
@@ -235,6 +263,14 @@ let slave = function
let sleep () = Unix.sleep 5 ; Printf.printf "Ok\n"
+let echo out err =
+ if out <> "" then print_endline out ;
+ if err <> "" then prerr_endline err
+
+let replay () =
+ let line = read_line () in
+ print_endline line
+
let usage () =
Printf.printf "Usage:\n" ;
Printf.printf
@@ -253,6 +289,10 @@ let _ =
sleep ()
| _ :: "slave" :: rest ->
slave rest
+ | _ :: "echo" :: out :: err :: _ ->
+ echo out err
+ | _ :: "replay" :: _ ->
+ replay ()
| [_] ->
master max_fds
| [_; fds] -> (
diff --git a/ocaml/forkexecd/test/fe_test.sh b/ocaml/forkexecd/test/fe_test.sh
index fa5ffc514..aa0b9899e 100755
--- a/ocaml/forkexecd/test/fe_test.sh
+++ b/ocaml/forkexecd/test/fe_test.sh
@@ -6,13 +6,14 @@ export XDG_RUNTIME_DIR=${XDG_RUNTIME_DIR:-$TMPDIR}
export FE_TEST=1
SOCKET=${XDG_RUNTIME_DIR}/xapi/forker/main
+rm -f "$SOCKET"
../src/fe_main.exe &
MAIN=$!
cleanup () {
kill $MAIN
}
-trap cleanup EXIT
+trap cleanup EXIT INT
for _ in $(seq 1 10); do
test -S ${SOCKET} || sleep 1
done
diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml
index 8f452b470..a9f219e91 100644
--- a/ocaml/idl/datamodel.ml
+++ b/ocaml/idl/datamodel.ml
@@ -136,7 +136,7 @@ module Session = struct
call ~flags:[`Session] ~name:"change_password"
~doc:
"Change the account password; if your session is authenticated with \
- root priviledges then the old_pwd is validated and the new_pwd is set \
+ root privileges then the old_pwd is validated and the new_pwd is set \
regardless"
~params:
[
@@ -8177,6 +8177,7 @@ let http_actions =
; Bool_query_arg "include_dom0"
; Bool_query_arg "include_vhd_parents"
; Bool_query_arg "export_snapshots"
+ ; String_query_arg "excluded_device_types"
]
, _R_VM_ADMIN
, []
diff --git a/ocaml/idl/datamodel_vm.ml b/ocaml/idl/datamodel_vm.ml
index c1a6b9a7d..aa45d93de 100644
--- a/ocaml/idl/datamodel_vm.ml
+++ b/ocaml/idl/datamodel_vm.ml
@@ -1899,7 +1899,7 @@ let t =
; field ~qualifier:DynamicRO ~ty:(Set (Ref _vbd)) "VBDs"
"virtual block devices"
; field ~qualifier:DynamicRO ~ty:(Set (Ref _vusb)) "VUSBs"
- "vitual usb devices"
+ "virtual usb devices"
; field ~writer_roles:_R_POOL_ADMIN ~qualifier:DynamicRO
~ty:(Set (Ref _crashdump)) "crash_dumps"
"crash dumps associated with this VM"
diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml
index c8e5972c9..82619e839 100644
--- a/ocaml/idl/schematest.ml
+++ b/ocaml/idl/schematest.ml
@@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex
(* BEWARE: if this changes, check that schema has been bumped accordingly in
ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *)
-let last_known_schema_hash = "186131ad48f40dff30246e8e0c0dbf0a"
+let last_known_schema_hash = "a55d5dc70920dcf4ab72ed321497b482"
let current_schema_hash : string =
let open Datamodel_types in
diff --git a/ocaml/libs/uuid/uuidx.ml b/ocaml/libs/uuid/uuidx.ml
index de471da0e..01dbda468 100644
--- a/ocaml/libs/uuid/uuidx.ml
+++ b/ocaml/libs/uuid/uuidx.ml
@@ -83,3 +83,15 @@ let string_of_uuid = to_string
let uuid_of_int_array = of_int_array
let int_array_of_uuid = to_int_array
+
+module Hash = struct
+ (** Derive a deterministic UUID from a string: the same
+ string maps to the same UUID. We are using our own namespace; the
+ namespace is not a secret *)
+
+ let namespace =
+ let ns = "e93e0639-2bdb-4a59-8b46-352b3f408c19" in
+ Uuidm.(of_string ns |> Option.get)
+
+ let string str = Uuidm.v5 namespace str
+end
diff --git a/ocaml/libs/uuid/uuidx.mli b/ocaml/libs/uuid/uuidx.mli
index 57b4058b8..618235b4a 100644
--- a/ocaml/libs/uuid/uuidx.mli
+++ b/ocaml/libs/uuid/uuidx.mli
@@ -81,3 +81,11 @@ val make_cookie : unit -> cookie
val cookie_of_string : string -> cookie
val string_of_cookie : cookie -> string
+
+module Hash : sig
+ (** hash a string (deterministically) into a UUID. This uses
+ namespace UUID e93e0639-2bdb-4a59-8b46-352b3f408c19. *)
+
+ (* UUID Version 5 derived from argument string and namespace UUID *)
+ val string : string -> 'a t
+end
diff --git a/ocaml/message-switch/cli/dune b/ocaml/message-switch/cli/dune
index beb3741dc..c0741e713 100644
--- a/ocaml/message-switch/cli/dune
+++ b/ocaml/message-switch/cli/dune
@@ -5,6 +5,7 @@
cmdliner
message-switch-core
message-switch-unix
+ mtime
rpclib.core
rpclib.json
threads.posix
diff --git a/ocaml/message-switch/cli/main.ml b/ocaml/message-switch/cli/main.ml
index 197061a17..19324a5a2 100644
--- a/ocaml/message-switch/cli/main.ml
+++ b/ocaml/message-switch/cli/main.ml
@@ -76,23 +76,36 @@ let help =
; `P (Printf.sprintf "Check bug reports at %s" project_url)
]
+(* Durations, in nanoseconds *)
+let second = 1_000_000_000L
+
+let minute = 60_000_000_000L
+
+let hour = 3600_000_000_000L
+
+let day = 86400_000_000_000L
+
(* Commands *)
let diagnostics common_opts =
Client.connect ~switch:common_opts.Common.path () >>|= fun t ->
Client.diagnostics ~t () >>|= fun d ->
let open Message_switch_core.Protocol in
- let in_the_past = Int64.sub d.Diagnostics.current_time in
+ let in_the_past ts =
+ if d.Diagnostics.current_time < ts then
+ 0L
+ else
+ Int64.sub d.Diagnostics.current_time ts
+ in
let time f x =
- let open Int64 in
- let secs = div (f x) 1_000_000_000L in
- let secs' = rem secs 60L in
- let mins = div secs 60L in
- let mins' = rem mins 60L in
- let hours = div mins 60L in
- let hours' = rem hours 24L in
- let days = div hours 24L in
- let fragment name = function
+ let timespan = f x in
+ let ( // ) = Int64.div in
+ let ( %% ) = Int64.rem in
+ let secs = timespan %% minute // second in
+ let mins = timespan %% hour // minute in
+ let hours = timespan %% day // hour in
+ let days = timespan // day in
+ let format name = function
| 0L ->
[]
| 1L ->
@@ -101,11 +114,10 @@ let diagnostics common_opts =
[Printf.sprintf "%Ld %ss" n name]
in
let bits =
- fragment "day" days
- @ fragment "hour" hours'
- @ fragment "min" mins'
- @ fragment "second" secs'
- @ []
+ format "day" days
+ @ format "hour" hours
+ @ format "min" mins
+ @ format "second" secs
in
let length = List.length bits in
let _, rev_bits =
@@ -122,7 +134,16 @@ let diagnostics common_opts =
)
(0, []) bits
in
- String.concat "" (List.rev rev_bits) ^ "ago"
+ let format_secs ts =
+ Mtime.Span.(Format.asprintf "%a " pp (of_uint64_ns ts))
+ in
+ let timestrings =
+ if rev_bits = [] then
+ [format_secs (timespan %% minute)]
+ else
+ List.rev rev_bits
+ in
+ String.concat "" timestrings ^ "ago"
in
let origin = function
| Anonymous id ->
diff --git a/ocaml/quicktest/qt.ml b/ocaml/quicktest/qt.ml
index 1764f12ce..d390f0dfc 100644
--- a/ocaml/quicktest/qt.ml
+++ b/ocaml/quicktest/qt.ml
@@ -132,26 +132,32 @@ module VM = struct
Some x
end
- let install rpc session_id ~template ~name =
+ let install rpc session_id ~template ~name ?sr () =
let template_uuid =
Client.Client.VM.get_uuid ~rpc ~session_id ~self:template
in
- let newvm_uuid =
- cli_cmd
- [
- "vm-install"
- ; "template-uuid=" ^ template_uuid
- ; "new-name-label=" ^ name
- ]
+ let cmd =
+ ["vm-install"; "template-uuid=" ^ template_uuid; "new-name-label=" ^ name]
+ in
+ let sr_uuid =
+ Option.map
+ (fun sr -> Client.Client.SR.get_uuid ~rpc ~session_id ~self:sr)
+ sr
in
+ let cmd =
+ cmd @ Option.fold ~none:[] ~some:(fun x -> ["sr-uuid=" ^ x]) sr_uuid
+ in
+ let newvm_uuid = cli_cmd cmd in
Client.Client.VM.get_by_uuid ~rpc ~session_id ~uuid:newvm_uuid
let uninstall rpc session_id vm =
let uuid = Client.Client.VM.get_uuid ~rpc ~session_id ~self:vm in
cli_cmd ["vm-uninstall"; "uuid=" ^ uuid; "--force"] |> ignore
- let with_new rpc session_id ~template f =
- let vm = install rpc session_id ~template ~name:"temp_quicktest_vm" in
+ let with_new rpc session_id ~template ?sr f =
+ let vm =
+ install rpc session_id ~template ~name:"temp_quicktest_vm" ?sr ()
+ in
Xapi_stdext_pervasives.Pervasiveext.finally
(fun () -> f vm)
(fun () -> uninstall rpc session_id vm)
diff --git a/ocaml/quicktest/qt.mli b/ocaml/quicktest/qt.mli
index f0edde13a..15dbb785f 100644
--- a/ocaml/quicktest/qt.mli
+++ b/ocaml/quicktest/qt.mli
@@ -50,7 +50,12 @@ module VM : sig
end
val with_new :
- rpc -> API.ref_session -> template:API.ref_VM -> (API.ref_VM -> 'a) -> 'a
+ rpc
+ -> API.ref_session
+ -> template:API.ref_VM
+ -> ?sr:API.ref_SR
+ -> (API.ref_VM -> 'a)
+ -> 'a
val dom0_of_host : rpc -> API.ref_session -> API.ref_host -> API.ref_VM
(** Return a host's domain zero *)
diff --git a/ocaml/quicktest/quicktest_vm_lifecycle.ml b/ocaml/quicktest/quicktest_vm_lifecycle.ml
index 88fd9b8d6..b3de6b5b3 100644
--- a/ocaml/quicktest/quicktest_vm_lifecycle.ml
+++ b/ocaml/quicktest/quicktest_vm_lifecycle.ml
@@ -91,12 +91,18 @@ let one rpc session_id vm test =
| Halted ->
wait_for_domid (fun domid' -> domid' = -1L)
-let test rpc session_id vm_template () =
- Qt.VM.with_new rpc session_id ~template:vm_template (fun vm ->
+let test rpc session_id sr_info vm_template () =
+ let sr = sr_info.Qt.sr in
+ Qt.VM.with_new rpc session_id ~template:vm_template ~sr (fun vm ->
List.iter (one rpc session_id vm) all_possible_tests
)
let tests () =
let open Qt_filter in
- [[("VM lifecycle tests", `Slow, test)] |> conn |> vm_template "CoreOS"]
+ [
+ [("VM lifecycle tests", `Slow, test)]
+ |> conn
+ |> sr SR.(all |> allowed_operations [`vdi_create])
+ |> vm_template "CoreOS"
+ ]
|> List.concat
diff --git a/ocaml/sdk-gen/c/autogen/src/xen_common.c b/ocaml/sdk-gen/c/autogen/src/xen_common.c
index 9081f9bd7..9178d3fd4 100644
--- a/ocaml/sdk-gen/c/autogen/src/xen_common.c
+++ b/ocaml/sdk-gen/c/autogen/src/xen_common.c
@@ -292,10 +292,7 @@ set_api_version(xen_session *session)
void
xen_session_logout(xen_session *session)
{
- abstract_value params[] =
- {
- };
- xen_call_(session, "session.logout", params, 0, NULL, NULL);
+ xen_call_(session, "session.logout", NULL, 0, NULL, NULL);
if (session->error_description != NULL)
{
@@ -314,10 +311,7 @@ xen_session_logout(xen_session *session)
void
xen_session_local_logout(xen_session *session)
{
- abstract_value params[] =
- {
- };
- xen_call_(session, "session.local_logout", params, 0, NULL, NULL);
+ xen_call_(session, "session.local_logout", NULL, 0, NULL, NULL);
if (session->error_description != NULL)
{
@@ -336,14 +330,11 @@ xen_session_local_logout(xen_session *session)
bool
xen_session_get_all_subject_identifiers(xen_session *session, struct xen_string_set **result)
{
- abstract_value params[] =
- {
- };
abstract_type result_type = abstract_type_string_set;
*result = NULL;
- xen_call_(session, "session.get_all_subject_identifiers", params, 0, &result_type, result);
+ xen_call_(session, "session.get_all_subject_identifiers", NULL, 0, &result_type, result);
return session->ok;
}
@@ -351,14 +342,10 @@ bool
bool
xen_session_get_all_subject_identifiers_async(xen_session *session, xen_task *result)
{
- abstract_value params[] =
- {
- };
-
abstract_type result_type = abstract_type_string;
*result = NULL;
- xen_call_(session, "Async.session.get_all_subject_identifiers", params, 0, &result_type, result);
+ xen_call_(session, "Async.session.get_all_subject_identifiers", NULL, 0, &result_type, result);
return session->ok;
}
diff --git a/ocaml/sdk-gen/c/gen_c_binding.ml b/ocaml/sdk-gen/c/gen_c_binding.ml
index 5203b86f2..2302fc6cf 100644
--- a/ocaml/sdk-gen/c/gen_c_binding.ml
+++ b/ocaml/sdk-gen/c/gen_c_binding.ml
@@ -83,11 +83,7 @@ let rec main () =
all_headers := List.map (fun x -> x.name) filtered_classes ;
- TypeSet.iter (gen_enum write_enum_decl decl_filename include_dir) !enums ;
- TypeSet.iter (gen_enum write_enum_impl impl_filename src_dir) !enums ;
- TypeSet.iter
- (gen_enum write_enum_internal_decl internal_decl_filename include_dir)
- !enums ;
+ TypeSet.iter render_enum !enums ;
maps := TypeSet.add (Map (String, Int)) !maps ;
maps := TypeSet.add (Map (Int, Int)) !maps ;
@@ -140,17 +136,6 @@ and gen_class f g clas targetdir =
let out_chan = open_out (Filename.concat targetdir (g clas.name)) in
Fun.protect (fun () -> f clas out_chan) ~finally:(fun () -> close_out out_chan)
-and gen_enum f g targetdir = function
- | Enum (name, _) as x ->
- if not (List.mem name !all_headers) then
- all_headers := name :: !all_headers ;
- let out_chan = open_out (Filename.concat targetdir (g name)) in
- Fun.protect
- (fun () -> f x out_chan)
- ~finally:(fun () -> close_out out_chan)
- | _ ->
- assert false
-
and gen_map f g targetdir = function
| Map (l, r) ->
let name = mapname l r in
@@ -389,7 +374,9 @@ and impl_message needed classname message =
sprintf
" xen_call_(session, \"%s.%s\", %s, %d, NULL, NULL);\n\
\ return session->ok;\n"
- classname message.msg_name param_call param_count
+ classname message.msg_name
+ (if param_count = 0 then "NULL" else param_call)
+ param_count
in
let messageAsyncImpl = impl_message_async needed classname message in
@@ -669,174 +656,49 @@ and hash_include n =
else
sprintf "#include <%s>" (decl_filename n)
-and write_enum_decl x out_chan =
+and replace_dashes x =
+ Astring.String.map (fun y -> match y with '-' -> '_' | _ -> y) x
+
+and render_enum x =
match x with
| Enum (name, contents) ->
- let print format = fprintf out_chan format in
- let protect = protector name in
- let tn = typename name in
-
- print_h_header out_chan protect ;
-
- print
- "\n\
- %s\n\n\n\
- enum %s\n\
- {\n\
- %s\n\
- };\n\n\n\
- typedef struct %s_set\n\
- {\n\
- \ size_t size;\n\
- \ enum %s contents[];\n\
- } %s_set;\n\n\
- %s\n\
- extern %s_set *\n\
- %s_set_alloc(size_t size);\n\n\
- %s\n\n\n\
- %s\n\
- extern const char *\n\
- %s_to_string(enum %s val);\n\n\n\
- %s\n\
- extern enum %s\n\
- %s_from_string(xen_session *session, const char *str);\n\n"
- (hash_include "common") tn
- (joined ",\n\n" (enum_entry name)
- (contents
- @ [("undefined", "Unknown to this version of the bindings.")]
+ if not (List.mem name !all_headers) then
+ all_headers := name :: !all_headers ;
+ let json =
+ `O
+ [
+ ("enum_name", `String name)
+ ; ("enum_name_upper", `String (String.uppercase_ascii name))
+ ; ("event_operations", `Bool (name = "event_operation"))
+ ; ( "enum_values"
+ , `A
+ (List.map
+ (fun (n, c) ->
+ `O
+ [
+ ("enum_value", `String n)
+ ; ("enum_value_doc", `String c)
+ ; ( "enum_value_upper"
+ , `String (replace_dashes (String.uppercase_ascii n))
)
+ ]
)
- tn tn tn
- (Helper.comment true (sprintf "Allocate a %s_set of the given size." tn))
- tn tn
- (decl_free (sprintf "%s_set" tn) "*set" false "set")
- (Helper.comment true
- "Return the name corresponding to the given code. This string must \
- not be modified or freed."
+ contents
)
- tn tn
- (Helper.comment true
- "Return the correct code for the given string, or set the session \
- object to failure and return an undefined value if the given \
- string does not match a known code."
)
- tn tn ;
-
- print_h_footer out_chan
- | _ ->
- ()
-
-and enum_entry enum_name = function
- | n, c ->
- sprintf "%s\n XEN_%s_%s"
- (Helper.comment true ~indent:4 c)
- (String.uppercase_ascii enum_name)
- (Astring.String.map
- (fun x -> match x with '-' -> '_' | _ -> x)
- (String.uppercase_ascii n)
- )
-
-and write_enum_impl x out_chan =
- match x with
- | Enum (name, contents) ->
- let print format = fprintf out_chan format in
- let tn = typename name in
-
- print
- "%s\n\n\
- #include <string.h>\n\n\
- %s\n\
- %s\n\
- %s\n\n\n\
- /*\n\
- \ * Maintain this in the same order as the enum declaration!\n\
- \ */\n\
- static const char *lookup_table[] =\n\
- {\n\
- %s\n\
- };\n\n\n\
- extern %s_set *\n\
- %s_set_alloc(size_t size)\n\
- {\n\
- \ return calloc(1, sizeof(%s_set) +\n\
- \ size * sizeof(enum %s));\n\
- }\n\n\n\
- extern void\n\
- %s_set_free(%s_set *set)\n\
- {\n\
- \ free(set);\n\
- }\n\n\n\
- const char *\n\
- %s_to_string(enum %s val)\n\
- {\n\
- \ return lookup_table[val];\n\
- }\n\n\n\
- extern enum %s\n\
- %s_from_string(xen_session *session, const char *str)\n\
- {\n\
- \ (void)session;\n\
- \ return ENUM_LOOKUP(str, lookup_table);\n\
- }\n\n\n\
- const abstract_type %s_abstract_type_ =\n\
- \ {\n\
- \ .XEN_API_TYPE = ENUM,\n\
- \ .enum_marshaller =\n\
- \ (const char *(*)(int))&%s_to_string,\n\
- \ .enum_demarshaller =\n\
- \ (int (*)(xen_session *, const char *))&%s_from_string\n\
- \ };\n\n\n"
- Licence.bsd_two_clause (hash_include "internal") (hash_include name)
- (hash_include (name ^ "_internal"))
- (enum_lookup_entries (contents @ [("undefined", "")]))
- tn tn tn tn tn tn tn tn tn tn tn tn tn ;
-
- if name <> "event_operation" then
- print
- "const abstract_type %s_set_abstract_type_ =\n\
- \ {\n\
- \ .XEN_API_TYPE = SET,\n\
- \ .child = &%s_abstract_type_\n\
- \ };\n\n\n"
- tn tn
- | _ ->
- ()
-
-and enum_lookup_entries contents = joined ",\n" enum_lookup_entry contents
-
-and enum_lookup_entry = function n, _ -> sprintf " \"%s\"" n
-
-and write_enum_internal_decl x out_chan =
- match x with
- | Enum (name, _) ->
- let print format = fprintf out_chan format in
- let protect = protector (sprintf "%s_internal" name) in
- let tn = typename name in
-
- let set_abstract_type =
- if name = "event_operations" then
- ""
- else
- sprintf "extern const abstract_type %s_set_abstract_type_;\n" tn
+ ]
in
-
- print
- "%s\n\n\n\
- %s\n\n\n\
- #ifndef %s\n\
- #define %s\n\n\n\
- %s\n\n\n\
- extern const abstract_type %s_abstract_type_;\n\
- %s\n\n\
- #endif\n"
- Licence.bsd_two_clause
- (Helper.comment false
- (sprintf
- "Declarations of the abstract types used during demarshalling of \
- enum %s. Internal to this library -- do not use from outside."
- tn
- )
+ render_file
+ ( "xen_enum_internal.h.mustache"
+ , sprintf "include/xen_%s_internal.h" name
)
- protect protect (hash_include "internal") tn set_abstract_type
+ json templates_dir destdir ;
+ render_file
+ ("xen_enum.h.mustache", sprintf "include/xen/api/xen_%s.h" name)
+ json templates_dir destdir ;
+ render_file
+ ("xen_enum.c.mustache", sprintf "src/xen_%s.c" name)
+ json templates_dir destdir
| _ ->
()
diff --git a/ocaml/sdk-gen/c/templates/xen_enum.c.mustache b/ocaml/sdk-gen/c/templates/xen_enum.c.mustache
new file mode 100644
index 000000000..421c9015a
--- /dev/null
+++ b/ocaml/sdk-gen/c/templates/xen_enum.c.mustache
@@ -0,0 +1,98 @@
+/*
+ * Copyright (c) Cloud Software Group, Inc.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1) Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2) Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following
+ * disclaimer in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+ * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+ * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+ * OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+#include <string.h>
+
+#include "xen_internal.h"
+#include <xen/api/xen_{{{enum_name}}}.h>
+#include "xen_{{{enum_name}}}_internal.h"
+
+
+/*
+ * Maintain this in the same order as the enum declaration!
+ */
+static const char *lookup_table[] =
+{
+{{#enum_values}}
+ "{{{enum_value}}}",
+{{/enum_values}}
+ "undefined"
+};
+
+
+extern xen_{{{enum_name}}}_set *
+xen_{{{enum_name}}}_set_alloc(size_t size)
+{
+ return calloc(1, sizeof(xen_{{{enum_name}}}_set) +
+ size * sizeof(enum xen_{{{enum_name}}}));
+}
+
+
+extern void
+xen_{{{enum_name}}}_set_free(xen_{{{enum_name}}}_set *set)
+{
+ free(set);
+}
+
+
+const char *
+xen_{{{enum_name}}}_to_string(enum xen_{{{enum_name}}} val)
+{
+ return lookup_table[val];
+}
+
+
+extern enum xen_{{{enum_name}}}
+xen_{{{enum_name}}}_from_string(xen_session *session, const char *str)
+{
+ (void)session;
+ return ENUM_LOOKUP(str, lookup_table);
+}
+
+
+const abstract_type xen_{{{enum_name}}}_abstract_type_ =
+ {
+ .XEN_API_TYPE = ENUM,
+ .enum_marshaller =
+ (const char *(*)(int))&xen_{{{enum_name}}}_to_string,
+ .enum_demarshaller =
+ (int (*)(xen_session *, const char *))&xen_{{{enum_name}}}_from_string
+ };
+
+
+{{^event_operations}}
+const abstract_type xen_{{{enum_name}}}_set_abstract_type_ =
+ {
+ .XEN_API_TYPE = SET,
+ .child = &xen_{{{enum_name}}}_abstract_type_
+ };
+
+
+{{/event_operations}}
diff --git a/ocaml/sdk-gen/c/templates/xen_enum.h.mustache b/ocaml/sdk-gen/c/templates/xen_enum.h.mustache
new file mode 100644
index 000000000..824179cf2
--- /dev/null
+++ b/ocaml/sdk-gen/c/templates/xen_enum.h.mustache
@@ -0,0 +1,91 @@
+/*
+ * Copyright (c) Cloud Software Group, Inc.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1) Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2) Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following
+ * disclaimer in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+ * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+ * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+ * OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+#ifndef XEN_{{{enum_name_upper}}}_H
+#define XEN_{{{enum_name_upper}}}_H
+
+
+#include <xen/api/xen_common.h>
+
+
+enum xen_{{{enum_name}}}
+{
+{{#enum_values}}
+ /**
+ * {{{enum_value_doc}}}
+ */
+ XEN_{{{enum_name_upper}}}_{{{enum_value_upper}}},
+
+{{/enum_values}}
+ /**
+ * Unknown to this version of the bindings.
+ */
+ XEN_{{{enum_name_upper}}}_UNDEFINED
+};
+
+
+typedef struct xen_{{{enum_name}}}_set
+{
+ size_t size;
+ enum xen_{{{enum_name}}} contents[];
+} xen_{{{enum_name}}}_set;
+
+/**
+ * Allocate a xen_{{{enum_name}}}_set of the given size.
+ */
+extern xen_{{{enum_name}}}_set *
+xen_{{{enum_name}}}_set_alloc(size_t size);
+
+/**
+ * Free the given xen_{{{enum_name}}}_set. The given set must have been
+ * allocated by this library.
+ */
+extern void
+xen_{{{enum_name}}}_set_free(xen_{{{enum_name}}}_set *set);
+
+
+/**
+ * Return the name corresponding to the given code. This string must
+ * not be modified or freed.
+ */
+extern const char *
+xen_{{{enum_name}}}_to_string(enum xen_{{{enum_name}}} val);
+
+
+/**
+ * Return the correct code for the given string, or set the session
+ * object to failure and return an undefined value if the given string does
+ * not match a known code.
+ */
+extern enum xen_{{{enum_name}}}
+xen_{{{enum_name}}}_from_string(xen_session *session, const char *str);
+
+
+#endif
diff --git a/ocaml/sdk-gen/c/templates/xen_enum_internal.h.mustache b/ocaml/sdk-gen/c/templates/xen_enum_internal.h.mustache
new file mode 100644
index 000000000..b9731686e
--- /dev/null
+++ b/ocaml/sdk-gen/c/templates/xen_enum_internal.h.mustache
@@ -0,0 +1,51 @@
+/*
+ * Copyright (c) Cloud Software Group, Inc.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1) Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2) Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following
+ * disclaimer in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+ * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+ * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+ * OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+
+/*
+ * Declarations of the abstract types used during demarshalling of enum
+ * xen_{{{enum_name}}}. Internal to this library -- do not use from outside.
+ */
+
+
+#ifndef XEN_{{{enum_name_upper}}}_INTERNAL_H
+#define XEN_{{{enum_name_upper}}}_INTERNAL_H
+
+
+#include "xen_internal.h"
+
+
+extern const abstract_type xen_{{{enum_name}}}_abstract_type_;
+{{^event_operations}}
+extern const abstract_type xen_{{{enum_name}}}_set_abstract_type_;
+{{/event_operations}}
+
+
+#endif
diff --git a/ocaml/sdk-gen/csharp/templates/XenServer.csproj.mustache b/ocaml/sdk-gen/csharp/autogen/src/XenServer.csproj
similarity index 100%
rename from ocaml/sdk-gen/csharp/templates/XenServer.csproj.mustache
rename to ocaml/sdk-gen/csharp/autogen/src/XenServer.csproj
diff --git a/ocaml/sdk-gen/csharp/gen_csharp_binding.ml b/ocaml/sdk-gen/csharp/gen_csharp_binding.ml
index 0c70b85c6..56243c59f 100644
--- a/ocaml/sdk-gen/csharp/gen_csharp_binding.ml
+++ b/ocaml/sdk-gen/csharp/gen_csharp_binding.ml
@@ -89,18 +89,6 @@ let rec main () =
("HTTP_actions.mustache", "HTTP_actions.cs")
(gen_http_actions ()) templdir destdir ;
gen_relations () ;
- let sorted_members = List.sort String.compare !api_members in
- let json =
- `O
- [
- ( "api_members"
- , `A (List.map (fun x -> `O [("api_member", `String x)]) sorted_members)
- )
- ]
- in
- render_file
- ("XenServer.csproj.mustache", "XenServer.csproj")
- json templdir destdir ;
render_file
("ApiVersion.mustache", "ApiVersion.cs")
json_releases templdir destdir
@@ -109,33 +97,42 @@ let rec main () =
and relations = Hashtbl.create 10
and gen_relations () =
- let out_chan = open_out (Filename.concat destdir "Relation.cs") in
- let print format = fprintf out_chan format in
List.iter process_relations (relations_of_api api) ;
- print
- "%s\n\n\
- using System;\n\
- using System.Collections.Generic;\n\n\
- namespace XenAPI\n\
- {\n\
- \ public partial class Relation\n\
- \ {\n\
- \ public readonly String field;\n\
- \ public readonly String manyType;\n\
- \ public readonly String manyField;\n\n\
- \ public Relation(String field, String manyType, String manyField)\n\
- \ {\n\
- \ this.field = field;\n\
- \ this.manyField = manyField;\n\
- \ this.manyType = manyType;\n\
- \ }\n\n\
- \ public static Dictionary<Type, Relation[]> GetRelations()\n\
- \ {\n\
- \ Dictionary<Type, Relation[]> relations = new Dictionary<Type, \
- Relation[]>();\n\n"
- Licence.bsd_two_clause ;
- Hashtbl.iter (gen_relations_by_type out_chan) relations ;
- print "\n return relations;\n }\n }\n}\n"
+ let typelist =
+ List.rev (Hashtbl.fold (fun k v acc -> (k, v) :: acc) relations [])
+ in
+ let json =
+ `O
+ [
+ ( "types"
+ , `A
+ (List.map
+ (fun (k, v) ->
+ `O
+ [
+ ("type", `String (exposed_class_name k))
+ ; ( "relations"
+ , `A
+ (List.map
+ (fun (x, y, z) ->
+ `O
+ [
+ ("field", `String x)
+ ; ("manyType", `String y)
+ ; ("manyField", `String z)
+ ]
+ )
+ v
+ )
+ )
+ ]
+ )
+ typelist
+ )
+ )
+ ]
+ in
+ render_file ("Relation.mustache", "Relation.cs") json templdir destdir
and process_relations ((oneClass, oneField), (manyClass, manyField)) =
let value =
@@ -144,20 +141,6 @@ and process_relations ((oneClass, oneField), (manyClass, manyField)) =
in
Hashtbl.replace relations manyClass value
-and gen_relations_by_type out_chan manyClass relations =
- let print format = fprintf out_chan format in
- print " relations.Add(typeof(%s), new Relation[] {\n"
- (exposed_class_name manyClass) ;
-
- List.iter (gen_relation out_chan) relations ;
-
- print " });\n\n"
-
-and gen_relation out_chan (manyField, oneClass, oneField) =
- let print format = fprintf out_chan format in
- print " new Relation(\"%s\", \"%s\", \"%s\"),\n" manyField
- oneClass oneField
-
(* ------------------- category: http_actions *)
and gen_http_actions () =
(* Each action has:
@@ -841,70 +824,44 @@ and gen_enum' name contents =
(* ------------------- category: maps *)
and gen_maps () =
- let out_chan = open_out (Filename.concat destdir "Maps.cs") in
- Fun.protect
- (fun () -> gen_maps' out_chan)
- ~finally:(fun () -> close_out out_chan)
-
-and gen_maps' out_chan =
- let print format = fprintf out_chan format in
-
- print
- "%s\n\n\
- using System;\n\
- using System.Collections;\n\
- using System.Collections.Generic;\n\n\
- \ namespace XenAPI\n\
- {\n\
- \ internal class Maps\n\
- \ {" Licence.bsd_two_clause ;
-
- TypeSet.iter (gen_map_conversion out_chan) !maps ;
-
- print "\n }\n}\n"
-
-and gen_map_conversion out_chan = function
+ let mapList = List.rev (TypeSet.fold (fun x acc -> x :: acc) !maps []) in
+ let json =
+ `O
+ [
+ ( "all_maps"
+ , `A
+ (List.map
+ (function
| Map (l, r) ->
- let print format = fprintf out_chan format in
- let el = exposed_type l in
- let el_literal = exposed_type_as_literal l in
- let er = exposed_type r in
- let er_literal = exposed_type_as_literal r in
-
- print
- "\n\
- \ internal static Dictionary<%s, %s> \
- ToDictionary_%s_%s(Hashtable table)\n\
- \ {\n\
- \ Dictionary<%s, %s> result = new Dictionary<%s, %s>();\n\
- \ if (table != null)\n\
- \ {\n\
- \ foreach (string key in table.Keys)\n\
- \ {\n\
- \ try\n\
- \ {\n\
- \ %s k = %s;\n\
- \ %s v = %s;\n\
- \ result[k] = v;\n\
- \ }\n\
- \ catch\n\
- \ {\n\
- \ // continue\n\
- \ }\n\
- \ }\n\
- \ }\n\
- \ return result;\n\
- \ }\n\n"
- el er
- (sanitise_function_name el_literal)
- (sanitise_function_name er_literal)
- el er el er el
- (simple_convert_from_proxy "key" l)
- er
+ `O
+ [
+ ("map_key", `String (exposed_type l))
+ ; ("map_value", `String (exposed_type r))
+ ; ( "sanitised_key"
+ , `String
+ (sanitise_function_name (exposed_type_as_literal l))
+ )
+ ; ( "sanitised_value"
+ , `String
+ (sanitise_function_name (exposed_type_as_literal r))
+ )
+ ; ( "proxy_key"
+ , `String (simple_convert_from_proxy "key" l)
+ )
+ ; ( "proxy_value"
+ , `String
(convert_from_proxy_hashtable_value "table[key]" r)
- (***)
+ )
+ ]
| _ ->
- assert false
+ `Null
+ )
+ mapList
+ )
+ )
+ ]
+ in
+ render_file ("Maps.mustache", "Maps.cs") json templdir destdir
(* ------------------- category: utility *)
and exposed_type_opt = function
@@ -991,7 +948,6 @@ and convert_from_proxy_hashtable_value thing ty =
convert_from_proxy thing ty
and convert_from_proxy thing ty =
- (*function*)
match ty with
| DateTime ->
thing
diff --git a/ocaml/sdk-gen/csharp/templates/Maps.mustache b/ocaml/sdk-gen/csharp/templates/Maps.mustache
new file mode 100644
index 000000000..b8942e887
--- /dev/null
+++ b/ocaml/sdk-gen/csharp/templates/Maps.mustache
@@ -0,0 +1,64 @@
+/*
+ * Copyright (c) Cloud Software Group, Inc.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1) Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2) Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following
+ * disclaimer in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+ * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+ * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+ * OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+using System;
+using System.Collections;
+using System.Collections.Generic;
+
+namespace XenAPI
+{
+ internal class Maps
+ {
+{{#all_maps}}
+ internal static Dictionary<{{{map_key}}}, {{{map_value}}}> ToDictionary_{{{sanitised_key}}}_{{{sanitised_value}}}(Hashtable table)
+ {
+ var result = new Dictionary<{{{map_key}}}, {{{map_value}}}>();
+ if (table != null)
+ {
+ foreach (string key in table.Keys)
+ {
+ try
+ {
+ {{{map_key}}} k = {{{proxy_key}}};
+ {{{map_value}}} v = {{{proxy_value}}};
+ result[k] = v;
+ }
+ catch
+ {
+ // continue
+ }
+ }
+ }
+ return result;
+ }
+
+{{/all_maps}}
+ }
+}
diff --git a/ocaml/sdk-gen/csharp/templates/Relation.mustache b/ocaml/sdk-gen/csharp/templates/Relation.mustache
new file mode 100644
index 000000000..69f3cd8c8
--- /dev/null
+++ b/ocaml/sdk-gen/csharp/templates/Relation.mustache
@@ -0,0 +1,64 @@
+/*
+ * Copyright (c) Cloud Software Group, Inc.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1) Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2) Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following
+ * disclaimer in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+ * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+ * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+ * OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+using System;
+using System.Collections.Generic;
+
+namespace XenAPI
+{
+ public partial class Relation
+ {
+ public readonly String field;
+ public readonly String manyType;
+ public readonly String manyField;
+
+ public Relation(String field, String manyType, String manyField)
+ {
+ this.field = field;
+ this.manyField = manyField;
+ this.manyType = manyType;
+ }
+
+ public static Dictionary<Type, Relation[]> GetRelations()
+ {
+ Dictionary<Type, Relation[]> relations = new Dictionary<Type, Relation[]>();
+{{#types}}
+
+ relations.Add(typeof({{type}}), new Relation[] {
+ {{#relations}}
+ new Relation("{{field}}", "{{manyType}}", "{{manyField}}"),
+ {{/relations}}
+ });
+{{/types}}
+
+ return relations;
+ }
+ }
+}
diff --git a/ocaml/sdk-gen/powershell/autogen/Initialize-Environment.ps1 b/ocaml/sdk-gen/powershell/autogen/Initialize-Environment.ps1
index d418745ee..c0d7b30dc 100644
--- a/ocaml/sdk-gen/powershell/autogen/Initialize-Environment.ps1
+++ b/ocaml/sdk-gen/powershell/autogen/Initialize-Environment.ps1
@@ -46,4 +46,6 @@ if (Test-Path $perUserXsProfile) {
Remove-Item variable:systemWideXsProfile
Remove-Item variable:perUserXsProfile
+$global:KnownServerCertificatesFilePath = Join-Path -Path (Split-Path $PROFILE) -ChildPath "XenServer_Known_Certificates.xml"
+
$XenServer_Environment_Initialized = $true
diff --git a/ocaml/sdk-gen/powershell/autogen/src/CommonCmdletFunctions.cs b/ocaml/sdk-gen/powershell/autogen/src/CommonCmdletFunctions.cs
index d01a03098..8f29ecde1 100644
--- a/ocaml/sdk-gen/powershell/autogen/src/CommonCmdletFunctions.cs
+++ b/ocaml/sdk-gen/powershell/autogen/src/CommonCmdletFunctions.cs
@@ -42,8 +42,10 @@ namespace Citrix.XenServer
class CommonCmdletFunctions
{
private const string SessionsVariable = "global:Citrix.XenServer.Sessions";
+
private const string DefaultSessionVariable = "global:XenServer_Default_Session";
- private static string CertificatePath = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments), @"WindowsPowerShell\XenServer_Known_Certificates.xml");
+
+ private const string KnownServerCertificatesFilePathVariable = "global:KnownServerCertificatesFilePath";
static CommonCmdletFunctions()
{
@@ -68,8 +70,7 @@ namespace Citrix.XenServer
internal static Session GetDefaultXenSession(PSCmdlet cmdlet)
{
- object obj = cmdlet.SessionState.PSVariable.GetValue(DefaultSessionVariable);
- return obj as Session;
+ return cmdlet.SessionState.PSVariable.GetValue(DefaultSessionVariable) as Session;
}
internal static void SetDefaultXenSession(PSCmdlet cmdlet, Session session)
@@ -77,19 +78,28 @@ namespace Citrix.XenServer
cmdlet.SessionState.PSVariable.Set(DefaultSessionVariable, session);
}
+ internal static string GetKnownServerCertificatesFilePathVariable(PSCmdlet cmdlet)
+ {
+ var knownCertificatesFilePathObject = cmdlet.SessionState.PSVariable.GetValue(KnownServerCertificatesFilePathVariable);
+ if (knownCertificatesFilePathObject is PSObject psObject)
+ return psObject.BaseObject as string;
+ return knownCertificatesFilePathObject?.ToString() ?? string.Empty;
+ }
+
internal static string GetUrl(string hostname, int port)
{
return string.Format("{0}://{1}:{2}", port == 80 ? "http" : "https", hostname, port);
}
- public static Dictionary<string, string> LoadCertificates()
+ public static Dictionary<string, string> LoadCertificates(PSCmdlet cmdlet)
{
Dictionary<string, string> certificates = new Dictionary<string, string>();
+ var knownServerCertificatesFilePath = GetKnownServerCertificatesFilePathVariable(cmdlet);
- if (File.Exists(CertificatePath))
+ if (File.Exists(knownServerCertificatesFilePath))
{
XmlDocument doc = new XmlDocument();
- doc.Load(CertificatePath);
+ doc.Load(knownServerCertificatesFilePath);
foreach (XmlNode node in doc.GetElementsByTagName("certificate"))
{
@@ -104,9 +114,10 @@ namespace Citrix.XenServer
return certificates;
}
- public static void SaveCertificates(Dictionary<string, string> certificates)
+ public static void SaveCertificates(PSCmdlet cmdlet, Dictionary<string, string> certificates)
{
- string dirName = Path.GetDirectoryName(CertificatePath);
+ var knownServerCertificatesFilePath = GetKnownServerCertificatesFilePathVariable(cmdlet);
+ string dirName = Path.GetDirectoryName(knownServerCertificatesFilePath);
if (!Directory.Exists(dirName))
Directory.CreateDirectory(dirName);
@@ -129,7 +140,7 @@ namespace Citrix.XenServer
}
doc.AppendChild(node);
- doc.Save(CertificatePath);
+ doc.Save(knownServerCertificatesFilePath);
}
public static string FingerprintPrettyString(string fingerprint)
diff --git a/ocaml/sdk-gen/powershell/autogen/src/Connect-XenServer.cs b/ocaml/sdk-gen/powershell/autogen/src/Connect-XenServer.cs
index 0ec80444a..c1155f7a2 100644
--- a/ocaml/sdk-gen/powershell/autogen/src/Connect-XenServer.cs
+++ b/ocaml/sdk-gen/powershell/autogen/src/Connect-XenServer.cs
@@ -253,9 +253,9 @@ namespace Citrix.XenServer.Commands
private void AddCertificate(string hostname, string fingerprint)
{
- var certificates = CommonCmdletFunctions.LoadCertificates();
+ var certificates = CommonCmdletFunctions.LoadCertificates(this);
certificates[hostname] = fingerprint;
- CommonCmdletFunctions.SaveCertificates(certificates);
+ CommonCmdletFunctions.SaveCertificates(this, certificates);
}
private bool ValidateServerCertificate(object sender, X509Certificate certificate, X509Chain chain, SslPolicyErrors sslPolicyErrors)
@@ -274,7 +274,7 @@ namespace Citrix.XenServer.Commands
bool trusted = VerifyInAllStores(new X509Certificate2(certificate));
- var certificates = CommonCmdletFunctions.LoadCertificates();
+ var certificates = CommonCmdletFunctions.LoadCertificates(this);
if (certificates.ContainsKey(hostname))
{
@@ -292,7 +292,7 @@ namespace Citrix.XenServer.Commands
}
certificates[hostname] = fingerprint;
- CommonCmdletFunctions.SaveCertificates(certificates);
+ CommonCmdletFunctions.SaveCertificates(this, certificates);
return true;
}
}
diff --git a/ocaml/sdk-gen/powershell/autogen/src/XenServerPowerShell.csproj b/ocaml/sdk-gen/powershell/autogen/src/XenServerPowerShell.csproj
index 85ea0dc72..23fff0134 100644
--- a/ocaml/sdk-gen/powershell/autogen/src/XenServerPowerShell.csproj
+++ b/ocaml/sdk-gen/powershell/autogen/src/XenServerPowerShell.csproj
@@ -6,7 +6,7 @@
<GenerateAssemblyInfo>True</GenerateAssemblyInfo>
</PropertyGroup>
<PropertyGroup>
- <!-- This propety ensures all DLLs are placed oin `bin/` at compile time -->
+ <!-- This propety ensures all DLLs are placed in `bin/` at compile time -->
<CopyLocalLockFileAssemblies>true</CopyLocalLockFileAssemblies>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)|$(OS)' == 'Debug|AnyCPU|Windows_NT' And '$(TargetFramework)' == 'net6.0'">
diff --git a/ocaml/sdk-gen/powershell/gen_powershell_binding.ml b/ocaml/sdk-gen/powershell/gen_powershell_binding.ml
index 26b94fba2..b455d0104 100644
--- a/ocaml/sdk-gen/powershell/gen_powershell_binding.ml
+++ b/ocaml/sdk-gen/powershell/gen_powershell_binding.ml
@@ -19,6 +19,8 @@ end)
let destdir = "autogen/src"
+let templdir = "templates"
+
type cmdlet = {filename: string; content: string}
let api =
@@ -67,17 +69,38 @@ let generated x =
not (List.mem x.name ["blob"; "session"; "debug"; "event"; "vtpm"])
let rec main () =
- gen_xenref_converters classes ;
- let cmdlets =
- classes |> List.filter generated |> List.map gen_cmdlets |> List.concat
+ let json =
+ `O
+ [
+ ( "all_classes"
+ , `A
+ (List.map
+ (fun x ->
+ `O
+ [
+ ("exposed_name", `String (exposed_class_name x.name))
+ ; ( "var_name"
+ , `String (ocaml_class_to_csharp_local_var x.name)
+ )
+ ]
+ )
+ classes
+ )
+ )
+ ]
in
- let http_cmdlets =
+ render_file
+ ("ConvertTo-XenRef.mustache", "ConvertTo-XenRef.cs")
+ json templdir destdir ;
+
http_actions
|> List.filter (fun (_, (_, _, sdk, _, _, _)) -> sdk)
- |> List.map gen_http_action
+ |> List.iter gen_http_action ;
+
+ let cmdlets =
+ classes |> List.filter generated |> List.map gen_cmdlets |> List.concat
in
- let all_cmdlets = cmdlets @ http_cmdlets in
- List.iter (fun x -> write_file x.filename x.content) all_cmdlets
+ List.iter (fun x -> write_file x.filename x.content) cmdlets
(****************)
(* Http actions *)
@@ -87,196 +110,58 @@ and gen_http_action action =
let commonVerb = get_http_action_verb name meth in
let verbCategory = get_common_verb_category commonVerb in
let stem = get_http_action_stem name in
- let content =
- sprintf
- "%s\n\n\
- using System;\n\
- using System.Collections;\n\
- using System.Collections.Generic;\n\
- using System.Management.Automation;\n\
- using XenAPI;\n\n\
- namespace Citrix.XenServer.Commands\n\
- {\n\
- \ [Cmdlet(%s.%s, \"Xen%s\"%s)]\n\
- \ [OutputType(typeof(void))]\n\
- \ public class %sXen%sCommand : XenServerHttpCmdlet\n\
- \ {\n\
- \ #region Cmdlet Parameters\n\
- %s%s\n\
- \ #endregion\n\n\
- \ #region Cmdlet Methods\n\n\
- \ protected override void ProcessRecord()\n\
- \ {\n\
- \ GetSession();\n\
- %s\n\
- \ RunApiCall(() => %s);\n\
- \ }\n\n\
- \ #endregion\n\
- \ }\n\
- }\n"
- Licence.bsd_two_clause verbCategory commonVerb stem
- (gen_should_process_http_decl meth)
- commonVerb stem
- (gen_progress_tracker meth)
- (gen_arg_params args)
- (gen_should_process_http meth uri)
- (gen_http_action_call action)
- in
- {filename= sprintf "%s-Xen%s.cs" commonVerb stem; content}
-
-and gen_should_process_http_decl meth =
- match meth with
- | Put ->
- ", SupportsShouldProcess = true"
- | Get ->
- ", SupportsShouldProcess = false"
- | _ ->
- assert false
-
-and gen_should_process_http meth uri =
- match meth with
- | Put ->
- sprintf
- "\n if (!ShouldProcess(\"%s\"))\n return;\n"
- uri
- | _ ->
- ""
-
-and gen_progress_tracker meth =
- match meth with
- | Get ->
- "\n\
- \ [Parameter]\n\
- \ public HTTP.DataCopiedDelegate DataCopiedDelegate { get; set; }\n"
- | Put ->
- "\n\
- \ [Parameter]\n\
- \ public HTTP.UpdateProgressDelegate ProgressDelegate { get; set; }\n"
- | _ ->
- assert false
-
-and gen_arg_params args =
- match args with
- | [] ->
- ""
- | hd :: tl ->
- sprintf "%s%s" (gen_arg_param hd) (gen_arg_params tl)
-
-and gen_arg_param = function
- | String_query_arg x ->
- sprintf
- "\n [Parameter%s]\n public string %s { get; set; }\n"
- ( if String.lowercase_ascii x = "uuid" then
- "(ValueFromPipelineByPropertyName = true)"
- else
- ""
- )
- (pascal_case_rec x)
- | Int64_query_arg x ->
- sprintf "\n [Parameter]\n public long? %s { get; set; }\n"
- (pascal_case_rec x)
+ let arg_name = function
+ | String_query_arg x | Int64_query_arg x ->
+ pascal_case_rec x
| Bool_query_arg x ->
- let y = if x = "host" then "is_host" else x in
- sprintf "\n [Parameter]\n public bool? %s { get; set; }\n"
- (pascal_case_rec y)
+ if String.lowercase_ascii x = "host" then
+ "IsHost"
+ else
+ pascal_case_rec x
| Varargs_query_arg ->
- sprintf
- "\n\
- \ ///<summary>\n\
- \ /// Alternate names and values\n\
- \ ///</summary>\n\
- \ [Parameter]\n\
- \ public string[] Args { get; set; }\n"
-
-and gen_http_action_call (name, (meth, _, _, args, _, _)) =
- let progressTracker =
- match meth with
- | Get ->
- "DataCopiedDelegate"
- | Put ->
- "ProgressDelegate"
- | _ ->
- assert false
+ "Args"
in
- sprintf
- "XenAPI.HTTP_actions.%s(%s,\n\
- \ CancellingDelegate, TimeoutMs, XenHost, Proxy, Path, \
- TaskRef,\n\
- \ session.opaque_ref%s)" name progressTracker
- (gen_call_arg_params args)
-
-and gen_call_arg_params args =
- match args with
- | [] ->
- ""
- | hd :: tl ->
- sprintf "%s%s" (gen_call_arg_param hd) (gen_call_arg_params tl)
-
-and gen_call_arg_param = function
- | String_query_arg x ->
- sprintf ", %s" (pascal_case_rec x)
- | Int64_query_arg x ->
- sprintf ", %s" (pascal_case_rec x)
- | Bool_query_arg x ->
- let y = if x = "host" then "is_host" else x in
- sprintf ", %s" (pascal_case_rec y)
+ let arg_type = function
+ | String_query_arg _ ->
+ "string"
+ | Int64_query_arg _ ->
+ "long?"
+ | Bool_query_arg _ ->
+ "bool?"
| Varargs_query_arg ->
- sprintf ", Args"
-
-(***********************************)
-(* Utility cmdlet ConvertTo-XenRef *)
-(***********************************)
-and gen_xenref_converters classes =
- write_file "ConvertTo-XenRef.cs" (gen_body_xenref_converters classes)
-
-and gen_body_xenref_converters classes =
- sprintf
- "%s\n\n\
- using System;\n\
- using System.Collections;\n\
- using System.Collections.Generic;\n\
- using System.Management.Automation;\n\
- using XenAPI;\n\n\
- namespace Citrix.XenServer.Commands\n\
- {\n\
- \ [Cmdlet(VerbsData.ConvertTo, \"XenRef\")]\n\
- \ [OutputType(typeof(IXenObject))]\n\
- \ public class ConvertToXenRefCommand : PSCmdlet\n\
- \ {\n\
- \ #region Cmdlet Parameters\n\n\
- \ [Parameter(Mandatory = true, ValueFromPipeline = true, Position = \
- 0)]\n\
- \ public IXenObject XenObject { get; set; }\n\n\
- \ #endregion\n\n\
- \ #region Cmdlet Methods\n\n\
- \ protected override void ProcessRecord()\n\
- \ {%s\n\
- \ }\n\n\
- \ #endregion\n\n\
- \ }\n\
- }\n"
- Licence.bsd_two_clause (print_converters classes)
-
-and print_converters classes =
- match classes with
- | [] ->
- ""
- | hd :: tl ->
- sprintf
- "\n\
- \ %s %s = XenObject as %s;\n\
- \ if (%s != null)\n\
- \ {\n\
- \ WriteObject(new XenRef<%s>(%s));\n\
- \ return;\n\
- \ }%s"
- (qualified_class_name hd.name)
- (ocaml_class_to_csharp_local_var hd.name)
- (qualified_class_name hd.name)
- (ocaml_class_to_csharp_local_var hd.name)
- (qualified_class_name hd.name)
- (ocaml_class_to_csharp_local_var hd.name)
- (print_converters tl)
+ "string[]"
+ in
+ let json =
+ `O
+ [
+ ("verb_category", `String verbCategory)
+ ; ("common_verb", `String commonVerb)
+ ; ("stem", `String stem)
+ ; ("isPut", `Bool (meth == Put))
+ ; ("isGet", `Bool (meth == Get))
+ ; ("uri", `String uri)
+ ; ("action_name", `String name)
+ ; ( "args"
+ , `A
+ (List.map
+ (fun x ->
+ `O
+ [
+ ("arg_type", `String (arg_type x))
+ ; ("arg_name", `String (arg_name x))
+ ; ( "from_pipeline"
+ , `Bool (String.lowercase_ascii (arg_name x) = "uuid")
+ )
+ ]
+ )
+ args
+ )
+ )
+ ]
+ in
+ render_file
+ ("HttpAction.mustache", sprintf "%s-Xen%s.cs" commonVerb stem)
+ json templdir destdir
(*************************)
(* Autogenerated cmdlets *)
diff --git a/ocaml/sdk-gen/powershell/templates/ConvertTo-XenRef.mustache b/ocaml/sdk-gen/powershell/templates/ConvertTo-XenRef.mustache
new file mode 100644
index 000000000..669704fa3
--- /dev/null
+++ b/ocaml/sdk-gen/powershell/templates/ConvertTo-XenRef.mustache
@@ -0,0 +1,63 @@
+/*
+ * Copyright (c) Cloud Software Group, Inc.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1) Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2) Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following
+ * disclaimer in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+ * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+ * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+ * OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+using System.Management.Automation;
+using XenAPI;
+
+namespace Citrix.XenServer.Commands
+{
+ [Cmdlet(VerbsData.ConvertTo, "XenRef")]
+ [OutputType(typeof(IXenObject))]
+ public class ConvertToXenRefCommand : PSCmdlet
+ {
+ #region Cmdlet Parameters
+
+ [Parameter(Mandatory = true, ValueFromPipeline = true, Position = 0,
+ HelpMessage = "The API object to convert")]
+ public IXenObject XenObject { get; set; }
+
+ #endregion
+
+ #region Cmdlet Methods
+
+ protected override void ProcessRecord()
+ {
+{{#all_classes}}
+ if (XenObject is {{exposed_name}} {{var_name}})
+ {
+ WriteObject(new XenRef<{{exposed_name}}>({{var_name}}));
+ return;
+ }
+{{/all_classes}}
+ }
+
+ #endregion
+ }
+}
diff --git a/ocaml/sdk-gen/powershell/templates/HttpAction.mustache b/ocaml/sdk-gen/powershell/templates/HttpAction.mustache
new file mode 100644
index 000000000..e346a68b8
--- /dev/null
+++ b/ocaml/sdk-gen/powershell/templates/HttpAction.mustache
@@ -0,0 +1,80 @@
+/*
+ * Copyright (c) Cloud Software Group, Inc.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1) Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2) Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following
+ * disclaimer in the documentation and/or other materials
+ * provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
+ * INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+ * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
+ * OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+
+using System;
+using System.Collections;
+using System.Collections.Generic;
+using System.Management.Automation;
+using XenAPI;
+
+namespace Citrix.XenServer.Commands
+{
+ [Cmdlet({{verb_category}}.{{common_verb}}, "Xen{{stem}}", SupportsShouldProcess = {{#isPut}}true{{/isPut}}{{#isGet}}false{{/isGet}})]
+ [OutputType(typeof(void))]
+ public class {{common_verb}}Xen{{stem}}Command : XenServerHttpCmdlet
+ {
+ #region Cmdlet Parameters
+{{#isPut}}
+
+ [Parameter]
+ public HTTP.UpdateProgressDelegate ProgressDelegate { get; set; }
+{{/isPut}}
+{{#isGet}}
+
+ [Parameter]
+ public HTTP.DataCopiedDelegate DataCopiedDelegate { get; set; }
+{{/isGet}}
+{{#args}}
+
+ [Parameter{{#from_pipeline}}(ValueFromPipelineByPropertyName = true){{/from_pipeline}}]
+ public {{arg_type}} {{arg_name}} { get; set; }
+{{/args}}
+
+ #endregion
+
+ #region Cmdlet Methods
+
+ protected override void ProcessRecord()
+ {
+ GetSession();
+{{#isPut}}
+
+ if (!ShouldProcess("{{uri}}"))
+ return;
+{{/isPut}}
+
+ RunApiCall(() => HTTP_actions.{{action_name}}({{#isPut}}ProgressDelegate{{/isPut}}{{#isGet}}DataCopiedDelegate{{/isGet}},
+ CancellingDelegate, TimeoutMs, XenHost, Proxy, Path, TaskRef,
+ session.opaque_ref{{#args}}, {{arg_name}}{{/args}}));
+ }
+
+ #endregion
+ }
+}
diff --git a/ocaml/tests/test_livepatch.ml b/ocaml/tests/test_livepatch.ml
index 31b0eef8b..b87b657c8 100644
--- a/ocaml/tests/test_livepatch.ml
+++ b/ocaml/tests/test_livepatch.ml
@@ -52,6 +52,38 @@ lp_4.13.4-10.22.xs8-4.13.4-10.23.xs8 | CHECKED
|}
, None
)
+ ; ( {|
+ ID | status
+----------------------------------------+------------
+lp_4.13.4-10.22.xs8-4.13.4-10.23.xs8| CHECKED
+lp_4.13.4-10.22.xs8-4.13.4-10.23.xs8| APPLIED
+ |}
+ , Some ("4.13.4", "10.22.xs8", "4.13.4", "10.23.xs8")
+ )
+ ; ( {|
+ ID | status
+----------------------------------------+------------
+ lp_4.13.4-10.22.xs8-4.13.4-10.23.xs8|CHECKED
+ lp_4.13.4-10.22.xs8-4.13.4-10.23.xs8|APPLIED
+ |}
+ , Some ("4.13.4", "10.22.xs8", "4.13.4", "10.23.xs8")
+ )
+ ; ( {|
+ ID | status
+----------------------------------------+------------
+p_4.13.4-10.22.xs8-4.13.4-10.23.xs8 | CHECKED
+p_4.13.4-10.22.xs8-4.13.4-10.23.xs8 | APPLIED
+ |}
+ , None
+ )
+ ; ( {|
+ ID | status | metadata
+----------------------------------------+------------+---------------
+lp_4.17.3-3.11.gf717213.xs8-4.17.3-3.12.xs8| CHECKED |
+lp_4.17.3-3.11.gf717213.xs8-4.17.3-3.13.xs8| APPLIED |
+ |}
+ , Some ("4.17.3", "3.11.gf717213.xs8", "4.17.3", "3.13.xs8")
+ )
]
end)
diff --git a/ocaml/xapi-cli-server/cli_frontend.ml b/ocaml/xapi-cli-server/cli_frontend.ml
index f8aa043eb..58ecb6cc8 100644
--- a/ocaml/xapi-cli-server/cli_frontend.ml
+++ b/ocaml/xapi-cli-server/cli_frontend.ml
@@ -1756,7 +1756,13 @@ let rec cmdtable_data : (string * cmd_spec) list =
; ( "vm-export"
, {
reqd= ["filename"]
- ; optn= ["preserve-power-state"; "compress"]
+ ; optn=
+ [
+ "preserve-power-state"
+ ; "compress"
+ ; "metadata"
+ ; "excluded-device-types"
+ ]
; help= "Export a VM to <filename>."
; implementation= With_fd Cli_operations.vm_export
; flags= [Standard; Vm_selectors]
@@ -1798,7 +1804,13 @@ let rec cmdtable_data : (string * cmd_spec) list =
; ( "snapshot-export-to-template"
, {
reqd= ["filename"; "snapshot-uuid"]
- ; optn= ["preserve-power-state"]
+ ; optn=
+ [
+ "preserve-power-state"
+ ; "compress"
+ ; "metadata"
+ ; "excluded-device-types"
+ ]
; help= "Export a snapshot to <filename>."
; implementation= With_fd Cli_operations.snapshot_export
; flags= [Standard]
@@ -1863,7 +1875,7 @@ let rec cmdtable_data : (string * cmd_spec) list =
; ( "template-export"
, {
reqd= ["filename"; "template-uuid"]
- ; optn= []
+ ; optn= ["compress"; "metadata"; "excluded-device-types"]
; help= "Export a template to <filename>."
; implementation= With_fd Cli_operations.template_export
; flags= [Standard]
diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml
index bc0d9ea30..4f28a4884 100644
--- a/ocaml/xapi-cli-server/cli_operations.ml
+++ b/ocaml/xapi-cli-server/cli_operations.ml
@@ -32,26 +32,10 @@ let failwith str = raise (Cli_util.Cli_failure str)
exception ExitWithError of int
let bool_of_string param string =
- let s = String.lowercase_ascii string in
- match s with
- | "true" ->
- true
- | "t" ->
- true
- | "1" ->
- true
- | "false" ->
- false
- | "f" ->
- false
- | "0" ->
- false
- | _ ->
- failwith
- ("Failed to parse parameter '"
- ^ param
- ^ "': expecting 'true' or 'false'"
- )
+ try Record_util.bool_of_string string
+ with Record_util.Record_failure msg ->
+ let msg = Printf.sprintf "Failed to parse parameter '%s': %s" param msg in
+ raise (Record_util.Record_failure msg)
let get_bool_param params ?(default = false) param =
List.assoc_opt param params
@@ -66,6 +50,24 @@ let get_float_param params param ~default =
let get_param params param ~default =
Option.value ~default (List.assoc_opt param params)
+let get_set_param params ?(default = []) param =
+ List.assoc_opt param params
+ |> Option.map (String.split_on_char ',')
+ |> Option.value ~default
+
+let get_map_param params ?(default = []) param =
+ let get_map x =
+ String.split_on_char ',' x
+ |> List.filter_map (fun x ->
+ match String.split_on_char ':' x with
+ | [k; v] ->
+ Some (k, v)
+ | _ ->
+ None
+ )
+ in
+ List.assoc_opt param params |> Option.map get_map |> Option.value ~default
+
(** [get_unique_param param params] is intended to replace [List.assoc_opt] in
the cases where a parameter can only exist once, as repeating it might
force the CLI to make choices the user didn't foresee. In those cases
@@ -1520,16 +1522,15 @@ let pool_management_reconfigure (_ : printer) rpc session_id params =
let pool_join printer rpc session_id params =
try
let force = get_bool_param params "force" in
+ let master_address = List.assoc "master-address" params in
+ let master_username = List.assoc "master-username" params in
+ let master_password = List.assoc "master-password" params in
if force then
- Client.Pool.join_force ~rpc ~session_id
- ~master_address:(List.assoc "master-address" params)
- ~master_username:(List.assoc "master-username" params)
- ~master_password:(List.assoc "master-password" params)
+ Client.Pool.join_force ~rpc ~session_id ~master_address ~master_username
+ ~master_password
else
- Client.Pool.join ~rpc ~session_id
- ~master_address:(List.assoc "master-address" params)
- ~master_username:(List.assoc "master-username" params)
- ~master_password:(List.assoc "master-password" params) ;
+ Client.Pool.join ~rpc ~session_id ~master_address ~master_username
+ ~master_password ;
printer
(Cli_printer.PList
[
@@ -3264,11 +3265,11 @@ let do_vm_op ?(include_control_vms = false) ?(include_template_vms = false)
select_vms ~include_control_vms ~include_template_vms rpc session_id
params ignore_params
in
- match List.length vms with
- | 0 ->
+ match vms with
+ | [] ->
failwith "No matching VMs found"
- | 1 ->
- [op (List.hd vms)]
+ | [vm] ->
+ [op vm]
| _ ->
if multiple && get_bool_param params "multiple" then
do_multiple op vms
@@ -3310,11 +3311,11 @@ let do_host_op rpc session_id op params ?(multiple = true) ignore_params =
let do_sr_op rpc session_id op params ?(multiple = true) ignore_params =
let srs = select_srs rpc session_id params ignore_params in
- match List.length srs with
- | 0 ->
+ match srs with
+ | [] ->
failwith "No matching hosts found"
- | 1 ->
- [op (List.hd srs)]
+ | [sr] ->
+ [op sr]
| _ ->
if multiple && get_bool_param params "multiple" then
do_multiple op srs
@@ -5575,12 +5576,7 @@ let vm_import fd _printer rpc session_id params =
raise
(Cli_util.Cli_failure "No SR specified and Pool default SR is null")
in
- let _type =
- if List.mem_assoc "type" params then
- List.assoc "type" params
- else
- "default"
- in
+ let _type = get_param ~default:"default" params "type" in
let full_restore = get_bool_param params "preserve" in
let vm_metadata_only = get_bool_param params "metadata" in
let force = get_bool_param params "force" in
@@ -5806,9 +5802,7 @@ let blob_put fd _printer rpc session_id params =
let blob_create printer rpc session_id params =
let name = List.assoc "name" params in
let mime_type = Listext.assoc_default "mime-type" params "" in
- let public =
- try bool_of_string "public" (List.assoc "public" params) with _ -> false
- in
+ let public = get_bool_param params "public" in
if List.mem_assoc "vm-uuid" params then
let uuid = List.assoc "vm-uuid" params in
let vm = Client.VM.get_by_uuid ~rpc ~session_id ~uuid in
@@ -5860,14 +5854,17 @@ let blob_create printer rpc session_id params =
let export_common fd _printer rpc session_id params filename num ?task_uuid
compression preserve_power_state vm =
- let vm_metadata_only : bool = get_bool_param params "metadata" in
- let export_snapshots : bool =
- if List.mem_assoc "include-snapshots" params then
- bool_of_string "include-snapshots" (List.assoc "include-snapshots" params)
+ let vm_metadata_only = get_bool_param params "metadata" in
+ let export_snapshots = get_bool_param params "include-snapshots" in
+ let uri, extra_args =
+ if vm_metadata_only then
+ ( Constants.export_metadata_uri
+ , Printf.sprintf "&excluded_device_types=%s"
+ (get_param params ~default:"" "excluded-device-types")
+ )
else
- vm_metadata_only
+ (Constants.export_uri, "")
in
- let vm_metadata_only = get_bool_param params "metadata" in
let vm_record = vm.record () in
let exporttask, task_destroy_fn =
match task_uuid with
@@ -5884,49 +5881,40 @@ let export_common fd _printer rpc session_id params filename num ?task_uuid
(* do not destroy the task that has been received *)
(Client.Task.get_by_uuid ~rpc ~session_id ~uuid:task_uuid, fun () -> ())
in
- (* Initially mark the task progress as -1.0. The first thing the export handler does it to mark it as zero *)
- (* This is used as a flag to show that the 'ownership' of the task has been passed to the handler, and it's *)
- (* not our responsibility any more to mark the task as completed/failed/etc. *)
+ (* Initially mark the task progress as -1.0. The first thing the export
+ handler does it to mark it as zero. This is used as a flag to show that
+ the 'ownership' of the task has been passed to the handler, and it's
+ not our responsibility any more to mark the task as completed/failed/etc.
+ *)
Client.Task.set_progress ~rpc ~session_id ~self:exporttask ~value:(-1.0) ;
finally
(fun () ->
- let f = if !num > 1 then filename ^ string_of_int !num else filename in
+ let num = Atomic.fetch_and_add num 1 in
+ let f = if num > 1 then filename ^ string_of_int num else filename in
download_file rpc session_id exporttask fd f
(Printf.sprintf
- "%s?session_id=%s&task_id=%s&ref=%s&%s=%s&preserve_power_state=%b&export_snapshots=%b"
- ( if vm_metadata_only then
- Constants.export_metadata_uri
- else
- Constants.export_uri
- )
- (Ref.string_of session_id) (Ref.string_of exporttask)
+ "%s?session_id=%s&task_id=%s&ref=%s&%s=%s&preserve_power_state=%b&export_snapshots=%b%s"
+ uri (Ref.string_of session_id) (Ref.string_of exporttask)
(Ref.string_of (vm.getref ()))
Constants.use_compression
(Compression_algorithms.to_string compression)
- preserve_power_state export_snapshots
+ preserve_power_state export_snapshots extra_args
)
- "Export" ;
- num := !num + 1
+ "Export"
)
(fun () -> task_destroy_fn ())
let get_compression_algorithm params =
- if List.mem_assoc "compress" params then
- Compression_algorithms.of_string (List.assoc "compress" params)
- else
- None
+ Option.bind
+ (List.assoc_opt "compress" params)
+ Compression_algorithms.of_string
let vm_export fd printer rpc session_id params =
let filename = List.assoc "filename" params in
let compression = get_compression_algorithm params in
let preserve_power_state = get_bool_param params "preserve-power-state" in
- let task_uuid =
- if List.mem_assoc "task-uuid" params then
- Some (List.assoc "task-uuid" params)
- else
- None
- in
- let num = ref 1 in
+ let task_uuid = List.assoc_opt "task-uuid" params in
+ let num = Atomic.make 1 in
let op vm =
export_common fd printer rpc session_id params filename num ?task_uuid
compression preserve_power_state vm
@@ -5939,6 +5927,7 @@ let vm_export fd printer rpc session_id params =
; "compress"
; "preserve-power-state"
; "include-snapshots"
+ ; "excluded-device-types"
]
)
@@ -5946,32 +5935,23 @@ let vm_export_aux obj_type fd printer rpc session_id params =
let filename = List.assoc "filename" params in
let compression = get_compression_algorithm params in
let preserve_power_state = get_bool_param params "preserve-power-state" in
- let num = ref 1 in
let uuid = List.assoc (obj_type ^ "-uuid") params in
- let ref = Client.VM.get_by_uuid ~rpc ~session_id ~uuid in
- if
- obj_type = "template"
- && not (Client.VM.get_is_a_template ~rpc ~session_id ~self:ref)
- then
- failwith
- (Printf.sprintf
- "This operation can only be performed on a VM template. %s is not a \
- VM template."
- uuid
- ) ;
- if
- obj_type = "snapshot"
- && not (Client.VM.get_is_a_snapshot ~rpc ~session_id ~self:ref)
- then
- failwith
- (Printf.sprintf
- "This operation can only be performed on a VM snapshot. %s is not a \
- VM snapshot."
- uuid
- ) ;
+ let vm = Client.VM.get_by_uuid ~rpc ~session_id ~uuid in
+ let is_template () = Client.VM.get_is_a_template ~rpc ~session_id ~self:vm in
+ let is_snapshot () = Client.VM.get_is_a_snapshot ~rpc ~session_id ~self:vm in
+ let msg () =
+ Printf.sprintf
+ "This operation can only be performed on a VM %s. %s is not a VM %s."
+ obj_type uuid obj_type
+ in
+ if obj_type = "template" && not (is_template ()) then
+ failwith (msg ()) ;
+ if obj_type = "snapshot" && not (is_snapshot ()) then
+ failwith (msg ()) ;
+ let num = Atomic.make 1 in
export_common fd printer rpc session_id params filename num compression
preserve_power_state
- (vm_record rpc session_id ref)
+ (vm_record rpc session_id vm)
let vm_copy_bios_strings printer rpc session_id params =
let host =
@@ -7349,7 +7329,7 @@ let vmss_create printer rpc session_id params =
let schedule = read_map_params "schedule" params in
(* optional parameters with default values *)
let name_description = get "name-description" ~default:"" in
- let enabled = Record_util.bool_of_string (get "enabled" ~default:"true") in
+ let enabled = get_bool_param ~default:true params "enabled" in
let retained_snapshots =
Int64.of_string (get "retained-snapshots" ~default:"7")
in
@@ -7918,13 +7898,7 @@ module VTPM = struct
let create printer rpc session_id params =
let vm_uuid = List.assoc "vm-uuid" params in
let vM = Client.VM.get_by_uuid ~rpc ~session_id ~uuid:vm_uuid in
- let is_unique =
- match List.assoc_opt "is_unique" params with
- | Some value ->
- bool_of_string "is_unique" value
- | None ->
- false
- in
+ let is_unique = get_bool_param params "is_unique" in
let ref = Client.VTPM.create ~rpc ~session_id ~vM ~is_unique in
let uuid = Client.VTPM.get_uuid ~rpc ~session_id ~self:ref in
printer (Cli_printer.PList [uuid])
@@ -7940,33 +7914,12 @@ module Observer = struct
let create printer rpc session_id params =
let name_label = List.assoc "name-label" params in
let hosts =
- List.assoc_opt "host-uuids" params
- |> Option.fold ~none:[] ~some:(fun host_uuids ->
- List.map
- (fun uuid -> Client.Host.get_by_uuid ~rpc ~session_id ~uuid)
- (String.split_on_char ',' host_uuids)
- )
- in
- let name_description =
- List.assoc_opt "name-description" params |> Option.value ~default:""
- in
- let enabled =
- List.assoc_opt "enabled" params
- |> Option.fold ~none:false ~some:(fun s ->
- try Stdlib.bool_of_string s with _ -> false
- )
- in
- let attributes =
- List.assoc_opt "attributes" params
- |> Option.fold ~none:[] ~some:(String.split_on_char ',')
- |> List.filter_map (fun kv ->
- match String.split_on_char ':' kv with
- | [k; v] ->
- Some (k, v)
- | _ ->
- None
- )
+ get_set_param params "host-uuids"
+ |> List.map (fun uuid -> Client.Host.get_by_uuid ~rpc ~session_id ~uuid)
in
+ let name_description = get_param ~default:"" params "name-description" in
+ let enabled = get_bool_param params "enabled" in
+ let attributes = get_map_param params "attributes" in
let endpoints =
List.assoc_opt "endpoints" params
|> Option.fold ~none:[Tracing.bugtool_name]
diff --git a/ocaml/xapi-cli-server/record_util.ml b/ocaml/xapi-cli-server/record_util.ml
index 5332c2aee..8fbd141e9 100644
--- a/ocaml/xapi-cli-server/record_util.ml
+++ b/ocaml/xapi-cli-server/record_util.ml
@@ -953,12 +953,17 @@ let cluster_host_operation_to_string op =
let bool_of_string s =
match String.lowercase_ascii s with
- | "true" | "yes" ->
+ | "true" | "t" | "yes" | "y" | "1" ->
true
- | "false" | "no" ->
+ | "false" | "f" | "no" | "n" | "0" ->
false
| _ ->
- raise (Record_failure ("Expected 'true','yes','false','no', got " ^ s))
+ raise
+ (Record_failure
+ ("Expected 'true','t','yes','y','1','false','f','no','n','0' got "
+ ^ s
+ )
+ )
let sdn_protocol_of_string s =
match String.lowercase_ascii s with
diff --git a/ocaml/xapi-guard/lib/disk_cache.ml b/ocaml/xapi-guard/lib/disk_cache.ml
index 0f0a6e2c2..5e8b9bb06 100644
--- a/ocaml/xapi-guard/lib/disk_cache.ml
+++ b/ocaml/xapi-guard/lib/disk_cache.ml
@@ -62,18 +62,15 @@ let unlink_safe file =
type valid_file = t * string
-type file =
- | Latest of valid_file
- | Outdated of valid_file
- | Temporary of string
- | Invalid of string
-
-let path_of_key root (uuid, timestamp, key) =
- root
- // Uuidm.to_string uuid
+type file = Latest of valid_file | Outdated of valid_file | Invalid of string
+
+let print_key (uuid, timestamp, key) =
+ Uuidm.to_string uuid
// Types.Tpm.(serialize_key key |> string_of_int)
// Mtime.(to_uint64_ns timestamp |> Int64.to_string)
+let path_of_key root key = root // print_key key
+
let key_of_path path =
let ( let* ) = Option.bind in
let key_dir = Filename.(dirname path) in
@@ -81,7 +78,12 @@ let key_of_path path =
let* key =
Filename.basename key_dir
|> int_of_string_opt
- |> Option.map Types.Tpm.deserialize_key
+ |> Option.map (fun e ->
+ Types.Tpm.deserialize_key e
+ |> Result.map_error (fun msg -> D.info "Invalid key found: %s" msg)
+ |> Result.to_option
+ )
+ |> Option.join
in
let* timestamp =
Filename.basename path
@@ -90,24 +92,17 @@ let key_of_path path =
in
Some ((uuid, timestamp, key), path)
-let path_is_temp path =
- let pathlen = String.length path in
- String.ends_with ~suffix:".pre" path
- && key_of_path (String.sub path 0 (pathlen - 4)) |> Option.is_some
-
-let temp_of_path path = path ^ ".pre"
+let only_latest = function
+ | Latest f ->
+ Either.Left f
+ | Outdated (_, p) | Invalid p ->
+ Right p
let sort_updates contents =
let classify elem =
match key_of_path elem with
| None ->
- let file =
- if path_is_temp elem then
- Temporary elem
- else
- Invalid elem
- in
- Either.Right file
+ Either.Right (Invalid elem)
| Some valid_file ->
Either.Left valid_file
in
@@ -152,7 +147,7 @@ let read_from ~filename =
let persist_to ~filename:f_path ~contents =
let atomic_write_to_file ~perm f =
- let tmp_path = temp_of_path f_path in
+ let tmp_path = f_path ^ ".pre" in
let dirname = Filename.dirname f_path in
let flags = Unix.[O_WRONLY; O_CREAT; O_SYNC] in
let* fd_tmp = Lwt_unix.openfile tmp_path flags perm in
@@ -285,16 +280,10 @@ end = struct
let updates = sort_updates contents in
(* 2. Pick latest *)
- let only_latest = function
- | Latest (_, p) ->
- Either.Left p
- | Temporary p | Outdated (_, p) | Invalid p ->
- Right p
- in
let latest, _ = List.partition_map only_latest updates in
(* 3. fall back to remote read if needed *)
- let get_contents path =
+ let get_contents (_, path) =
Lwt.catch (fun () -> read_from ~filename:path) (fun _ -> read_remote ())
in
@@ -382,43 +371,38 @@ module Watcher : sig
end = struct
type push_cache = File of valid_file | Update_all | Wait
- (* Outdated and invalid files can be deleted, keep temporary files just in case
- they need to be recovered *)
- let discarder = function
- | Latest _ as f ->
- Either.Left f
- | Temporary _ as f ->
- Left f
- | Outdated (_, p) ->
- Right p
- | Invalid p ->
- Right p
-
let get_latest_and_delete_rest root =
let* files = get_all_contents root in
- let keep, to_delete = List.partition_map discarder files in
+ let latest, to_delete = List.partition_map only_latest files in
let* () = Lwt_list.iter_p unlink_safe to_delete in
- (* Ignore temporaty files *)
- let latest =
- List.filter_map (function Latest f -> Some f | _ -> None) keep
- in
Lwt.return latest
let retry_push push (uuid, timestamp, key) contents =
let __FUN = __FUNCTION__ in
let push' () = push (uuid, timestamp, key) contents in
- let rec retry k =
+ let counter = Mtime_clock.counter () in
+ let rec retry is_first_try =
let on_error e =
- D.info "%s: Error on push, attempt %i. Reason: %s" __FUN k
+ if is_first_try then
+ D.debug "%s: Error on push, retrying. Reason: %s" __FUN
(Printexc.to_string e) ;
let* () = Lwt_unix.sleep 0.1 in
- retry (k + 1)
+ retry false
in
Lwt.try_bind push'
- (function Ok () -> Lwt.return_unit | Error e -> on_error e)
+ (function
+ | Ok () -> Lwt.return (not is_first_try) | Error e -> on_error e
+ )
on_error
in
- retry 1
+ let* failed = retry true in
+ ( if failed then
+ let elapsed = Mtime_clock.count counter in
+ D.debug "%s: Pushed %s after trying for %s" __FUN
+ (print_key (uuid, timestamp, key))
+ (Fmt.to_to_string Mtime.Span.pp elapsed)
+ ) ;
+ Lwt.return_unit
let push_file push (key, path) =
let __FUN = __FUNCTION__ in
@@ -519,30 +503,28 @@ end
(** Module use to change the cache contents before the reader and writer start
running *)
module Setup : sig
- val retime_cache_contents : Types.Service.t -> unit Lwt.t
+ val retime_cache_contents : Types.Service.t -> t List.t Lwt.t
+ (** [retime_cache_contents typ] retimes the current cache contents so they
+ are time congruently with the current execution and returns the keys of
+ valid files that are yet to be pushed *)
end = struct
type file_action =
| Keep of file
| Delete of string
| Move of {from: string; into: string}
- let get_fs_action root now = function
+ let get_fs_action root now acc = function
| Latest ((uuid, timestamp, key), from) as latest ->
if Mtime.is_later ~than:now timestamp then
let timestamp = now in
let into = path_of_key root (uuid, timestamp, key) in
- Move {from; into}
+ ((uuid, timestamp, key) :: acc, Move {from; into})
else
- Keep latest
- | Temporary _ as temp ->
- Keep temp
+ ((uuid, timestamp, key) :: acc, Keep latest)
| Invalid p | Outdated (_, p) ->
- Delete p
+ (acc, Delete p)
let commit __FUN = function
- | Keep (Temporary p) ->
- D.warn "%s: Found temporary file, ignoring '%s'" __FUN p ;
- Lwt.return_unit
| Keep _ ->
Lwt.return_unit
| Delete p ->
@@ -585,19 +567,31 @@ end = struct
let now = Mtime_clock.now () in
let root = cache_of typ in
let* contents = get_all_contents root in
- let* () =
- contents
- |> List.map (get_fs_action root now)
- |> Lwt_list.iter_p (commit __FUNCTION__)
+ let pending, actions =
+ contents |> List.fold_left_map (get_fs_action root now) []
in
- delete_empty_dirs ~delete_root:false root
+ let* () = Lwt_list.iter_p (commit __FUNCTION__) actions in
+ let* () = delete_empty_dirs ~delete_root:false root in
+ Lwt.return pending
end
let setup typ read write =
- let* () = Setup.retime_cache_contents typ in
- let queue, push = Lwt_bounded_stream.create 2 in
+ let* pending = Setup.retime_cache_contents typ in
+ let capacity = 512 in
+ let queue, push = Lwt_bounded_stream.create capacity in
let lock = Lwt_mutex.create () in
- let q = {queue; push; lock; state= Disengaged} in
+ let state =
+ if pending = [] then
+ Direct
+ else if List.length pending < capacity then
+ let () =
+ List.iter (fun e -> Option.value ~default:() (push (Some e))) pending
+ in
+ Engaged
+ else
+ Disengaged
+ in
+ let q = {queue; push; lock; state} in
Lwt.return
( Writer.with_cache ~direct:(read, write) typ q
, Watcher.watch ~direct:write typ q
diff --git a/ocaml/xapi-guard/lib/types.ml b/ocaml/xapi-guard/lib/types.ml
index 3f2b41c76..ff6dbc1dd 100644
--- a/ocaml/xapi-guard/lib/types.ml
+++ b/ocaml/xapi-guard/lib/types.ml
@@ -28,13 +28,13 @@ module Tpm = struct
let deserialize_key = function
| 0 ->
- Perm
+ Ok Perm
| 1 ->
- Save
+ Ok Save
| 2 ->
- Volatile
+ Ok Volatile
| s ->
- Fmt.invalid_arg "Unknown TPM state key: %i" s
+ Error Printf.(sprintf "Unknown TPM state key: %i" s)
let empty_state = ""
diff --git a/ocaml/xapi-guard/lib/types.mli b/ocaml/xapi-guard/lib/types.mli
index f210ea8c9..06b811ba3 100644
--- a/ocaml/xapi-guard/lib/types.mli
+++ b/ocaml/xapi-guard/lib/types.mli
@@ -17,7 +17,7 @@ module Tpm : sig
(** [key_of_swtpm path] returns a state key represented by [path]. These paths
are parts of the requests generated by SWTPM and may contain slashes *)
- val deserialize_key : int -> key
+ val deserialize_key : int -> (key, string) Result.t
val serialize_key : key -> int
(** [serialize key] returns the state key represented by [key]. *)
diff --git a/ocaml/xapi-guard/test/cache_test.ml b/ocaml/xapi-guard/test/cache_test.ml
index 97b144839..3e51cab2c 100644
--- a/ocaml/xapi-guard/test/cache_test.ml
+++ b/ocaml/xapi-guard/test/cache_test.ml
@@ -12,7 +12,7 @@ module TPMs = struct
let request_persist uuid write =
let __FUN = __FUNCTION__ in
- let key = Tpm.deserialize_key (Random.int 3) in
+ let key = Tpm.deserialize_key (Random.int 3) |> Result.get_ok in
let time = Mtime_clock.now () in
let serial_n = Atomic.fetch_and_add writes_created 1 in
@@ -31,7 +31,7 @@ module TPMs = struct
let request_read uuid read =
let __FUN = __FUNCTION__ in
- let key = Tpm.deserialize_key (Random.int 3) in
+ let key = Tpm.deserialize_key (Random.int 3) |> Result.get_ok in
let time = Mtime_clock.now () in
let serial_n = Atomic.fetch_and_add reads_created 1 in
@@ -200,5 +200,6 @@ let main () =
Lwt.return_unit
let () =
+ Debug.log_to_stdout () ;
setup_log @@ Some Logs.Debug ;
Lwt_main.run (main ())
diff --git a/ocaml/xapi/dune b/ocaml/xapi/dune
index 45d5e67aa..fe161e0dd 100644
--- a/ocaml/xapi/dune
+++ b/ocaml/xapi/dune
@@ -73,6 +73,7 @@
hex
http_lib
ipaddr
+ magic-mime
message-switch-core
message-switch-unix
mirage-crypto
diff --git a/ocaml/xapi/export.ml b/ocaml/xapi/export.ml
index 49ccc7b0c..c549fb742 100644
--- a/ocaml/xapi/export.ml
+++ b/ocaml/xapi/export.ml
@@ -52,7 +52,7 @@ let make_id =
"Ref:" ^ string_of_int this
let rec update_table ~__context ~include_snapshots ~preserve_power_state
- ~include_vhd_parents ~table vm =
+ ~include_vhd_parents ~table ~excluded_devices vm =
let add r =
if not (Hashtbl.mem table (Ref.string_of r)) then
Hashtbl.add table (Ref.string_of r) (make_id ())
@@ -77,6 +77,7 @@ let rec update_table ~__context ~include_snapshots ~preserve_power_state
then (
add vm ;
let vm = Db.VM.get_record ~__context ~self:vm in
+ if not (List.mem Devicetype.VIF excluded_devices) then
List.iter
(fun vif ->
if Db.is_valid_ref __context vif then (
@@ -86,6 +87,7 @@ let rec update_table ~__context ~include_snapshots ~preserve_power_state
)
)
vm.API.vM_VIFs ;
+ if not (List.mem Devicetype.VBD excluded_devices) then
List.iter
(fun vbd ->
if Db.is_valid_ref __context vbd then (
@@ -96,6 +98,7 @@ let rec update_table ~__context ~include_snapshots ~preserve_power_state
)
)
vm.API.vM_VBDs ;
+ if not (List.mem Devicetype.VGPU excluded_devices) then
List.iter
(fun vgpu ->
if Db.is_valid_ref __context vgpu then (
@@ -107,8 +110,7 @@ let rec update_table ~__context ~include_snapshots ~preserve_power_state
)
vm.API.vM_VGPUs ;
(* add all PVS proxies that have a VIF belonging to this VM, add their
- * PVS sites as well
- *)
+ PVS sites as well *)
Db.PVS_proxy.get_all_records ~__context
|> List.filter (fun (_, p) -> List.mem p.API.pVS_proxy_VIF vm.API.vM_VIFs)
|> List.iter (fun (ref, proxy) ->
@@ -118,6 +120,7 @@ let rec update_table ~__context ~include_snapshots ~preserve_power_state
)
) ;
(* add VTPMs that belong to this VM *)
+ if not (List.mem Devicetype.VTPM excluded_devices) then
vm.API.vM_VTPMs
|> List.iter (fun ref -> if Db.is_valid_ref __context ref then add ref) ;
@@ -126,7 +129,7 @@ let rec update_table ~__context ~include_snapshots ~preserve_power_state
List.iter
(fun snap ->
update_table ~__context ~include_snapshots:false ~preserve_power_state
- ~include_vhd_parents ~table snap
+ ~include_vhd_parents ~table ~excluded_devices snap
)
vm.API.vM_snapshots ;
(* If VM is suspended then add the suspend_VDI *)
@@ -145,7 +148,7 @@ let rec update_table ~__context ~include_snapshots ~preserve_power_state
(* Add the parent VM *)
if include_snapshots && Db.is_valid_ref __context vm.API.vM_parent then
update_table ~__context ~include_snapshots:false ~preserve_power_state
- ~include_vhd_parents ~table vm.API.vM_parent
+ ~include_vhd_parents ~table ~excluded_devices vm.API.vM_parent
)
(** Walk the graph of objects and update the table of Ref -> ids for each object we wish
@@ -580,11 +583,11 @@ let make_all ~with_snapshot_metadata ~preserve_power_state table __context =
on metadata-export, include snapshots fields of the exported VM as well as the VM records of VMs
which are snapshots of the exported VM. *)
let vm_metadata ~with_snapshot_metadata ~preserve_power_state
- ~include_vhd_parents ~__context ~vms =
+ ~include_vhd_parents ~__context ~vms ~excluded_devices =
let table = create_table () in
List.iter
(update_table ~__context ~include_snapshots:with_snapshot_metadata
- ~preserve_power_state ~include_vhd_parents ~table
+ ~preserve_power_state ~include_vhd_parents ~table ~excluded_devices
)
vms ;
let objects =
@@ -603,31 +606,31 @@ let string_of_vm ~__context vm =
(** Export a VM's metadata only *)
let export_metadata ~__context ~with_snapshot_metadata ~preserve_power_state
- ~include_vhd_parents ~vms s =
+ ~include_vhd_parents ~vms ~excluded_devices s =
+ let infomsg vm =
+ info
+ "VM.export_metadata: VM = %s; with_snapshot_metadata = '%b'; \
+ include_vhd_parents = '%b'; preserve_power_state = '%s'; \
+ excluded_devices = '%s'"
+ vm with_snapshot_metadata include_vhd_parents
+ (string_of_bool preserve_power_state)
+ (String.concat ", " (List.map Devicetype.to_string excluded_devices))
+ in
+ let now = Date.now () |> Date.to_unix_time |> Int64.of_float in
( match vms with
| [] ->
failwith "need to specify at least one VM"
| [vm] ->
- info
- "VM.export_metadata: VM = %s; with_snapshot_metadata = '%b'; \
- include_vhd_parents = '%b'; preserve_power_state = '%s"
- (string_of_vm ~__context vm)
- with_snapshot_metadata include_vhd_parents
- (string_of_bool preserve_power_state)
+ infomsg (string_of_vm ~__context vm)
| vms ->
- info
- "VM.export_metadata: VM = %s; with_snapshot_metadata = '%b'; \
- preserve_power_state = '%s"
- (String.concat ", " (List.map (string_of_vm ~__context) vms))
- with_snapshot_metadata
- (string_of_bool preserve_power_state)
+ infomsg (String.concat ", " (List.map (string_of_vm ~__context) vms))
) ;
let _, ova_xml =
vm_metadata ~with_snapshot_metadata ~preserve_power_state
- ~include_vhd_parents ~__context ~vms
+ ~include_vhd_parents ~__context ~vms ~excluded_devices
in
let hdr =
- Tar.Header.make Xapi_globs.ova_xml_filename
+ Tar.Header.make ~mod_time:now Xapi_globs.ova_xml_filename
(Int64.of_int @@ String.length ova_xml)
in
Tar_helpers.write_block hdr (fun s -> Unixext.really_write_string s ova_xml) s ;
@@ -635,16 +638,17 @@ let export_metadata ~__context ~with_snapshot_metadata ~preserve_power_state
let export refresh_session __context rpc session_id s vm_ref
preserve_power_state =
+ let now = Date.now () |> Date.to_unix_time |> Int64.of_float in
info "VM.export: VM = %s; preserve_power_state = '%s'"
(string_of_vm ~__context vm_ref)
(string_of_bool preserve_power_state) ;
let table, ova_xml =
vm_metadata ~with_snapshot_metadata:false ~preserve_power_state
- ~include_vhd_parents:false ~__context ~vms:[vm_ref]
+ ~include_vhd_parents:false ~__context ~vms:[vm_ref] ~excluded_devices:[]
in
debug "Outputting ova.xml" ;
let hdr =
- Tar.Header.make Xapi_globs.ova_xml_filename
+ Tar.Header.make ~mod_time:now Xapi_globs.ova_xml_filename
(Int64.of_int @@ String.length ova_xml)
in
Tar_helpers.write_block hdr (fun s -> Unixext.really_write_string s ova_xml) s ;
@@ -716,35 +720,43 @@ let vm_from_request ~__context (req : Request.t) =
Client.VM.get_by_uuid ~rpc ~session_id ~uuid
)
-let bool_from_request ~__context (req : Request.t) default k =
- if List.mem_assoc k req.Request.query then
- bool_of_string (List.assoc k req.Request.query)
- else
- default
+let arg_from_request (req : Request.t) k = List.assoc_opt k req.Request.query
+
+let bool_from_request req default k =
+ arg_from_request req k |> Option.fold ~none:default ~some:bool_of_string
+
+let devicetypelist_from_request req default k =
+ let to_list = function
+ | "" ->
+ []
+ | x ->
+ String.split_on_char ',' x |> List.map Devicetype.of_string
+ in
+ arg_from_request req k |> Option.fold ~none:default ~some:to_list
+
+let export_all_vms_from_request req = bool_from_request req false "all"
-let export_all_vms_from_request ~__context (req : Request.t) =
- bool_from_request ~__context req false "all"
+let include_vhd_parents_from_request req =
+ bool_from_request req false "include_vhd_parents"
-let include_vhd_parents_from_request ~__context (req : Request.t) =
- bool_from_request ~__context req false "include_vhd_parents"
+let export_snapshots_from_request req =
+ bool_from_request req true "export_snapshots"
-let export_snapshots_from_request ~__context (req : Request.t) =
- bool_from_request ~__context req true "export_snapshots"
+let include_dom0_from_request req = bool_from_request req true "include_dom0"
-let include_dom0_from_request ~__context (req : Request.t) =
- bool_from_request ~__context req true "include_dom0"
+let excluded_devices_from_request req =
+ devicetypelist_from_request req [] "excluded_device_types"
let metadata_handler (req : Request.t) s _ =
debug "metadata_handler called" ;
req.Request.close <- true ;
(* Xapi_http.with_context always completes the task at the end *)
Xapi_http.with_context "VM.export_metadata" req s (fun __context ->
- let include_vhd_parents =
- include_vhd_parents_from_request ~__context req
- in
- let export_all = export_all_vms_from_request ~__context req in
- let export_snapshots = export_snapshots_from_request ~__context req in
- let include_dom0 = include_dom0_from_request ~__context req in
+ let include_vhd_parents = include_vhd_parents_from_request req in
+ let export_all = export_all_vms_from_request req in
+ let export_snapshots = export_snapshots_from_request req in
+ let include_dom0 = include_dom0_from_request req in
+ let excluded_devices = excluded_devices_from_request req in
(* Get the VM refs. In case of exporting the metadata of a particular VM, return a singleton list containing the vm ref. *)
(* In case of exporting all the VMs metadata, get all the VM records which are not default templates. *)
let vm_refs =
@@ -771,16 +783,6 @@ let metadata_handler (req : Request.t) s _ =
else
[vm_from_request ~__context req]
in
- if
- (not export_all)
- && Db.VM.get_is_a_snapshot ~__context ~self:(List.hd vm_refs)
- then
- raise
- (Api_errors.Server_error
- ( Api_errors.operation_not_allowed
- , ["Exporting metadata of a snapshot is not allowed"]
- )
- ) ;
let task_id = Ref.string_of (Context.get_task_id __context) in
let read_fd, write_fd = Unix.pipe () in
let export_error = ref None in
@@ -800,7 +802,7 @@ let metadata_handler (req : Request.t) s _ =
vm_refs ;
export_metadata ~with_snapshot_metadata:export_snapshots
~preserve_power_state:true ~include_vhd_parents
- ~__context ~vms:vm_refs write_fd
+ ~excluded_devices ~__context ~vms:vm_refs write_fd
)
(fun () ->
Unix.close write_fd ;
diff --git a/ocaml/xapi/fileserver.ml b/ocaml/xapi/fileserver.ml
index 1c4cf9520..ed9ed334d 100644
--- a/ocaml/xapi/fileserver.ml
+++ b/ocaml/xapi/fileserver.ml
@@ -42,40 +42,8 @@ let missing uri =
^ " was not found on this server.</p> <hr><address>Xapi \
Server</address></body></html>"
-let get_extension filename =
- try
- let basename = Filename.basename filename in
- let i = String.rindex basename '.' in
- Some (String.sub basename (i + 1) (String.length basename - i - 1))
- with _ -> None
-
-let application_octet_stream = "application/octet-stream"
-
-let mime_of_extension = function
- | "html" | "htm" ->
- "text/html"
- | "css" ->
- "text/css"
- | "js" ->
- "application/javascript"
- | "gif" ->
- "image/gif"
- | "png" ->
- "image/png"
- | "jpg" | "jpeg" ->
- "image/jpeg"
- | "xml" ->
- "application/xml"
- | "rpm" ->
- "application/x-rpm"
- | _ ->
- application_octet_stream
-
let response_file s file_path =
- let mime_content_type =
- let ext = Option.map String.lowercase_ascii (get_extension file_path) in
- Option.fold ~none:application_octet_stream ~some:mime_of_extension ext
- in
+ let mime_content_type = Magic_mime.lookup file_path in
let hsts_time = !Xapi_globs.hsts_max_age in
Http_svr.response_file ~mime_content_type ~hsts_time s file_path
diff --git a/ocaml/xapi/import.ml b/ocaml/xapi/import.ml
index fd6d898b1..01e5ca256 100644
--- a/ocaml/xapi/import.ml
+++ b/ocaml/xapi/import.ml
@@ -2158,12 +2158,19 @@ let complete_import ~__context vmrefs =
Xapi_vm_lifecycle.update_allowed_operations ~__context ~self:vm
)
vmrefs ;
- (* We only keep VMs which are not snapshot *)
+ (* When only snapshots have been imported, return all of them.
+ Otherwise, only keep VMs which are not snapshots *)
let vmrefs =
+ let non_snapshots =
List.filter
- (fun vmref -> not (Db.VM.get_is_a_snapshot ~__context ~self:vmref))
+ (fun x -> not (Db.VM.get_is_a_snapshot ~__context ~self:x))
vmrefs
in
+ if non_snapshots = [] then
+ vmrefs
+ else
+ non_snapshots
+ in
(* We only set the result on the task since it is officially completed later. *)
TaskHelper.set_result ~__context (Some (API.rpc_of_ref_VM_set vmrefs))
with e ->
diff --git a/ocaml/xapi/importexport.ml b/ocaml/xapi/importexport.ml
index a7354fce4..f90a8da80 100644
--- a/ocaml/xapi/importexport.ml
+++ b/ocaml/xapi/importexport.ml
@@ -469,6 +469,37 @@ module Format = struct
(* default *)
end
+module Devicetype = struct
+ type t = VIF | VBD | VGPU | VTPM
+
+ let all = [VIF; VBD; VGPU; VTPM]
+
+ let to_string = function
+ | VIF ->
+ "vif"
+ | VBD ->
+ "vbd"
+ | VGPU ->
+ "vgpu"
+ | VTPM ->
+ "vtpm"
+
+ let of_string x =
+ match String.lowercase_ascii x with
+ | "vif" ->
+ VIF
+ | "vbd" ->
+ VBD
+ | "vgpu" ->
+ VGPU
+ | "vtpm" ->
+ VTPM
+ | other ->
+ let fail fmt = Printf.kprintf failwith fmt in
+ fail "%s: Type '%s' not one of [%s]" __FUNCTION__ other
+ (String.concat "; " (List.map to_string all))
+end
+
let return_302_redirect (req : Http.Request.t) s address =
let address = Http.Url.maybe_wrap_IPv6_literal address in
let url =
diff --git a/ocaml/xapi/livepatch.ml b/ocaml/xapi/livepatch.ml
index 0dc386933..63afa9a2c 100644
--- a/ocaml/xapi/livepatch.ml
+++ b/ocaml/xapi/livepatch.ml
@@ -187,16 +187,19 @@ module KernelLivePatch = struct
end
module XenLivePatch = struct
- let get_regexp status =
- Re.Posix.compile_pat
- (Printf.sprintf {|^[ ]*lp_([^- ]+)-([^- ]+)-([^- ]+)-([^- ]+).+%s.*$|}
- status
- )
+ let drop x = Astring.Char.Ascii.(is_control x || is_white x)
- let get_livepatches pattern s =
+ let get_livepatches state s =
+ let pattern =
+ Re.Posix.compile_pat {|^lp_([^- ]+)-([^- ]+)-([^- ]+)-([^- ]+)$|}
+ in
Astring.String.cuts ~sep:"\n" s
|> List.filter_map (fun line ->
- match Re.exec_opt pattern line with
+ Astring.String.cuts ~sep:"|" line
+ |> List.map (Astring.String.trim ~drop)
+ |> function
+ | name :: state' :: _ when state' = state -> (
+ match Re.exec_opt pattern name with
| Some groups ->
let base_version = Re.Group.get groups 1 in
let base_release = Re.Group.get groups 2 in
@@ -206,10 +209,12 @@ module XenLivePatch = struct
| None ->
None
)
+ | _ ->
+ None
+ )
let get_running_livepatch' s =
- let r = get_regexp "APPLIED" in
- get_livepatches r s |> get_latest_livepatch
+ get_livepatches "APPLIED" s |> get_latest_livepatch
let get_running_livepatch () =
Helpers.call_script !Xapi_globs.xen_livepatch_cmd ["list"]
@@ -217,13 +222,9 @@ module XenLivePatch = struct
let get_checked_livepatches () =
Helpers.call_script !Xapi_globs.xen_livepatch_cmd ["list"]
- |> get_livepatches (get_regexp "CHECKED")
+ |> get_livepatches "CHECKED"
let get_base_build_id () =
- let drop x =
- let open Astring.Char.Ascii in
- is_control x || is_blank x || is_white x
- in
Helpers.call_script !Xapi_globs.xl_cmd ["info"; "build_id"]
|> Astring.String.trim ~drop
|> function
diff --git a/ocaml/xapi/sm.ml b/ocaml/xapi/sm.ml
index 2526aa79b..0ae899f63 100644
--- a/ocaml/xapi/sm.ml
+++ b/ocaml/xapi/sm.ml
@@ -152,7 +152,7 @@ let sr_update ~dbg dconf driver sr =
let call = Sm_exec.make_call ~sr_ref:sr dconf "sr_update" [] in
Sm_exec.parse_unit (Sm_exec.exec_xmlrpc ~dbg (driver_filename driver) call)
-let vdi_create ~dbg dconf driver sr sm_config vdi_type size name_label
+let vdi_create ~dbg ?vdi_uuid dconf driver sr sm_config vdi_type size name_label
name_description metadata_of_pool is_a_snapshot snapshot_time snapshot_of
read_only =
with_dbg ~dbg ~name:"vdi_create" @@ fun di ->
@@ -164,8 +164,8 @@ let vdi_create ~dbg dconf driver sr sm_config vdi_type size name_label
) ;
srmaster_only dconf ;
let call =
- Sm_exec.make_call ~sr_ref:sr ~vdi_sm_config:sm_config ~vdi_type dconf
- "vdi_create"
+ Sm_exec.make_call ?vdi_uuid ~sr_ref:sr ~vdi_sm_config:sm_config ~vdi_type
+ dconf "vdi_create"
[
sprintf "%Lu" size
; name_label
diff --git a/ocaml/xapi/sm_exec.ml b/ocaml/xapi/sm_exec.ml
index a6d0d231e..a55b61d72 100644
--- a/ocaml/xapi/sm_exec.ml
+++ b/ocaml/xapi/sm_exec.ml
@@ -69,8 +69,8 @@ type call = {
}
let make_call ?driver_params ?sr_sm_config ?vdi_sm_config ?vdi_type
- ?vdi_location ?new_uuid ?sr_ref ?vdi_ref (subtask_of, device_config) cmd
- args =
+ ?vdi_location ?new_uuid ?sr_ref ?vdi_ref ?vdi_uuid
+ (subtask_of, device_config) cmd args =
Server_helpers.exec_with_new_task "sm_exec" (fun __context ->
(* Only allow a subset of calls if the SR has been introduced by a DR task. *)
Option.iter
@@ -117,7 +117,22 @@ let make_call ?driver_params ?sr_sm_config ?vdi_sm_config ?vdi_type
Option.map (fun self -> Db.VDI.get_location ~__context ~self) vdi_ref
in
let vdi_uuid =
- Option.map (fun self -> Db.VDI.get_uuid ~__context ~self) vdi_ref
+ match (cmd, vdi_ref, vdi_uuid) with
+ | "vdi_create", None, (Some x as uuid) ->
+ debug "%s: cmd=%s vdi_uuid=%s" __FUNCTION__ cmd x ;
+ uuid
+ (* when creating a VDI we sometimes want to provide the UUID
+ rather than letting the backend pick one. This is to
+ support backup VDIs CP-46179. So in that case, use the
+ provided UUID but not for other commands *)
+ | _, None, Some uuid ->
+ warn "%s: cmd=%s vdi_uuid=%s - should not happen" __FUNCTION__ cmd
+ uuid ;
+ None
+ | _, Some self, _ ->
+ Db.VDI.get_uuid ~__context ~self |> Option.some
+ | _, None, None ->
+ None
in
let vdi_on_boot =
Option.map
diff --git a/ocaml/xapi/storage_smapiv1.ml b/ocaml/xapi/storage_smapiv1.ml
index 9ca3660ee..c7bdd772a 100644
--- a/ocaml/xapi/storage_smapiv1.ml
+++ b/ocaml/xapi/storage_smapiv1.ml
@@ -691,19 +691,33 @@ module SMAPIv1 : Server_impl = struct
let uuid = require_uuid vi in
vdi_info_from_db ~__context (Db.VDI.get_by_uuid ~__context ~uuid)
- let create _context ~dbg ~sr ~vdi_info =
+ let create _context ~dbg ~sr ~(vdi_info : Storage_interface.vdi_info) =
with_dbg ~name:"VDI.create" ~dbg @@ fun di ->
let dbg = Debuginfo.to_string di in
try
Server_helpers.exec_with_new_task "VDI.create"
~subtask_of:(Ref.of_string dbg) (fun __context ->
- let sr = Db.SR.get_by_uuid ~__context ~uuid:(s_of_sr sr) in
+ let sr_uuid = s_of_sr sr in
+ let sr = Db.SR.get_by_uuid ~__context ~uuid:sr_uuid in
let vi =
+ (* we want to set vdi_uuid when creating a backup VDI with
+ a specific UUID. SM picks up vdi_uuid instead of creating
+ a new random UUID; Cf. Xapi_vdi.create *)
+ let vdi_uuid =
+ match vdi_info.uuid with
+ | Some uuid when uuid = Uuidx.(Hash.string sr_uuid |> to_string)
+ ->
+ info "%s: creating a backup VDI %s" __FUNCTION__ uuid ;
+ vdi_info.uuid
+ | _ ->
+ None
+ in
Sm.call_sm_functions ~__context ~sR:sr (fun device_config _type ->
- Sm.vdi_create ~dbg device_config _type sr vdi_info.sm_config
- vdi_info.ty vdi_info.virtual_size vdi_info.name_label
- vdi_info.name_description vdi_info.metadata_of_pool
- vdi_info.is_a_snapshot vdi_info.snapshot_time
+ Sm.vdi_create ~dbg ?vdi_uuid device_config _type sr
+ vdi_info.sm_config vdi_info.ty vdi_info.virtual_size
+ vdi_info.name_label vdi_info.name_description
+ vdi_info.metadata_of_pool vdi_info.is_a_snapshot
+ vdi_info.snapshot_time
(s_of_vdi vdi_info.snapshot_of)
vdi_info.read_only
)
diff --git a/ocaml/xapi/stream_vdi.ml b/ocaml/xapi/stream_vdi.ml
index 64b1da93e..3c27d158a 100644
--- a/ocaml/xapi/stream_vdi.ml
+++ b/ocaml/xapi/stream_vdi.ml
@@ -163,6 +163,31 @@ let get_nbd_device path =
else
None
+(* Copied from vhd-tool/src/image.ml.
+ * Just keep the situation of xapi doesn't depend on vhd-tool OCaml module.
+ *)
+let image_behind_nbd_device = function
+ | Some (path, _exportname) as image ->
+ (* The nbd server path exposed by tapdisk can lead us to the actual image
+ file below. Following the symlink gives a path like
+ `/run/blktap-control/nbd<pid>.<minor>`,
+ containing the tapdisk pid and minor number. Using this information,
+ we can get the file path from tap-ctl.
+ *)
+ let default _ _ = image in
+ let filename = Unix.realpath path |> Filename.basename in
+ Scanf.ksscanf filename default "nbd%d.%d" (fun pid minor ->
+ match Tapctl.find (Tapctl.create ()) ~pid ~minor with
+ | _, _, Some ("vhd", vhd) ->
+ Some ("vhd", vhd)
+ | _, _, Some ("aio", vhd) ->
+ Some ("raw", vhd)
+ | _, _, _ | (exception _) ->
+ None
+ )
+ | _ ->
+ None
+
type extent = {flags: int32; length: int64} [@@deriving rpc]
type extent_list = extent list [@@deriving rpc]
diff --git a/ocaml/xapi/vhd_tool_wrapper.ml b/ocaml/xapi/vhd_tool_wrapper.ml
index 7e22dc865..6fe4e40d7 100644
--- a/ocaml/xapi/vhd_tool_wrapper.ml
+++ b/ocaml/xapi/vhd_tool_wrapper.ml
@@ -170,9 +170,16 @@ let vhd_of_device path =
| _, _, _ ->
raise Not_found
with
- | Tapctl.Not_blktap ->
+ | Tapctl.Not_blktap -> (
debug "Device %s is not controlled by blktap" path ;
+ (* Check if it is a VHD behind a NBD deivce *)
+ Stream_vdi.(get_nbd_device path |> image_behind_nbd_device) |> function
+ | Some ("vhd", vhd) ->
+ debug "%s is a VHD behind NBD device %s" vhd path ;
+ Some vhd
+ | _ ->
None
+ )
| Tapctl.Not_a_device ->
debug "%s is not a device" path ;
None
@@ -186,15 +193,18 @@ let send progress_cb ?relative_to (protocol : string) (dest_format : string)
(s : Unix.file_descr) (path : string) (size : Int64.t) (prefix : string) =
let s' = Uuidx.(to_string (make ())) in
let source_format, source =
- match (Stream_vdi.get_nbd_device path, vhd_of_device path) with
- | Some (nbd_server, exportname), _ ->
+ match (Stream_vdi.get_nbd_device path, vhd_of_device path, relative_to) with
+ | Some (nbd_server, exportname), _, None ->
( "nbdhybrid"
, Printf.sprintf "%s:%s:%s:%Ld" path nbd_server exportname size
)
- | None, Some vhd ->
+ | Some _, Some vhd, Some _ | None, Some vhd, _ ->
("hybrid", path ^ ":" ^ vhd)
- | None, None ->
+ | None, None, None ->
("raw", path)
+ | _, None, Some _ ->
+ let msg = "Cannot compute differences on non-VHD images" in
+ error "%s" msg ; failwith msg
in
let relative_to =
match relative_to with
diff --git a/ocaml/xapi/xapi_dr.ml b/ocaml/xapi/xapi_dr.ml
index e9c1c53ad..bdbb4dee6 100644
--- a/ocaml/xapi/xapi_dr.ml
+++ b/ocaml/xapi/xapi_dr.ml
@@ -245,6 +245,7 @@ let create_import_objects ~__context ~vms =
List.iter
(Export.update_table ~__context ~include_snapshots:true
~preserve_power_state:true ~include_vhd_parents:false ~table
+ ~excluded_devices:[]
)
vms ;
Export.make_all ~with_snapshot_metadata:true ~preserve_power_state:true table
diff --git a/ocaml/xapi/xapi_session.ml b/ocaml/xapi/xapi_session.ml
index 455dcef9c..221498d6f 100644
--- a/ocaml/xapi/xapi_session.ml
+++ b/ocaml/xapi/xapi_session.ml
@@ -1149,8 +1149,8 @@ let change_password ~__context ~old_pwd ~new_pwd =
try
(* CP-696: only change password if session has is_local_superuser bit set *)
(*
- CA-13567: If you have root priviledges then we do not authenticate old_pwd; right now, since we only
- ever have root priviledges we just comment this out.
+ CA-13567: If you have root privileges then we do not authenticate old_pwd; right now, since we only
+ ever have root privileges we just comment this out.
begin
try
diff --git a/ocaml/xapi/xapi_vdi.ml b/ocaml/xapi/xapi_vdi.ml
index ac989551b..bc7bafb23 100644
--- a/ocaml/xapi/xapi_vdi.ml
+++ b/ocaml/xapi/xapi_vdi.ml
@@ -625,13 +625,27 @@ let create ~__context ~name_label ~name_description ~sR ~virtual_size ~_type
| `cbt_metadata ->
"cbt_metadata"
in
+ (* special case: we want to use a specific UUID for Pool Meta Data
+ Backup *)
+ let uuid_ =
+ match (_type, name_label) with
+ | `user, "Pool Metadata Backup" ->
+ let sr = Db.SR.get_uuid ~__context ~self:sR in
+ let uuid = Uuidx.(Hash.string sr |> to_string) in
+ info "%s: using deterministic UUID for '%s' VDI: %s" __FUNCTION__
+ name_label uuid ;
+ Some uuid
+ | _ ->
+ None
+ in
let open Storage_access in
let task = Context.get_task_id __context in
let open Storage_interface in
let vdi_info =
{
Storage_interface.default_vdi_info with
- name_label
+ uuid= uuid_
+ ; name_label
; name_description
; ty= vdi_type
; read_only
diff --git a/ocaml/xapi/xapi_vm_lifecycle.ml b/ocaml/xapi/xapi_vm_lifecycle.ml
index d90da3961..7d35a12f1 100644
--- a/ocaml/xapi/xapi_vm_lifecycle.ml
+++ b/ocaml/xapi/xapi_vm_lifecycle.ml
@@ -790,6 +790,7 @@ let update_allowed_operations ~__context ~self =
; `changing_dynamic_range
; `changing_NVRAM
; `create_vtpm
+ ; `metadata_export
]
in
(* FIXME: need to be able to deal with rolling-upgrade for orlando as well *)
diff --git a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml
index 4f696085d..3eb708d7a 100644
--- a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml
+++ b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml
@@ -361,9 +361,11 @@ let dss_loadavg () =
)
]
-let count_running_domain domains =
+let count_power_state_running_domains domains =
List.fold_left
- (fun count (dom, _, _) -> if dom.Xenctrl.running then count + 1 else count)
+ (fun count (dom, _, _) ->
+ if not dom.Xenctrl.paused then count + 1 else count
+ )
0 domains
let dss_hostload xc domains =
@@ -386,7 +388,7 @@ let dss_hostload xc domains =
)
0 domains
in
- let running_domains = count_running_domain domains in
+ let running_domains = count_power_state_running_domains domains in
let load_per_cpu = float_of_int load /. float_of_int pcpus in
[
diff --git a/quality-gate.sh b/quality-gate.sh
index 77238f4ab..56e53e75b 100755
--- a/quality-gate.sh
+++ b/quality-gate.sh
@@ -3,7 +3,7 @@
set -e
list-hd () {
- N=318
+ N=315
LIST_HD=$(git grep -r --count 'List.hd' -- **/*.ml | cut -d ':' -f 2 | paste -sd+ - | bc)
if [ "$LIST_HD" -eq "$N" ]; then
echo "OK counted $LIST_HD List.hd usages"
diff --git a/scripts/plugins/perfmon b/scripts/plugins/perfmon
index 2186c9389..e3dc24526 100644
--- a/scripts/plugins/perfmon
+++ b/scripts/plugins/perfmon
@@ -14,16 +14,17 @@ def send_perfmon_cmd(cmd):
"Return True for success, or ERROR_%d: <msg> otherwise"
if len(cmd) >= cmdmaxlen:
return "ERROR_0: command too long"
+ cmd_bytes = cmd.encode()
try:
sock = socket.socket(socket.AF_UNIX, socket.SOCK_DGRAM)
- rc = sock.sendto(cmd, cmdsockname)
+ rc = sock.sendto(cmd_bytes, cmdsockname)
except socket.error as e:
err, msg = e.args
return "ERROR_%d: %s" % (err, msg)
except Exception:
return "ERROR_1: unknown error"
- return str(rc == len(cmd))
+ return str(rc == len(cmd_bytes))
def stop(session, args):
diff --git a/scripts/varstored-guard.service b/scripts/varstored-guard.service
index 59e45110f..c9d1b9bd9 100644
--- a/scripts/varstored-guard.service
+++ b/scripts/varstored-guard.service
@@ -2,7 +2,7 @@
Description=Varstored XAPI socket deprivileging daemon
Documentation=man:varstored-guard(1)
After=message-switch.service syslog.target
-Before=xenopsd.service
+Before=xapi-domains.service xenopsd.service
Wants=message-switch.service syslog.target
[Service]
diff --git a/scripts/xe-backup-metadata b/scripts/xe-backup-metadata
index 4aa09b7f7..47b21108b 100755
--- a/scripts/xe-backup-metadata
+++ b/scripts/xe-backup-metadata
@@ -39,6 +39,7 @@ function usage {
echo " -k: Number of older backups to preserve (default: ${history_kept})"
echo " -n: Just try to find a backup VDI and stop the script after that"
echo " -f Force backup even when less than 10% free capacity is left on the backup VDI"
+ echo " -y: Assume non-interactive mode and yes to all questions"
echo " -v: Verbose output"
echo
echo
@@ -48,10 +49,33 @@ function usage {
exit 1
}
+function uuid5 {
+ # could use a modern uuidgen but it's not on XS 8
+ # should work with Python 2 and 3
+ python -c "import uuid; print (uuid.uuid5(uuid.UUID('$1'), '$2'))"
+}
+
+function validate_vdi_uuid {
+ # we check that vdi has the expected UUID which depends on the UUID of
+ # the SR. This is a deterministic hash of the SR UUID and the
+ # namespace UUID $NS. This UUID must match what Xapi's Uuidx module is using.
+ local NS="e93e0639-2bdb-4a59-8b46-352b3f408c19"
+ local sr="$1"
+ local vdi="$2"
+ local uuid
+
+ uuid=$(uuid5 "$NS" "$sr")
+ if [ "$vdi" != "$uuid" ]; then
+ return 1
+ else
+ return 0
+ fi
+}
+
function test_sr {
sr_uuid_found=$(${XE} sr-list uuid="$1" --minimal)
if [ "${sr_uuid_found}" != "$1" ]; then
- echo Invalid SR UUID specified: $1
+ echo "Invalid SR UUID specified: $1"
usage
fi
}
@@ -63,7 +87,8 @@ just_find_vdi=0
fs_uninitialised=0
usage_alert=90
force_backup=0
-while getopts "hvink:u:dcf" opt ; do
+yes=0
+while getopts "yhvink:u:dcf" opt ; do
case $opt in
h) usage ;;
c) create_vdi=1 ; fs_uninitialised=1 ;;
@@ -73,6 +98,7 @@ while getopts "hvink:u:dcf" opt ; do
d) leave_mounted=1 ;;
n) just_find_vdi=1 ;;
v) debug="" ;;
+ y) yes=1 ;;
f) force_backup=1 ;;
*) echo "Invalid option"; usage ;;
esac
@@ -89,32 +115,32 @@ fi
# determine if the SR UUID is vaid
if [ -z "${sr_uuid}" ]; then
# use the default-SR from the pool
- sr_uuid=$(${XE} pool-param-get uuid=${pool_uuid} param-name=default-SR)
+ sr_uuid=$(${XE} pool-param-get uuid="${pool_uuid}" param-name=default-SR)
fi
test_sr "${sr_uuid}"
-sr_name=$(${XE} sr-param-get uuid=${sr_uuid} param-name=name-label)
+sr_name=$(${XE} sr-param-get uuid="${sr_uuid}" param-name=name-label)
# see if a backup VDI already exists on the selected SR
-vdi_uuid=$(${XE} vdi-list other-config:ctxs-pool-backup=true sr-uuid=${sr_uuid} params=uuid --minimal)
+vdi_uuid=$(${XE} vdi-list other-config:ctxs-pool-backup=true sr-uuid="${sr_uuid}" params=uuid --minimal)
mnt=
function cleanup {
trap "" TERM INT
cd /
if [ ! -z "${mnt}" ]; then
- umount ${mnt} >/dev/null 2>&1
- rmdir ${mnt}
+ umount "${mnt}" >/dev/null 2>&1
+ rmdir "${mnt}"
fi
if [ ! -z "${vbd_uuid}" ]; then
${debug} echo -n "Unplugging VBD: "
- ${XE} vbd-unplug uuid=${vbd_uuid} timeout=20
+ ${XE} vbd-unplug uuid="${vbd_uuid}" timeout=20
# poll for the device to go away if we know its name
if [ "${device}" != "" ]; then
device_gone=0
for ((i=0; i<10; i++)); do
${debug} echo -n "."
- if [ ! -b ${device} ]; then
+ if [ ! -b "${device}" ]; then
${debug} echo " done"
device_gone=1
break
@@ -123,22 +149,35 @@ function cleanup {
done
if [ ${device_gone} -eq 0 ]; then
${debug} echo " failed"
- echo Please destroy VBD ${vbd_uuid} manually.
+ echo "Please destroy VBD ${vbd_uuid} manually."
else
- ${XE} vbd-destroy uuid=${vbd_uuid}
+ ${XE} vbd-destroy uuid="${vbd_uuid}"
fi
fi
fi
if [ ${fs_uninitialised} -eq 1 -a -n "${vdi_uuid}" ] ; then
- ${XE} vdi-destroy uuid=${vdi_uuid}
+ ${XE} vdi-destroy uuid="${vdi_uuid}"
fi
}
-echo Using SR: ${sr_name}
+# if we can't validate the UUID of the VDI, prompt the user
+if [ -n "${vdi_uuid}" ]; then
+ if ! validate_vdi_uuid "${sr_uuid}" "${vdi_uuid}" && [ "$yes" -eq 0 ]; then
+ echo "Backup VDI $vdi_uuid was most likley create by an earlier"
+ echo "version of this code. Make sure this is a VDI that you"
+ echo "created as we can't validate it without mounting it."
+ read -p "Continue? [Y/N]" -n 1 -r; echo
+ if [[ ! $REPLY =~ ^[Yy]$ ]]; then exit 1; fi
+ fi
+fi
+
+echo "Using SR: ${sr_name}"
if [ -z "${vdi_uuid}" ]; then
if [ "${create_vdi}" -gt 0 ]; then
echo -n "Creating new backup VDI: "
- vdi_uuid=$(${XE} vdi-create virtual-size=500MiB sr-uuid=${sr_uuid} type=user name-label="Pool Metadata Backup")
+ label="Pool Metadata Backup"
+ # the label must match what xapi_vdi.ml is using for backup VDIs
+ vdi_uuid=$(${XE} vdi-create virtual-size=500MiB sr-uuid="${sr_uuid}" type=user name-label="${label}")
init_fs=1
if [ $? -ne 0 ]; then
echo failed
@@ -148,8 +187,8 @@ if [ -z "${vdi_uuid}" ]; then
echo "Backup VDI not found, aborting. You can initialise one using the '-c' flag."
exit 3
fi
- echo ${vdi_uuid}
- ${XE} vdi-param-set uuid=${vdi_uuid} other-config:ctxs-pool-backup=true
+ echo "${vdi_uuid}"
+ ${XE} vdi-param-set uuid="${vdi_uuid}" other-config:ctxs-pool-backup=true
else
${debug} echo "Using existing backup VDI: ${vdi_uuid}"
fs_uninitialised=0
@@ -160,110 +199,110 @@ if [ ${just_find_vdi} -gt 0 ]; then
fi
${debug} echo -n "Creating VBD: "
-vbd_uuid=$(${XE} vbd-create vm-uuid=${CONTROL_DOMAIN_UUID} vdi-uuid=${vdi_uuid} device=autodetect)
-${debug} echo ${vbd_uuid}
+vbd_uuid=$(${XE} vbd-create vm-uuid="${CONTROL_DOMAIN_UUID}" vdi-uuid="${vdi_uuid}" device=autodetect)
+${debug} echo "${vbd_uuid}"
if [ $? -ne 0 -o -z "${vbd_uuid}" ]; then
- echo error creating VBD
+ echo "error creating VBD"
cleanup
exit 1
fi
${debug} echo -n "Plugging VBD: "
-${XE} vbd-plug uuid=${vbd_uuid}
-device=/dev/$(${XE} vbd-param-get uuid=${vbd_uuid} param-name=device)
+${XE} vbd-plug uuid="${vbd_uuid}"
+device=/dev/$(${XE} vbd-param-get uuid="${vbd_uuid}" param-name=device)
-if [ ! -b ${device} ]; then
- ${debug} echo ${device}: not a block special
+if [ ! -b "${device}" ]; then
+ ${debug} echo "${device}: not a block special"
cleanup
exit 1
fi
-${debug} echo ${device}
+${debug} echo "${device}"
-if [ $init_fs -eq 1 ]; then
+if [ "$init_fs" -eq 1 ]; then
${debug} echo -n "Creating filesystem: "
- mkfs.ext3 -j -F ${device} > /dev/null 2>&1
+ mkfs.ext3 -j -F "${device}" > /dev/null 2>&1
${debug} echo "done"
fs_uninitialised=0
fi
${debug} echo -n "Mounting filesystem: "
-mnt=/var/run/pool-backup-${vdi_uuid}
-mkdir -p ${mnt}
+mnt="/var/run/pool-backup-${vdi_uuid}"
+mkdir -p "${mnt}"
-/sbin/fsck -a ${device} >/dev/null 2>&1
+/sbin/fsck -a "${device}" >/dev/null 2>&1
if [ $? -ne 0 ]; then
${debug} fsck failed. Please correct manually
cleanup
exit 1
fi
-mount ${device} ${mnt} > /dev/null 2>&1
+mount "${device}" "${mnt}" > /dev/null 2>&1
if [ $? -ne 0 ]; then
${debug} echo failed
cleanup
exit 1
fi
-${debug} echo ${mnt}
+${debug} echo "${mnt}"
if [ ${leave_mounted} -eq 0 ]; then
- lrconf=${mnt}/conf/${vdi_uuid}
- if [ ! -f ${lrconf} ]; then
+ lrconf="${mnt}/conf/${vdi_uuid}"
+ if [ ! -f "${lrconf}" ]; then
${debug} echo -n "Initialising rotation: "
- mkdir -p ${mnt}/conf/
- echo "${mnt}/${pool_uuid}.db {" >> ${lrconf}
- echo " rotate ${history_kept}" >> ${lrconf}
- echo " missingok" >> ${lrconf}
- echo "}" >> ${lrconf}
- echo done
- echo ${metadata_version} >> ${mnt}/.ctxs-metadata-backup
+ mkdir -p "${mnt}/conf/"
+ echo "${mnt}/${pool_uuid}.db {" >> "${lrconf}"
+ echo " rotate ${history_kept}" >> "${lrconf}"
+ echo " missingok" >> "${lrconf}"
+ echo "}" >> "${lrconf}"
+ echo "done"
+ echo "${metadata_version}" >> "${mnt}/.ctxs-metadata-backup"
fi
# check the usage of the backup VDI
- usage=`cd ${mnt} && df . | sed -n "2p" | awk '{ print $5 }' | tr -d '%'`
+ usage=`cd "${mnt}" && df . | sed -n "2p" | awk '{ print $5 }' | tr -d '%'`
echo "Checking backup VDI space usage: $usage%"
- if [ $usage -gt $usage_alert ] && [ ${force_backup} -eq 0 ]; then
- echo "Running out of space, you can use "-d" option to attach VDI and free more space, exit now."
+ if [ "$usage" -gt "$usage_alert" ] && [ "${force_backup}" -eq 0 ]; then
+ echo "Running out of space, you can use '-d' option to attach VDI and free more space, exit now."
cleanup
exit 1
fi
# invoke logrotate to rotate over old pool db backups
echo -n "Rotating old backups: "
- logrotate -f ${lrconf}
- num_found=$(find ${mnt} -name \*.db\.* | wc -l)
- echo found ${num_found}
+ logrotate -f "${lrconf}"
+ num_found=$(find "${mnt}" -name '*.db.*' | wc -l)
+ echo "found ${num_found}"
# perform the pool database dump
echo -n "Backing up pool database: "
- ${XE} pool-dump-database file-name=${mnt}/${pool_uuid}.db
+ ${XE} pool-dump-database file-name="${mnt}/${pool_uuid}.db"
echo done
# backup the VM metadata for each VM in the pool into a dated directory
datetime=$(date +%F-%H-%M-%S)
- metadir=${mnt}/metadata/${datetime}
- mkdir -p ${metadir}
+ metadir="${mnt}/metadata/${datetime}"
+ mkdir -p "${metadir}"
echo -n "Cleaning old VM metadata: "
IFS=" "
- todelete=$(cd ${mnt}/metadata && ls -1 |sort -n | head -n -${history_kept} | xargs echo)
+ todelete=$(cd "${mnt}/metadata" && ls -1 |sort -n | head -n -${history_kept} | xargs echo)
for dir in ${todelete}; do
- rm -rf ${mnt}/metadata/${dir}
+ rm -rf "${mnt}/metadata/${dir}"
done
echo done
IFS=","
echo -n "Backing up SR metadata: "
- mkdir -p ${metadir}
- "@LIBEXECDIR@/backup-sr-metadata.py" -f ${metadir}/SRMETA.xml
+ mkdir -p "${metadir}"
+ "@LIBEXECDIR@/backup-sr-metadata.py" -f "${metadir}/SRMETA.xml"
echo "done"
echo -n "Backing up VM metadata: "
${debug} echo ""
- mkdir -p ${metadir}/all
+ mkdir -p "${metadir}/all"
for vmuuid in $(${XE} vm-list params=uuid is-control-domain=false --minimal); do
${debug} echo -n .
- ${XE} vm-export --metadata uuid=${vmuuid} filename=${metadir}/all/${vmuuid}.vmmeta >/dev/null 2>&1
+ ${XE} vm-export --metadata uuid="${vmuuid}" filename="${metadir}/all/${vmuuid}.vmmeta" >/dev/null 2>&1
done
echo "done"
echo -n "Backing up Template metadata: "
@@ -271,13 +310,13 @@ if [ ${leave_mounted} -eq 0 ]; then
template_uuids=$("@LIBEXECDIR@/print-custom-templates")
if [ $? -eq 0 ]; then
for tmpl_uuid in ${template_uuids}; do
- ${XE} template-export --metadata template-uuid=${tmpl_uuid} filename=${metadir}/all/${tmpl_uuid}.vmmeta >/dev/null 2>&1
+ ${XE} template-export --metadata template-uuid="${tmpl_uuid}" filename="${metadir}/all/${tmpl_uuid}.vmmeta" >/dev/null 2>&1
done
fi
echo "done"
- "@LIBEXECDIR@/link-vms-by-sr.py" -d ${metadir}
+ "@LIBEXECDIR@/link-vms-by-sr.py" -d "${metadir}"
else
- cd ${mnt}
+ cd "${mnt}"
env PS1="Mounted backup VDI on: ${mnt}\nPress ^D to exit shell and safely detach it.\n\n[\u@\h \W]\$ " bash
fi
diff --git a/scripts/xe-restore-metadata b/scripts/xe-restore-metadata
index 81beb51b7..093cd7721 100755
--- a/scripts/xe-restore-metadata
+++ b/scripts/xe-restore-metadata
@@ -47,11 +47,18 @@ function usage {
function test_sr {
sr_uuid_found=$(${XE} sr-list uuid="$1" --minimal)
if [ "${sr_uuid_found}" != "$1" ]; then
- echo Invalid SR UUID specified: $1
+ echo "Invalid SR UUID specified: $1"
usage
fi
}
+# name space to hash SRs for a deterministic VDI UUID
+NS="e93e0639-2bdb-4a59-8b46-352b3f408c19"
+function uuid5 {
+ # could use a modern uuidgen but it's not on XS 8
+ python -c "import uuid; print (uuid.uuid5(uuid.UUID('$1'), '$2'))"
+}
+
dry_run=0
sr_uuid=
yes=0
@@ -94,35 +101,42 @@ fi
# determine if the SR UUID is vaid
if [ -z "${sr_uuid}" ]; then
# use the default-SR from the pool
- sr_uuid=$(${XE} pool-param-get uuid=${pool_uuid} param-name=default-SR)
+ sr_uuid=$(${XE} pool-param-get uuid="${pool_uuid}" param-name=default-SR)
fi
test_sr "${sr_uuid}"
-sr_name=$(${XE} sr-param-get uuid=${sr_uuid} param-name=name-label)
+sr_name=$(${XE} sr-param-get uuid="${sr_uuid}" param-name=name-label)
+
+# probe first for a VDI with known UUID derived from the SR to avoid
+# scanning for a VDI
+backup_vdi=$(uuid5 "${NS}" "${sr_uuid}")
+if [ -z "${vdis}" ]; then
+ vdis=$(${XE} vdi-list uuid="${backup_vdi}" sr-uuid="${sr_uuid}" read-only=false --minimal)
+fi
# get a list of all VDIs if an override has not been provided on the cmd line
if [ -z "${vdis}" ]; then
- vdis=$(${XE} vdi-list params=uuid sr-uuid=${sr_uuid} read-only=false --minimal)
+ vdis=$(${XE} vdi-list params=uuid sr-uuid="${sr_uuid}" read-only=false --minimal)
fi
mnt=
function cleanup {
cd /
if [ ! -z "${mnt}" ]; then
- umount ${mnt} >/dev/null 2>&1
- rmdir ${mnt}
+ umount "${mnt}" >/dev/null 2>&1
+ rmdir "${mnt}"
mnt=""
fi
if [ ! -z "${vbd_uuid}" ]; then
${debug} echo -n "Unplugging VBD: " >&2
- ${XE} vbd-unplug uuid=${vbd_uuid} timeout=20
+ ${XE} vbd-unplug uuid="${vbd_uuid}" timeout=20
# poll for the device to go away if we know its name
if [ "${device}" != "" ]; then
device_gone=0
for ((i=0; i<10; i++)); do
${debug} echo -n "." >&2
- if [ ! -b ${device} ]; then
+ if [ ! -b "${device}" ]; then
${debug} echo " done" >&2
device_gone=1
break
@@ -131,9 +145,9 @@ function cleanup {
done
if [ ${device_gone} -eq 0 ]; then
${debug} echo " failed" >&2
- ${debug} echo Please destroy VBD ${vbd_uuid} manually. >&2
+ ${debug} echo "Please destroy VBD ${vbd_uuid} manually." >&2
else
- ${XE} vbd-destroy uuid=${vbd_uuid}
+ ${XE} vbd-destroy uuid="${vbd_uuid}"
vbd_uuid=""
fi
fi
@@ -142,88 +156,96 @@ function cleanup {
}
if [ -z "${vdis}" ]; then
- echo No VDIs found on SR. >&2
+ echo "No VDIs found on SR." >&2
exit 0
fi
trap cleanup SIGINT ERR
for vdi_uuid in ${vdis}; do
+ if [ "${vdi_uuid}" != "${backup_vdi}" ] && [ "$yes" -eq 0 ]; then
+ echo "Probing VDI ${vdi_uuid}."
+ echo "This VDI was created with a prior version of this code."
+ echo "Its validity can't be checked without mounting it first."
+ read -p "Continue? [Y/N]" -n 1 -r; echo
+ if [[ ! $REPLY =~ ^[Yy]$ ]]; then exit 1; fi
+ fi
+
${debug} echo -n "Creating VBD: " >&2
- vbd_uuid=$(${XE} vbd-create vm-uuid=${CONTROL_DOMAIN_UUID} vdi-uuid=${vdi_uuid} device=autodetect 2>/dev/null)
+ vbd_uuid=$(${XE} vbd-create vm-uuid="${CONTROL_DOMAIN_UUID}" vdi-uuid="${vdi_uuid}" device=autodetect 2>/dev/null)
if [ $? -ne 0 -o -z "${vbd_uuid}" ]; then
- ${debug} echo error creating VBD for VDI ${vdi_uuid} >&2
+ ${debug} echo "error creating VBD for VDI ${vdi_uuid}" >&2
cleanup
continue
fi
- ${debug} echo ${vbd_uuid} >&2
+ ${debug} echo "${vbd_uuid}" >&2
${debug} echo -n "Plugging VBD: " >&2
- ${XE} vbd-plug uuid=${vbd_uuid}
- device=/dev/$(${XE} vbd-param-get uuid=${vbd_uuid} param-name=device)
+ ${XE} vbd-plug uuid="${vbd_uuid}"
+ device=/dev/$(${XE} vbd-param-get uuid="${vbd_uuid}" param-name=device)
- if [ ! -b ${device} ]; then
- ${debug} echo ${device}: not a block special >&2
+ if [ ! -b "${device}" ]; then
+ ${debug} echo "${device}: not a block special" >&2
cleanup
continue
fi
- ${debug} echo ${device} >&2
+ ${debug} echo "${device}" >&2
${debug} echo -n "Probing device: " >&2
probecmd="@LIBEXECDIR@/probe-device-for-file"
metadata_stamp="/.ctxs-metadata-backup"
mnt=
- ${probecmd} ${device} ${metadata_stamp}
+ ${probecmd} "${device}" "${metadata_stamp}"
if [ $? -eq 0 ]; then
- ${debug} echo found metadata backup >&2
+ ${debug} echo "found metadata backup" >&2
${debug} echo -n "Mounting filesystem: " >&2
- mnt=/var/run/pool-backup-${vdi_uuid}
- mkdir -p ${mnt}
- /sbin/fsck -a ${device} >/dev/null 2>&1
+ mnt="/var/run/pool-backup-${vdi_uuid}"
+ mkdir -p "${mnt}"
+ /sbin/fsck -a "${device}" >/dev/null 2>&1
if [ $? -ne 0 ]; then
- echo File system integrity error. Please correct manually. >&2
+ echo "File system integrity error. Please correct manually." >&2
cleanup
continue
fi
- mount ${device} ${mnt} >/dev/null 2>&1
+ mount "${device}" "${mnt}" >/dev/null 2>&1
if [ $? -ne 0 ]; then
${debug} echo failed >&2
cleanup
else
if [ -e "${mnt}/.ctxs-metadata-backup" ]; then
- ${debug} echo Found backup metadata on VDI: ${vdi_uuid} >&2
- xe vdi-param-set uuid=${vdi_uuid} other-config:ctxs-pool-backup=true
+ ${debug} echo "Found backup metadata on VDI: ${vdi_uuid}" >&2
+ xe vdi-param-set uuid="${vdi_uuid}" other-config:ctxs-pool-backup=true
break
fi
fi
else
- ${debug} echo backup metadata not found >&2
+ ${debug} echo "backup metadata not found" >&2
fi
cleanup
done
if [ $just_probe -gt 0 ]; then
- echo ${vdi_uuid}
+ echo "${vdi_uuid}"
cleanup
exit 0
fi
-cd ${mnt}
+cd "${mnt}"
${debug} echo "" >&2
-if [ ! -d ${mnt}/metadata ]; then
- echo Metadata backups not found. >&2
+if [ ! -d "${mnt}/metadata" ]; then
+ echo "Metadata backups not found." >&2
cleanup
exit 1
fi
-cd ${mnt}/metadata
+cd "${mnt}/metadata"
-if [ $just_list_dates -gt 0 ]; then
- ls -1r ${mnt}/metadata
+if [ "$just_list_dates" -gt 0 ]; then
+ ls -1r "${mnt}/metadata"
cleanup
exit 0
fi
@@ -231,54 +253,54 @@ fi
if [ -z "${chosen_date}" ]; then
chosen_metadata_dir=$(ls | sort -n | tail -1)
if [ -z "${chosen_metadata_dir}" ]; then
- echo No VM metadata backups found in ${mnt}/metadata >&2
+ echo "No VM metadata backups found in ${mnt}/metadata" >&2
cleanup
exit 1
fi
else
- if [ ! -d ${mnt}/metadata/${chosen_date} ]; then
- echo Date directory "${chosen_date}" not found >&2
+ if [ ! -d "${mnt}/metadata/${chosen_date}" ]; then
+ echo "Date directory ${chosen_date} not found" >&2
cleanup
exit 1
fi
- chosen_metadata_dir=${chosen_date}
+ chosen_metadata_dir="${chosen_date}"
fi
case ${restore_mode} in
sr)
- full_dir=${mnt}/metadata/${chosen_metadata_dir}/by-sr/${sr_uuid}
+ full_dir="${mnt}/metadata/${chosen_metadata_dir}/by-sr/${sr_uuid}"
;;
all)
- full_dir=${mnt}/metadata/${chosen_metadata_dir}/all
+ full_dir="${mnt}/metadata/${chosen_metadata_dir}/all"
;;
esac
-if [ ! -d ${full_dir} ]; then
- echo No VM metadata exports were found for the selected SR >&2
+if [ ! -d "${full_dir}" ]; then
+ echo "No VM metadata exports were found for the selected SR" >&2
cleanup
exit 1
fi
-${debug} echo Selected: ${full_dir}
+${debug} echo "Selected: ${full_dir}"
-cd ${full_dir}
+cd "${full_dir}"
${debug} echo "" >&2
-${debug} echo Latest VM metadata found is: >&2
+${debug} echo "Latest VM metadata found is": >&2
${debug} ls >&2
-if [ $yes -eq 0 ]; then
+if [ "$yes" -eq 0 ]; then
echo "Do you wish to reimport all VM metadata?"
- echo "Please type in "yes" and <enter> to continue."
+ echo "Please type in 'yes' and <enter> to continue."
read response
if [ "$response" != "yes" ]; then
- echo Aborting metadata restore.
+ echo "Aborting metadata restore."
cleanup
exit 1
fi
fi
${debug} echo "" >&2
-${debug} echo Restoring VM metadata: >&2
+${debug} echo "Restoring VM metadata:" >&2
trap - ERR
@@ -297,8 +319,8 @@ else
fi
shopt -s nullglob
for meta in *.vmmeta; do
- echo xe vm-import filename=${meta} sr-uuid=${sr_uuid} --metadata --preserve${force_flag}${dry_run_flag}
- "@OPTDIR@/bin/xe" vm-import filename="${full_dir}/${meta}" sr-uuid=${sr_uuid} --metadata --preserve${force_flag}${dry_run_flag}
+ echo xe vm-import filename="${meta}" sr-uuid="${sr_uuid}" --metadata --preserve"${force_flag}""${dry_run_flag}"
+ "@OPTDIR@/bin/xe" vm-import filename="${full_dir}/${meta}" sr-uuid="${sr_uuid}" --metadata --preserve"${force_flag}""${dry_run_flag}"
if [ $? -gt 0 ]; then
error_count=$(( $error_count + 1 ))
else
@@ -306,16 +328,16 @@ for meta in *.vmmeta; do
fi
done
-smmeta_file=${mnt}/metadata/${chosen_metadata_dir}/SRMETA.xml
+smmeta_file="${mnt}/metadata/${chosen_metadata_dir}/SRMETA.xml"
if [ "$restore_mode" == "all" ]; then
cmd="@LIBEXECDIR@/restore-sr-metadata.py -f ${smmeta_file}"
else
cmd="@LIBEXECDIR@/restore-sr-metadata.py -u ${sr_uuid} -f ${smmeta_file}"
fi
-if [ -e ${smmeta_file} ]; then
- if [ ${dry_run} -gt 0 ]; then
- echo ${cmd}
+if [ -e "${smmeta_file}" ]; then
+ if [ "${dry_run}" -gt 0 ]; then
+ echo "${cmd}"
else
${cmd}
fi
@@ -323,4 +345,4 @@ fi
echo "Restored ${good_count} VM(s), and ${error_count} error(s)"
cleanup
-exit ${error_count}
+exit "${error_count}"An empty You can check the results of the job here |
psafont
changed the title
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
This allows orchestrators to copy devices like VBDs from the VM, export the
metadata without the disk, import the VM to any pool, and finally add the
saved VBDs to the new VM before booting it.
Also include cleanups in the cli server, it's full of ad-hoc methods.
This has passed manual testing, the corresponding FQP test by QA, and tested by CVAD people as well