Add test for lock implementation in message_switch #5362
Merged
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
|
Related fix for the race condition in async #5359 |
|
Some quality gate issues regarding ml files. Do we care about ml files in |
edwintorok
reviewed
Jan 17, 2024
ocaml/message-switch/core/mtest.ml
Outdated
| let mutex_provides_mutal_exclusion () : unit io = | ||
| ignore @@ M.Clock.run_after 1 broadcast ; | ||
| ignore | ||
| @@ Array.init 100 (fun _ -> |
There was a problem hiding this comment.
For Lwt I think we'll need to wait until all of these are complete. Instead of ignoring the array try storing it in a value (or as a list).
(I think that Lwt -- unlike Async -- would happily exit from Lwt_main.run even when there are unresolved promises as long as the "main" promise given as argument is resolved. Whereas async's scheduler will run for as long as there are promises to resolve).
edwintorok
reviewed
Jan 17, 2024
ocaml/message-switch/core/mtest.ml
Outdated
| let broadcast () = M.Condition.broadcast cond () | ||
|
|
||
| let mutex_provides_mutal_exclusion () : unit io = | ||
| ignore @@ M.Clock.run_after 1 broadcast ; |
There was a problem hiding this comment.
Move this after the array creation: then you don't need to sleep for 1s, you can immediately broadcast after the array has been created.
edwintorok
reviewed
Jan 17, 2024
| ) | ||
| ) ; | ||
| Printf.printf "%s test.\n" (M.whoami ()) ; | ||
| M.IO.return_unit |
There was a problem hiding this comment.
would be good to wait until all promises in the array are resolved to ensure we've let the code run fully. Then we can remove the arbitrary 2s sleep, and make this test complete more quickly.
edwintorok
reviewed
Jan 17, 2024
|
Are we not trying to remove all Async code and is this adding more? |
|
It's adding a test to ensure the async code works as expected. This will be removed in the coming months, but I believe it's good we have proof of the fix in the repo. I also ensures the Lwt backend works as expected as well, which is a net positive |
Vincent-lau
force-pushed
the
private/shul2/async-race
branch
from
c3bd539 to
9272376
Compare
|
Please rebase, tests should be more stable now |
Vincent-lau
force-pushed
the
private/shul2/async-race
branch
from
9272376 to
7935eae
Compare
psafont
approved these changes
Apr 9, 2024
|
@edwintorok you had some initial comments; so would suggest to revisit ⏫ |
lindig
approved these changes
Apr 11, 2024
The lock implementation for `protocol_async` was not correct, hence adding the test suggested by Edwin to trigger race. Test works by trying to acquire a standard Ocaml mutex in a critical section provided by the `with_lock` implementation. This means that any failed attempt to acquire the lock implies the `with_lock` implementation does not provide mutual exclusion. Signed-off-by: Vincent Liu <[email protected]>
Vincent-lau
force-pushed
the
private/shul2/async-race
branch
from
7935eae to
0d1d992
Compare
|
We can probably merge this one if @edwintorok is busy, it's a small change in unit tests anyway. |
|
I agree, this is low risk |
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/message-switch-core.opam b/message-switch-core.opam
index 960934bea..44e2983cc 100644
--- a/message-switch-core.opam
+++ b/message-switch-core.opam
@@ -22,6 +22,7 @@ depends: [
"ppx_sexp_conv"
"rpclib"
"sexplib"
+ "xapi-log"
]
synopsis: "A simple store-and-forward message switch"
description: """
diff --git a/message-switch-core.opam.template b/message-switch-core.opam.template
index 7ec11e91d..7f65fa075 100644
--- a/message-switch-core.opam.template
+++ b/message-switch-core.opam.template
@@ -20,6 +20,7 @@ depends: [
"ppx_sexp_conv"
"rpclib"
"sexplib"
+ "xapi-log"
]
synopsis: "A simple store-and-forward message switch"
description: """
diff --git a/ocaml/forkexecd/lib/fe.ml b/ocaml/forkexecd/lib/fe.ml
index 1a176a62b..c928cd3fc 100644
--- a/ocaml/forkexecd/lib/fe.ml
+++ b/ocaml/forkexecd/lib/fe.ml
@@ -1,13 +1,13 @@
(* Disable "Warning 39: unused rec flag." caused by rpc *)
[@@@warning "-39"]
-type syslog_stdout_t = {enabled: bool; key: string option} [@@deriving rpc]
+type syslog_stdout = {enabled: bool; key: string option} [@@deriving rpc]
type setup_cmd = {
cmdargs: string list
; env: string list
; id_to_fd_map: (string * int option) list
- ; syslog_stdout: syslog_stdout_t
+ ; syslog_stdout: syslog_stdout
; redirect_stderr_to_stdout: bool
}
[@@deriving rpc]
diff --git a/ocaml/forkexecd/lib/forkhelpers.ml b/ocaml/forkexecd/lib/forkhelpers.ml
index d55901c3c..f212ae7f0 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
@@ -136,7 +171,7 @@ let with_logfile_fd ?(delete = true) prefix f =
exception Spawn_internal_error of string * string * Unix.process_status
-type syslog_stdout_t =
+type syslog_stdout =
| NoSyslogging
| Syslog_DefaultKey
| Syslog_WithKey of string
diff --git a/ocaml/forkexecd/lib/forkhelpers.mli b/ocaml/forkexecd/lib/forkhelpers.mli
index 6252f0e75..186cbe518 100644
--- a/ocaml/forkexecd/lib/forkhelpers.mli
+++ b/ocaml/forkexecd/lib/forkhelpers.mli
@@ -34,7 +34,7 @@
(** {2 High-level interface } *)
-type syslog_stdout_t =
+type syslog_stdout =
| NoSyslogging
| Syslog_DefaultKey
| Syslog_WithKey of string
@@ -45,7 +45,7 @@ val default_path_env_pair : string array
val execute_command_get_output :
?env:string array
- -> ?syslog_stdout:syslog_stdout_t
+ -> ?syslog_stdout:syslog_stdout
-> ?redirect_stderr_to_stdout:bool
-> ?timeout:float
-> string
@@ -57,7 +57,7 @@ val execute_command_get_output :
val execute_command_get_output_send_stdin :
?env:string array
- -> ?syslog_stdout:syslog_stdout_t
+ -> ?syslog_stdout:syslog_stdout
-> ?redirect_stderr_to_stdout:bool
-> ?timeout:float
-> string
@@ -97,7 +97,7 @@ val safe_close_and_exec :
-> Unix.file_descr option
-> Unix.file_descr option
-> (string * Unix.file_descr) list
- -> ?syslog_stdout:syslog_stdout_t
+ -> ?syslog_stdout:syslog_stdout
-> ?redirect_stderr_to_stdout:bool
-> string
-> string list
@@ -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 197f3b91f..0bdb5fc1d 100644
--- a/ocaml/forkexecd/src/child.ml
+++ b/ocaml/forkexecd/src/child.ml
@@ -3,13 +3,13 @@ let debug (fmt : ('a, unit, string, unit) format4) =
exception Cancelled
-type syslog_stdout_t = {enabled: bool; key: string option}
+type syslog_stdout = {enabled: bool; key: string option}
type state_t = {
cmdargs: string list
; env: string list
; id_to_fd_map: (string * int option) list
- ; syslog_stdout: syslog_stdout_t
+ ; syslog_stdout: syslog_stdout
; redirect_stderr_to_stdout: bool
; ids_received: (string * Unix.file_descr) list
; fd_sock2: Unix.file_descr option
diff --git a/ocaml/forkexecd/test/fe_test.ml b/ocaml/forkexecd/test/fe_test.ml
index bb740d94d..42991d5f1 100644
--- a/ocaml/forkexecd/test/fe_test.ml
+++ b/ocaml/forkexecd/test/fe_test.ml
@@ -109,14 +109,23 @@ let test_delay () =
let start = Unix.gettimeofday () in
let exe = Printf.sprintf "/proc/%d/exe" (Unix.getpid ()) in
let args = ["sleep"] in
+ (* Need to have fractional part because some internal usage split integer
+ and fractional and do computation.
+ Better to have a high fractional part (> 0.5) to more probably exceed
+ the unit.
+ *)
+ let timeout = 1.7 in
try
- Forkhelpers.execute_command_get_output ~timeout:4.0 exe args |> ignore ;
+ Forkhelpers.execute_command_get_output ~timeout exe args |> ignore ;
failwith "Failed to timeout"
with
| Forkhelpers.Subprocess_timeout ->
- Printf.printf "Caught timeout exception after %f seconds\n%!"
- (Unix.gettimeofday () -. start) ;
- ()
+ let elapsed = Unix.gettimeofday () -. start in
+ Printf.printf "Caught timeout exception after %f seconds\n%!" elapsed ;
+ if elapsed < timeout then
+ failwith "Process exited too soon" ;
+ if elapsed > timeout +. 0.2 then
+ failwith "Excessive time elapsed"
| e ->
failwith
(Printf.sprintf "Failed with unexpected exception: %s"
@@ -140,6 +149,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 +163,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
@@ -233,7 +270,15 @@ let slave = function
pid (List.length filtered) ls
)
-let sleep () = Unix.sleep 5 ; Printf.printf "Ok\n"
+let sleep () = Unix.sleep 3 ; 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" ;
@@ -253,6 +298,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 c8fa26141..a9f219e91 100644
--- a/ocaml/idl/datamodel.ml
+++ b/ocaml/idl/datamodel.ml
@@ -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/async/protocol_async.ml b/ocaml/message-switch/async/protocol_async.ml
index 9ec9cc42b..5898d22f7 100644
--- a/ocaml/message-switch/async/protocol_async.ml
+++ b/ocaml/message-switch/async/protocol_async.ml
@@ -30,9 +30,16 @@ module M = struct
let iter f t = Deferred.List.iter t ~f
+ let iter_dontwait f t =
+ Deferred.don't_wait_for @@ Deferred.List.iter ~how:`Parallel t ~f
+
let any = Deferred.any
+ let all = Deferred.all
+
let is_determined = Deferred.is_determined
+
+ let return_unit = Deferred.unit
end
let connect path =
@@ -95,6 +102,20 @@ module M = struct
)
end
+ module Condition = struct
+ open Async_kernel
+
+ type 'a t = 'a Condition.t
+
+ let create = Condition.create
+
+ let wait = Condition.wait
+
+ let broadcast = Condition.broadcast
+
+ let signal = Condition.signal
+ end
+
module Clock = struct
type timer = {cancel: unit Ivar.t}
@@ -117,3 +138,4 @@ end
module Client = Message_switch_core.Make.Client (M)
module Server = Message_switch_core.Make.Server (M)
+module Mtest = Message_switch_core.Mtest.Make (M)
diff --git a/ocaml/message-switch/async/protocol_async.mli b/ocaml/message-switch/async/protocol_async.mli
index f691c24c9..d18b37b74 100644
--- a/ocaml/message-switch/async/protocol_async.mli
+++ b/ocaml/message-switch/async/protocol_async.mli
@@ -19,3 +19,5 @@ open Message_switch_core
module Client : S.CLIENT with type 'a io = 'a Deferred.t
module Server : S.SERVER with type 'a io = 'a Deferred.t
+
+module Mtest : Mtest.MTEST with type 'a io = 'a Deferred.t
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/message-switch/core/dune b/ocaml/message-switch/core/dune
index 676fa3f20..6debbc895 100644
--- a/ocaml/message-switch/core/dune
+++ b/ocaml/message-switch/core/dune
@@ -9,6 +9,8 @@
sexplib
sexplib0
uri
+ xapi-log
+ xapi-stdext-threads
)
(preprocess (pps ppx_deriving_rpc ppx_sexp_conv))
)
diff --git a/ocaml/message-switch/core/make.ml b/ocaml/message-switch/core/make.ml
index 54e8904e1..224012909 100644
--- a/ocaml/message-switch/core/make.ml
+++ b/ocaml/message-switch/core/make.ml
@@ -16,6 +16,10 @@
open Sexplib.Std
open Protocol
+module D = Debug.Make (struct let name = "Message_switch.make" end)
+
+open D
+
module Connection =
functor
(IO : Cohttp.S.IO)
@@ -406,4 +410,92 @@ functor
in
let _ = loop c None in
return (Ok t)
+
+ let listen_p ~process ~switch:port ~queue:name () =
+ let token = Printf.sprintf "%d" (Unix.getpid ()) in
+ let protect_connect path f =
+ M.connect path >>= fun conn ->
+ f conn >>= function
+ | Ok _ as ok ->
+ return ok
+ | Error _ as err ->
+ M.disconnect conn >>= fun () -> return err
+ in
+ let reconnect () =
+ protect_connect port @@ fun request_conn ->
+ Connection.rpc request_conn (In.Login token) >>|= fun (_ : string) ->
+ protect_connect port @@ fun reply_conn ->
+ Connection.rpc reply_conn (In.Login token) >>|= fun (_ : string) ->
+ return (Ok (request_conn, reply_conn))
+ in
+ reconnect () >>|= fun ((request_conn, reply_conn) as c) ->
+ let request_shutdown = M.Ivar.create () in
+ let on_shutdown = M.Ivar.create () in
+ let mutex = M.Mutex.create () in
+ Connection.rpc request_conn (In.CreatePersistent name) >>|= fun _ ->
+ let t = {request_shutdown; on_shutdown} in
+ let reconnect () =
+ M.disconnect request_conn >>= fun () ->
+ M.disconnect reply_conn >>= reconnect
+ in
+ let rec loop c from =
+ let transfer = {In.from; timeout; queues= [name]} in
+ let frame = In.Transfer transfer in
+ let message = Connection.rpc request_conn frame in
+ any [map (fun _ -> ()) message; M.Ivar.read request_shutdown]
+ >>= fun () ->
+ if is_determined (M.Ivar.read request_shutdown) then (
+ M.Ivar.fill on_shutdown () ; return (Ok ())
+ ) else
+ message >>= function
+ | Error _e ->
+ M.Mutex.with_lock mutex reconnect >>|= fun c -> loop c from
+ | Ok raw -> (
+ let transfer = Out.transfer_of_rpc (Jsonrpc.of_string raw) in
+ let print_error = function
+ | Ok (_ : string) ->
+ return ()
+ | Error _ as err ->
+ error "message switch reply received error" ;
+ ignore @@ error_to_msg err ;
+ return ()
+ in
+ match transfer.Out.messages with
+ | [] ->
+ loop c from
+ | _ :: _ ->
+ iter_dontwait
+ (fun (i, m) ->
+ process m.Message.payload >>= fun response ->
+ ( match m.Message.kind with
+ | Message.Response _ ->
+ return () (* configuration error *)
+ | Message.Request reply_to ->
+ let request =
+ In.Send
+ ( reply_to
+ , {
+ Message.kind= Message.Response i
+ ; payload= response
+ }
+ )
+ in
+ M.Mutex.with_lock mutex (fun () ->
+ Connection.rpc reply_conn request
+ )
+ >>= print_error
+ )
+ >>= fun () ->
+ let request = In.Ack i in
+ M.Mutex.with_lock mutex (fun () ->
+ Connection.rpc reply_conn request
+ )
+ >>= print_error
+ )
+ transfer.Out.messages ;
+ loop c (Some transfer.Out.next)
+ )
+ in
+ let _ = loop c None in
+ return (Ok t)
end
diff --git a/ocaml/message-switch/core/mtest.ml b/ocaml/message-switch/core/mtest.ml
new file mode 100644
index 000000000..3b8da9803
--- /dev/null
+++ b/ocaml/message-switch/core/mtest.ml
@@ -0,0 +1,42 @@
+module type MTEST = sig
+ type +'a io
+
+ val mutex_provides_mutal_exclusion : unit -> unit io
+end
+
+module Make =
+functor
+ (M : S.BACKEND)
+ ->
+ struct
+ open M.IO
+
+ type 'a io = 'a M.IO.t
+
+ let ocaml_lock = Mutex.create ()
+
+ let mu = M.Mutex.create ()
+
+ let cond = M.Condition.create ()
+
+ let broadcast () = M.Condition.broadcast cond ()
+
+ let mutex_provides_mutal_exclusion () : unit io =
+ let promises =
+ List.init 100 (fun _ ->
+ M.Condition.wait cond >>= fun () ->
+ M.Mutex.with_lock mu (fun () ->
+ M.IO.return_unit >>= fun () ->
+ (* the with_lock implementation should ensure that only one
+ monad can try to acquire this lock *)
+ assert (Mutex.try_lock ocaml_lock) ;
+ M.IO.return_unit >>= fun () ->
+ Mutex.unlock ocaml_lock ; M.IO.return_unit
+ )
+ )
+ in
+ broadcast () ;
+ ignore @@ all promises ;
+ Printf.printf "%s test.\n" (M.whoami ()) ;
+ M.IO.return_unit
+ end
diff --git a/ocaml/message-switch/core/s.ml b/ocaml/message-switch/core/s.ml
index f99e05826..423304d1b 100644
--- a/ocaml/message-switch/core/s.ml
+++ b/ocaml/message-switch/core/s.ml
@@ -29,9 +29,15 @@ module type BACKEND = sig
val iter : ('a -> unit t) -> 'a list -> unit t
+ val iter_dontwait : ('a -> unit t) -> 'a list -> unit
+
val any : 'a t list -> 'a t
+ val all : 'a t list -> 'a list t
+
val is_determined : 'a t -> bool
+
+ val return_unit : unit t
end
val connect : string -> (IO.ic * IO.oc) IO.t
@@ -56,6 +62,18 @@ module type BACKEND = sig
val with_lock : t -> (unit -> 'a IO.t) -> 'a IO.t
end
+ module Condition : sig
+ type 'a t
+
+ val create : unit -> 'a t
+
+ val wait : 'a t -> 'a IO.t
+
+ val broadcast : 'a t -> 'a -> unit
+
+ val signal : 'a t -> 'a -> unit
+ end
+
module Clock : sig
type timer
@@ -89,6 +107,14 @@ module type SERVER = sig
(** Connect to [switch] and start processing messages on [queue] via function
[process] *)
+ val listen_p :
+ process:(string -> string io)
+ -> switch:string
+ -> queue:string
+ -> unit
+ -> t result io
+ (** same as above, but processes requests concurrently *)
+
val shutdown : t:t -> unit -> unit io
(** [shutdown t] shutdown a server *)
end
diff --git a/ocaml/message-switch/core_test/async/server_async_main.ml b/ocaml/message-switch/core_test/async/server_async_main.ml
index 2372cb34c..cd7984bec 100644
--- a/ocaml/message-switch/core_test/async/server_async_main.ml
+++ b/ocaml/message-switch/core_test/async/server_async_main.ml
@@ -23,6 +23,8 @@ let path = ref "/var/run/message-switch/sock"
let name = ref "server"
+let concurrent = ref false
+
let shutdown = Ivar.create ()
let process = function
@@ -33,6 +35,9 @@ let process = function
let main () =
let (_ : 'a Deferred.t) =
+ if !concurrent then
+ Server.listen_p ~process ~switch:!path ~queue:!name ()
+ else
Server.listen ~process ~switch:!path ~queue:!name ()
in
Ivar.read shutdown >>= fun () ->
@@ -49,6 +54,11 @@ let _ =
, Arg.Set_string name
, Printf.sprintf "name to send message to (default %s)" !name
)
+ ; ( "-concurrent"
+ , Arg.Set concurrent
+ , Printf.sprintf "set concurrent processing of messages (default %b)"
+ !concurrent
+ )
]
(fun x -> P.fprintf stderr "Ignoring unexpected argument: %s" x)
"Respond to RPCs on a name" ;
diff --git a/ocaml/message-switch/core_test/basic-rpc-test.sh b/ocaml/message-switch/core_test/basic-rpc-test.sh
index e73c3a873..877790370 100755
--- a/ocaml/message-switch/core_test/basic-rpc-test.sh
+++ b/ocaml/message-switch/core_test/basic-rpc-test.sh
@@ -1,12 +1,14 @@
#!/bin/bash
set -e
-SPATH=${TMPDIR:-/tmp}/sock
-SWITCHPATH=${TMPDIR:-/tmp}/switch
+SPATH=${TMPDIR:-/tmp}/sock_s
+SWITCHPATH=${TMPDIR:-/tmp}/switch_s
rm -rf ${SWITCHPATH} && mkdir -p ${SWITCHPATH}
+echo Test message switch serial processing
+
echo Checking the switch can start late
./server_unix_main.exe -path $SPATH &
sleep 1
diff --git a/ocaml/message-switch/core_test/concur-rpc-test.sh b/ocaml/message-switch/core_test/concur-rpc-test.sh
new file mode 100755
index 000000000..a91768972
--- /dev/null
+++ b/ocaml/message-switch/core_test/concur-rpc-test.sh
@@ -0,0 +1,45 @@
+#!/bin/bash
+set -e
+
+SPATH="${TMPDIR:-/tmp}/sock_p-$$"
+SWITCHPATH="${TMPDIR:-/tmp}/switch_p-$$"
+
+trap "cleanup" TERM INT
+
+function cleanup {
+ rm -rf "${SWITCHPATH}"
+}
+
+rm -rf "${SWITCHPATH}" && mkdir -p "${SWITCHPATH}"
+
+echo Test message switch concurrent processing
+
+echo Checking the switch can start late
+test -x ./server_unix_main.exe || exit 1
+./server_unix_main.exe -path "$SPATH" &
+sleep 1
+test -x ../switch/switch_main.exe && test -x ./client_unix_main.exe || exit 1
+../switch/switch_main.exe --path "$SPATH" --statedir "${SWITCHPATH}" &
+./client_unix_main.exe -path "$SPATH" -secs 5
+sleep 2
+
+echo Performance test of Lwt to Lwt
+test -x lwt/server_main.exe && test -x lwt/client_main.exe || exit 1
+lwt/server_main.exe -path "$SPATH" -concurrent &
+lwt/client_main.exe -path "$SPATH" -secs 5
+sleep 2
+
+echo Performance test of Async to Lwt
+test -x lwt/server_main.exe && test -x async/client_async_main.exe || exit 1
+lwt/server_main.exe -path "$SPATH" -concurrent &
+async/client_async_main.exe -path "$SPATH" -secs 5
+sleep 2
+
+echo Performance test of Async to Async
+test -x async/server_async_main.exe && test -x async/client_async_main.exe || exit 1
+async/server_async_main.exe -path "$SPATH" -concurrent &
+async/client_async_main.exe -path "$SPATH" -secs 5
+sleep 2
+
+../cli/main.exe shutdown --path "$SPATH"
+sleep 2
diff --git a/ocaml/message-switch/core_test/dune b/ocaml/message-switch/core_test/dune
index d500c1013..449f2fae5 100644
--- a/ocaml/message-switch/core_test/dune
+++ b/ocaml/message-switch/core_test/dune
@@ -3,13 +3,43 @@
(names
client_unix_main
server_unix_main
+ lock_test_async
+ lock_test_lwt
+ )
+ (modules
+ client_unix_main
+ server_unix_main
+ lock_test_async
+ lock_test_lwt
)
(libraries
message-switch-unix
+ message-switch-core
+ message-switch-async
+ message-switch-lwt
threads.posix
)
)
+(rule
+ (alias runtest)
+ (deps
+ lock_test_async.exe
+ )
+ (action (run ./lock_test_async.exe))
+ (package message-switch)
+)
+
+(rule
+ (alias runtest)
+ (deps
+ lock_test_lwt.exe
+ )
+ (action (run ./lock_test_lwt.exe))
+ (package message-switch)
+)
+
+
(rule
(alias runtest)
(deps
@@ -27,3 +57,20 @@
(package message-switch)
)
+(rule
+ (alias runtest)
+ (deps
+ client_unix_main.exe
+ server_unix_main.exe
+ async/client_async_main.exe
+ async/server_async_main.exe
+ lwt/client_main.exe
+ lwt/server_main.exe
+ lwt/link_test_main.exe
+ ../switch/switch_main.exe
+ ../cli/main.exe
+ )
+ (action (run ./concur-rpc-test.sh))
+ (package message-switch)
+)
+
diff --git a/ocaml/message-switch/core_test/lock_test_async.ml b/ocaml/message-switch/core_test/lock_test_async.ml
new file mode 100644
index 000000000..85cde8eae
--- /dev/null
+++ b/ocaml/message-switch/core_test/lock_test_async.ml
@@ -0,0 +1,13 @@
+open Core
+open Async
+open Message_switch_async
+
+let ( >>= ) = Deferred.( >>= )
+
+let test_async_lock () = Protocol_async.Mtest.mutex_provides_mutal_exclusion ()
+
+let () =
+ don't_wait_for
+ (test_async_lock () >>= fun () -> shutdown 0 ; Deferred.return ())
+
+let () = never_returns (Scheduler.go ())
diff --git a/ocaml/message-switch/core_test/lock_test_lwt.ml b/ocaml/message-switch/core_test/lock_test_lwt.ml
new file mode 100644
index 000000000..784599daf
--- /dev/null
+++ b/ocaml/message-switch/core_test/lock_test_lwt.ml
@@ -0,0 +1,5 @@
+open Message_switch_lwt
+
+let test_lwt_lock = Protocol_lwt.Mtest.mutex_provides_mutal_exclusion ()
+
+let () = Lwt_main.run test_lwt_lock
diff --git a/ocaml/message-switch/core_test/lwt/server_main.ml b/ocaml/message-switch/core_test/lwt/server_main.ml
index c30021ff3..ece423dcb 100644
--- a/ocaml/message-switch/core_test/lwt/server_main.ml
+++ b/ocaml/message-switch/core_test/lwt/server_main.ml
@@ -20,6 +20,8 @@ let path = ref "/var/run/message-switch/sock"
let name = ref "server"
+let concurrent = ref false
+
let t, u = Lwt.task ()
let process = function
@@ -29,8 +31,13 @@ let process = function
return x
let main () =
+ ( if !concurrent then
+ Message_switch_lwt.Protocol_lwt.Server.listen_p ~process ~switch:!path
+ ~queue:!name ()
+ else
Message_switch_lwt.Protocol_lwt.Server.listen ~process ~switch:!path
~queue:!name ()
+ )
>>= fun _ ->
t >>= fun () -> Lwt_unix.sleep 1.
@@ -45,6 +52,11 @@ let _ =
, Arg.Set_string name
, Printf.sprintf "name to send message to (default %s)" !name
)
+ ; ( "-concurrent"
+ , Arg.Set concurrent
+ , Printf.sprintf "set concurrent processing of messages (default %b)"
+ !concurrent
+ )
]
(fun x -> Printf.fprintf stderr "Ignoring unexpected argument: %s" x)
"Respond to RPCs on a name" ;
diff --git a/ocaml/message-switch/lwt/protocol_lwt.ml b/ocaml/message-switch/lwt/protocol_lwt.ml
index 6da59eb32..26c9c874d 100644
--- a/ocaml/message-switch/lwt/protocol_lwt.ml
+++ b/ocaml/message-switch/lwt/protocol_lwt.ml
@@ -27,9 +27,15 @@ module M = struct
let iter = Lwt_list.iter_s
+ let iter_dontwait f lst = Lwt.async (fun () -> Lwt_list.iter_p f lst)
+
let any = Lwt.choose
+ let all = Lwt.all
+
let is_determined t = Lwt.state t <> Lwt.Sleep
+
+ let return_unit = Lwt.return_unit
end
let connect path =
@@ -75,6 +81,18 @@ module M = struct
let with_lock = Lwt_mutex.with_lock
end
+ module Condition = struct
+ type 'a t = 'a Lwt_condition.t
+
+ let create = Lwt_condition.create
+
+ let signal = Lwt_condition.signal
+
+ let wait c = Lwt_condition.wait c
+
+ let broadcast = Lwt_condition.broadcast
+ end
+
module Clock = struct
type timer = unit Lwt.t
@@ -90,3 +108,4 @@ end
module Client = Message_switch_core.Make.Client (M)
module Server = Message_switch_core.Make.Server (M)
+module Mtest = Message_switch_core.Mtest.Make (M)
diff --git a/ocaml/message-switch/lwt/protocol_lwt.mli b/ocaml/message-switch/lwt/protocol_lwt.mli
index c9bd22015..64ca15c0e 100644
--- a/ocaml/message-switch/lwt/protocol_lwt.mli
+++ b/ocaml/message-switch/lwt/protocol_lwt.mli
@@ -19,3 +19,5 @@ open Message_switch_core
module Client : S.CLIENT with type 'a io = 'a Lwt.t
module Server : S.SERVER with type 'a io = 'a Lwt.t
+
+module Mtest : Mtest.MTEST with type 'a io = 'a Lwt.t
diff --git a/ocaml/message-switch/switch/switch_main.ml b/ocaml/message-switch/switch/switch_main.ml
index 9bf78973a..583baf6e5 100644
--- a/ocaml/message-switch/switch/switch_main.ml
+++ b/ocaml/message-switch/switch/switch_main.ml
@@ -75,6 +75,13 @@ module Lwt_result = struct
let ( >>= ) m f = m >>= fun x -> f (Stdlib.Result.get_ok x)
end
+let exn_hook e =
+ let bt = Printexc.get_raw_backtrace () in
+ error "Caught exception in Lwt.async: %s" (Printexc.to_string e) ;
+ error "backtrace: %s" (Printexc.raw_backtrace_to_string bt)
+
+let () = Lwt.async_exception_hook := exn_hook
+
let make_server config trace_config =
let open Config in
info "Started server on %s" config.path ;
diff --git a/ocaml/message-switch/unix/protocol_unix.ml b/ocaml/message-switch/unix/protocol_unix.ml
index 678b302ab..485964a40 100644
--- a/ocaml/message-switch/unix/protocol_unix.ml
+++ b/ocaml/message-switch/unix/protocol_unix.ml
@@ -546,5 +546,7 @@ module Server = struct
let (_ : Thread.t) = thread_forever (loop connections) None in
Ok ()
+ let listen_p = listen
+
let shutdown ~t:_ () = failwith "Shutdown is unimplemented"
end
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/README.md b/ocaml/sdk-gen/README.md
index 7473d141f..fb4d71650 100644
--- a/ocaml/sdk-gen/README.md
+++ b/ocaml/sdk-gen/README.md
@@ -12,9 +12,7 @@ The Python module is not auto-generated, it can be found at
[XenAPI.py](../../scripts/examples/python/XenAPI/XenAPI.py).
To compile the generated source code, follow the instructions in the corresponding
-README files. The (patched) third party libraries required for the compilation
-of the C# and PowerShell source code can be obtained from
-[xenserver/dotnet-packages](https://github.com/xenserver/dotnet-packages)
+`README` files.
The repository [xenserver/xenserver-samples](https://github.com/xenserver/xenserver-samples)
contains a number of examples for each of the five programming languages to help
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 e9035a88c..2302fc6cf 100644
--- a/ocaml/sdk-gen/c/gen_c_binding.ml
+++ b/ocaml/sdk-gen/c/gen_c_binding.ml
@@ -374,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
diff --git a/ocaml/sdk-gen/powershell/autogen/README.md b/ocaml/sdk-gen/powershell/autogen/README.md
index cbe06791b..abbb3b0b1 100644
--- a/ocaml/sdk-gen/powershell/autogen/README.md
+++ b/ocaml/sdk-gen/powershell/autogen/README.md
@@ -51,9 +51,9 @@ The XenServer PowerShell Module is dependent upon the following libraries:
This archive contains the following folders that are relevant to PowerShell users:
-- `XenServerPowerShell\XenServerPSModule`: this is the XenServer PowerShell
+- `XenServerPowerShell\PowerShell_7\XenServerPSModule`: this is the XenServer PowerShell
Module
-- `XenServerPowerShell\src`: contains the C# source code for the XenServer
+- `XenServerPowerShell\PowerShell_7\src`: contains the C# source code for the XenServer
cmdlets shipped as a Visual Studio project.
## Getting Started
diff --git a/ocaml/sdk-gen/powershell/autogen/README_51.md b/ocaml/sdk-gen/powershell/autogen/README_51.md
index 8088982ff..4d5b19e26 100644
--- a/ocaml/sdk-gen/powershell/autogen/README_51.md
+++ b/ocaml/sdk-gen/powershell/autogen/README_51.md
@@ -51,9 +51,9 @@ The XenServer PowerShell Module is dependent upon the following libraries:
This archive contains the following folders that are relevant to PowerShell users:
-- `XenServerPowerShell\XenServerPSModule`: this is the XenServer PowerShell
+- `XenServerPowerShell\PowerShell_51\XenServerPSModule`: this is the XenServer PowerShell
Module
-- `XenServerPowerShell\src`: contains the C# source code for the XenServer
+- `XenServerPowerShell\PowerShell_51\src`: contains the C# source code for the XenServer
cmdlets shipped as a Visual Studio project.
## Getting Started
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-storage/generator/lib/control.ml b/ocaml/xapi-storage/generator/lib/control.ml
index 93b2800a7..f4d8a22a4 100644
--- a/ocaml/xapi-storage/generator/lib/control.ml
+++ b/ocaml/xapi-storage/generator/lib/control.ml
@@ -30,6 +30,12 @@ type health =
(** Storage is busy recovering, e.g. rebuilding mirrors *)
[@@deriving rpcty]
+type volume_type =
+ | Data (** Normal data volume *)
+ | CBT_Metadata (** CBT Metadata only, data destroyed *)
+ | Data_and_CBT_Metadata (** Both Data and CBT Metadata *)
+[@@deriving rpcty]
+
(** Primary key for a specific Storage Repository. This can be any string
which is meaningful to the implementation. For example this could be an
NFS directory name, an LVM VG name or even a URI. This string is
@@ -116,6 +122,11 @@ type volume = {
; keys: (string * string) list
(** A list of key=value pairs which have been stored in the Volume
metadata. These should not be interpreted by the Volume plugin. *)
+ ; volume_type: volume_type option [@default Some Data]
+ (** The content type of this volume *)
+ ; cbt_enabled: bool option [@default Some false]
+ (** True means that the storage datapath will track changed dirty blocks
+ while writing and will be able to provide CBT Metadata when requested *)
}
[@@deriving rpcty]
diff --git a/ocaml/xapi-storage/generator/test/storage_test.ml b/ocaml/xapi-storage/generator/test/storage_test.ml
index eca6cf45a..3da8be647 100644
--- a/ocaml/xapi-storage/generator/test/storage_test.ml
+++ b/ocaml/xapi-storage/generator/test/storage_test.ml
@@ -57,6 +57,8 @@ let test_volume =
; physical_utilisation= 0L
; uri= ["uri1"]
; keys= []
+ ; cbt_enabled= Some false
+ ; volume_type= Some Data
}
(** Check that we successfully parse the responses and
diff --git a/ocaml/xapi-storage/rpc-light/SR.ls/response b/ocaml/xapi-storage/rpc-light/SR.ls/response
index b85cff59c..7f989e330 100644
--- a/ocaml/xapi-storage/rpc-light/SR.ls/response
+++ b/ocaml/xapi-storage/rpc-light/SR.ls/response
@@ -12,6 +12,8 @@
<member><name>physical_utilisation</name><value>0</value></member>
<member><name>uri</name><value><array><data><value>uri1</value></data></array></value></member>
<member><name>keys</name><value><struct></struct></value></member>
+ <member><name>volume_type</name><value>Data</value></member>
+ <member><name>cbt_enabled</name><value>false</value></member>
</struct></value></data>
</array></value></member>
</struct></value></param></params>
diff --git a/ocaml/xapi-storage/rpc-light/Volume.clone/response b/ocaml/xapi-storage/rpc-light/Volume.clone/response
index 4b0f52b23..dc4036f59 100644
--- a/ocaml/xapi-storage/rpc-light/Volume.clone/response
+++ b/ocaml/xapi-storage/rpc-light/Volume.clone/response
@@ -11,6 +11,8 @@
<member><name>physical_utilisation</name><value>0</value></member>
<member><name>uri</name><value><array><data><value>uri1</value></data></array></value></member>
<member><name>keys</name><value><struct></struct></value></member>
+ <member><name>volume_type</name><value>Data</value></member>
+ <member><name>cbt_enabled</name><value>false</value></member>
</struct>
</value></member>
</struct></value></param>
diff --git a/ocaml/xapi-storage/rpc-light/Volume.create/response b/ocaml/xapi-storage/rpc-light/Volume.create/response
index 4b0f52b23..dc4036f59 100644
--- a/ocaml/xapi-storage/rpc-light/Volume.create/response
+++ b/ocaml/xapi-storage/rpc-light/Volume.create/response
@@ -11,6 +11,8 @@
<member><name>physical_utilisation</name><value>0</value></member>
<member><name>uri</name><value><array><data><value>uri1</value></data></array></value></member>
<member><name>keys</name><value><struct></struct></value></member>
+ <member><name>volume_type</name><value>Data</value></member>
+ <member><name>cbt_enabled</name><value>false</value></member>
</struct>
</value></member>
</struct></value></param>
diff --git a/ocaml/xapi-storage/rpc-light/Volume.snapshot/response b/ocaml/xapi-storage/rpc-light/Volume.snapshot/response
index 4b0f52b23..dc4036f59 100644
--- a/ocaml/xapi-storage/rpc-light/Volume.snapshot/response
+++ b/ocaml/xapi-storage/rpc-light/Volume.snapshot/response
@@ -11,6 +11,8 @@
<member><name>physical_utilisation</name><value>0</value></member>
<member><name>uri</name><value><array><data><value>uri1</value></data></array></value></member>
<member><name>keys</name><value><struct></struct></value></member>
+ <member><name>volume_type</name><value>Data</value></member>
+ <member><name>cbt_enabled</name><value>false</value></member>
</struct>
</value></member>
</struct></value></param>
diff --git a/ocaml/xapi-types/features.ml b/ocaml/xapi-types/features.ml
index 37fafc090..d55d7d01c 100644
--- a/ocaml/xapi-types/features.ml
+++ b/ocaml/xapi-types/features.ml
@@ -64,6 +64,7 @@ type feature =
| Updates
| Internal_repo_access
| VTPM
+ | VM_anti_affinity
[@@deriving rpc]
type orientation = Positive | Negative
@@ -132,6 +133,9 @@ let keys_of_features =
, ("restrict_internal_repo_access", Negative, "Internal_repo_access")
)
; (VTPM, ("restrict_vtpm", Negative, "VTPM"))
+ ; ( VM_anti_affinity
+ , ("restrict_vm_anti_affinity", Negative, "VM_anti_affinity")
+ )
]
(* A list of features that must be considered "enabled" by `of_assoc_list`
diff --git a/ocaml/xapi-types/features.mli b/ocaml/xapi-types/features.mli
index c2f1ed2a5..0696b3ddb 100644
--- a/ocaml/xapi-types/features.mli
+++ b/ocaml/xapi-types/features.mli
@@ -72,6 +72,7 @@ type feature =
| Internal_repo_access
(** Enable restriction on repository access to pool members only *)
| VTPM (** Support VTPM device required by Win11 guests *)
+ | VM_anti_affinity (** Enable use of VM anti-affinity placement *)
val feature_of_rpc : Rpc.t -> feature
(** Convert RPC into {!feature}s *)
diff --git a/ocaml/xapi/context.ml b/ocaml/xapi/context.ml
index 4179cf7d9..dce55ca4d 100644
--- a/ocaml/xapi/context.ml
+++ b/ocaml/xapi/context.ml
@@ -227,8 +227,64 @@ let parent_of_origin (origin : origin) span_name =
| _ ->
None
+let attribute_helper_fn f v = Option.fold ~none:[] ~some:f v
+
+let addr_port_of_sock s =
+ match s with
+ | None ->
+ (None, None)
+ | Some (Unix.ADDR_UNIX "") ->
+ (None, None)
+ | Some (Unix.ADDR_UNIX socket_name) ->
+ (Some socket_name, None)
+ | Some (Unix.ADDR_INET (addr, port)) ->
+ (Some (Unix.string_of_inet_addr addr), Some (string_of_int port))
+
+let with_try_get_addr f s =
+ (try Some (f s) with Unix.Unix_error (Unix.ENOTSOCK, _, _) -> None)
+ |> addr_port_of_sock
+
+let attr_of_fd s =
+ let peer_addr, peer_port = s |> with_try_get_addr Unix.getpeername in
+ let local_addr, local_port = s |> with_try_get_addr Unix.getsockname in
+ [
+ attribute_helper_fn
+ (fun addr -> [("network.local.address", addr)])
+ local_addr
+ ; attribute_helper_fn (fun port -> [("network.local.port", port)]) local_port
+ ; attribute_helper_fn (fun addr -> [("network.peer.address", addr)]) peer_addr
+ ; attribute_helper_fn (fun port -> [("network.peer.port", port)]) peer_port
+ ]
+ |> List.concat
+
+let attr_of_req (req : Http.Request.t) =
+ [
+ [
+ ("xs.xapi.task.origin", "http")
+ ; ("http.request.header.method", Http.string_of_method_t req.m)
+ ]
+ ; attribute_helper_fn
+ (fun user_agent -> [("http.request.header.user-agent", user_agent)])
+ req.user_agent
+ ; attribute_helper_fn
+ (fun content_type -> [("http.request.header.content-type", content_type)])
+ req.content_type
+ ; attribute_helper_fn
+ (fun content_length ->
+ [("http.request.body.size", Printf.sprintf "%Li" content_length)]
+ )
+ req.content_length
+ ; List.map
+ (fun (h, v) ->
+ ( h |> String.lowercase_ascii |> Printf.sprintf "http.request.header.%s"
+ , v
+ )
+ )
+ req.additional_headers
+ ]
+ |> List.concat
+
let make_attributes ?task_name ?task_id ?task_uuid ?session_id ?origin () =
- let attribute_helper_fn f v = Option.fold ~none:[] ~some:f v in
[
attribute_helper_fn
(fun task_name -> [("xs.xapi.task.name", task_name)])
@@ -249,8 +305,8 @@ let make_attributes ?task_name ?task_id ?task_uuid ?session_id ?origin () =
match origin with
| Internal ->
[("xs.xapi.task.origin", "internal")]
- | Http _ ->
- [("xs.xapi.task.origin", "http")]
+ | Http (req, s) ->
+ [attr_of_req req; attr_of_fd s] |> List.concat
)
origin
]
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/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_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/xenopsd/lib/xenops_utils.ml b/ocaml/xenopsd/lib/xenops_utils.ml
index 9a6ae66a9..d948f9865 100644
--- a/ocaml/xenopsd/lib/xenops_utils.ml
+++ b/ocaml/xenopsd/lib/xenops_utils.ml
@@ -584,7 +584,7 @@ let _sys_hypervisor_version_major = "/sys/hypervisor/version/major"
let _sys_hypervisor_version_minor = "/sys/hypervisor/version/minor"
type hypervisor =
- | Xen of string * string
+ | Xen of int * int
(* major, minor *)
| Other of string
@@ -601,7 +601,7 @@ let detect_hypervisor () =
let minor =
String.trim (Unixext.string_of_file _sys_hypervisor_version_minor)
in
- Some (Xen (major, minor))
+ Some (Xen (int_of_string major, int_of_string minor))
| x ->
Some (Other x)
else
diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml
index 4de4bbc35..2f60e3b27 100644
--- a/ocaml/xenopsd/xc/xenops_server_xen.ml
+++ b/ocaml/xenopsd/xc/xenops_server_xen.ml
@@ -5147,11 +5147,10 @@ let init () =
look_for_forkexec () ;
let major, minor = look_for_xen () in
look_for_xenctrl () ;
- if
- major < "4" || ((major = "4" && minor < "2") && !Xenopsd.run_hotplug_scripts)
+ if major < 4 || ((major = 4 && minor < 2) && !Xenopsd.run_hotplug_scripts)
then (
error
- "This is xen version %s.%s. On all versions < 4.1 we must use \
+ "This is xen version %d.%d. On all versions < 4.2 we must use \
hotplug/udev scripts"
major minor ;
error
diff --git a/python3/packages/observer.py b/python3/packages/observer.py
index 1eee0f2a7..b257aa9b3 100644
--- a/python3/packages/observer.py
+++ b/python3/packages/observer.py
@@ -71,7 +71,7 @@ def _get_configs_list(config_dir):
def read_config(config_path, header):
"""Read a config file and return a dictionary of key-value pairs."""
- parser = configparser.ConfigParser()
+ parser = configparser.ConfigParser(interpolation=None)
with open(config_path, encoding="utf-8") as config_file:
try:
parser.read_string(f"[{header}]\n{config_file.read()}")
diff --git a/quality-gate.sh b/quality-gate.sh
index 77238f4ab..01fdd3e40 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"
@@ -25,10 +25,10 @@ verify-cert () {
}
mli-files () {
- N=522
+ N=516
# do not count ml files from the tests in ocaml/{tests/perftest/quicktest}
- MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)
- MLS=$(git ls-files -- '**/*.ml' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)
+ MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)
+ MLS=$(git ls-files -- '**/*.ml' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)
num_mls_without_mlis=$(comm -23 <(sort <<<"$MLS") <(sort <<<"$MLIS") | wc -l)
if [ "$num_mls_without_mlis" -eq "$N" ]; then
echo "OK counted $num_mls_without_mlis .ml files without an .mli"
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 |
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.
The lock implementation for
protocol_asyncwas not correct, hence adding the test suggested by Edwin to trigger race.Test works by trying to acquire a standard Ocaml mutex in a critical section provided by the
with_lockimplementation. This means that any failed attempt to acquire the lock implies thewith_lockimplementation does not provide mutual exclusion.