Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
162 changes: 15 additions & 147 deletions ocaml/xapi/system_domains.ml
Original file line number Diff line number Diff line change
Expand Up @@ -17,155 +17,28 @@

let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute

module D = Debug.Make (struct let name = "system_domains" end)

open D

(** If a VM is a system domain then xapi will perform lifecycle operations on demand,
and will allow this VM to start even if a host is disabled. *)
let system_domain_key = "is_system_domain"

let bool_of_string x = try bool_of_string x with _ -> false

let is_system_domain snapshot =
snapshot.API.vM_is_control_domain
||
let oc = snapshot.API.vM_other_config in
List.mem_assoc system_domain_key oc
&& bool_of_string (List.assoc system_domain_key oc)
let is_system_domain snapshot = snapshot.API.vM_is_control_domain
(* NOTE: code that recognises the other_config:is_system_domain key has been dropped *)

let get_is_system_domain ~__context ~self =
is_system_domain (Db.VM.get_record ~__context ~self)

(* Notes on other_config keys: in the future these should become first-class fields.
For now note that although two threads may attempt to update these keys in parallel,
order shouldn't matter because everyone will always update them to the same value.
It's therefore safe to throw away exceptions. *)

let set_is_system_domain ~__context ~self ~value =
Helpers.log_exn_continue
(Printf.sprintf "set_is_system_domain self = %s" (Ref.string_of self))
(fun () ->
Db.VM.remove_from_other_config ~__context ~self ~key:system_domain_key ;
Db.VM.add_to_other_config ~__context ~self ~key:system_domain_key ~value
)
()

(** If a VM is a driver domain then it hosts backends for either disk or network
devices. We link PBD.other_config:storage_driver_domain_key to
VM.other_config:storage_driver_domain_key and we ensure the VM is marked as
a system domain. *)
let storage_driver_domain_key = "storage_driver_domain"

let pbd_set_storage_driver_domain ~__context ~self ~value =
Helpers.log_exn_continue
(Printf.sprintf "pbd_set_storage_driver_domain self = %s"
(Ref.string_of self)
)
(fun () ->
Db.PBD.remove_from_other_config ~__context ~self
~key:storage_driver_domain_key ;
Db.PBD.add_to_other_config ~__context ~self ~key:storage_driver_domain_key
~value
)
()

let vm_set_storage_driver_domain ~__context ~self ~value =
Helpers.log_exn_continue
(Printf.sprintf "vm_set_storage_driver_domain self = %s" (Ref.string_of self)
)
(fun () ->
Db.VM.remove_from_other_config ~__context ~self
~key:storage_driver_domain_key ;
Db.VM.add_to_other_config ~__context ~self ~key:storage_driver_domain_key
~value
)
()

let record_pbd_storage_driver_domain ~__context ~pbd ~domain =
set_is_system_domain ~__context ~self:domain ~value:"true" ;
pbd_set_storage_driver_domain ~__context ~self:pbd
~value:(Ref.string_of domain) ;
vm_set_storage_driver_domain ~__context ~self:domain ~value:(Ref.string_of pbd)

let pbd_of_vm ~__context ~vm =
let other_config = Db.VM.get_other_config ~__context ~self:vm in
if List.mem_assoc storage_driver_domain_key other_config then
Some (Ref.of_string (List.assoc storage_driver_domain_key other_config))
else
None

let storage_driver_domain_of_pbd ~__context ~pbd =
let other_config = Db.PBD.get_other_config ~__context ~self:pbd in
let dom0 = Helpers.get_domain_zero ~__context in
if List.mem_assoc storage_driver_domain_key other_config then (
let v = List.assoc storage_driver_domain_key other_config in
if Db.is_valid_ref __context (Ref.of_string v) then
Ref.of_string v
else
try Db.VM.get_by_uuid ~__context ~uuid:v
with _ ->
error "PBD %s has invalid %s key: falling back to dom0"
(Ref.string_of pbd) storage_driver_domain_key ;
dom0
) else
dom0

let storage_driver_domain_of_pbd ~__context ~pbd =
let domain = storage_driver_domain_of_pbd ~__context ~pbd in
set_is_system_domain ~__context ~self:domain ~value:"true" ;
pbd_set_storage_driver_domain ~__context ~self:pbd
~value:(Ref.string_of domain) ;
vm_set_storage_driver_domain ~__context ~self:domain ~value:(Ref.string_of pbd) ;
domain

let storage_driver_domain_of_vbd ~__context ~vbd =
let dom0 = Helpers.get_domain_zero ~__context in
let vdi = Db.VBD.get_VDI ~__context ~self:vbd in
if Db.is_valid_ref __context vdi then
let sr = Db.VDI.get_SR ~__context ~self:vdi in
let sr_pbds = Db.SR.get_PBDs ~__context ~self:sr in
let my_pbds = List.map fst (Helpers.get_my_pbds __context) in
match Xapi_stdext_std.Listext.List.intersect sr_pbds my_pbds with
| pbd :: _ ->
storage_driver_domain_of_pbd ~__context ~pbd
| _ ->
dom0
else
dom0

let storage_driver_domain_of_sr_type ~__context ~_type =
let dom0 = Helpers.get_domain_zero ~__context in
dom0

let is_in_use ~__context ~self =
let other_config = Db.VM.get_other_config ~__context ~self in
List.mem_assoc storage_driver_domain_key other_config
&&
let pbd = Ref.of_string (List.assoc storage_driver_domain_key other_config) in
if Db.is_valid_ref __context pbd then
Db.PBD.get_currently_attached ~__context ~self:pbd
else
false

let queryable ~__context transport () =
let open Xmlrpc_client in
let tracing = Context.set_client_span __context in
let http = xmlrpc ~version:"1.0" "/" in
let http = Helpers.TraceHelper.inject_span_into_req tracing http in
let rpc =
XMLRPC_protocol.rpc ~srcstr:"xapi" ~dststr:"remote_smapiv2" ~transport ~http
in
let listMethods = Rpc.call "system.listMethods" [] in
try
let _ = rpc listMethods in
info "XMLRPC service found at %s" (string_of_transport transport) ;
true
with e ->
debug "Temporary failure querying storage service on %s: %s"
(string_of_transport transport)
(Printexc.to_string e) ;
false
(* NOTE: the storage domain functionality used to be based on
other-config:storage_driver_domain, which has been dropped *)

let pbd_of_vm ~__context:_ ~vm:_ = None

let storage_driver_domain_of_pbd ~__context ~pbd:_ =
Helpers.get_domain_zero ~__context

let storage_driver_domain_of_vbd ~__context ~vbd:_ =
Helpers.get_domain_zero ~__context

let storage_driver_domain_of_sr_type ~__context ~_type:_ =
Helpers.get_domain_zero ~__context

type service = {uuid: string; ty: string; instance: string; url: string}
[@@deriving rpc]
Expand All @@ -186,11 +59,6 @@ let unregister_service service =
Hashtbl.remove service_to_queue service
)

let get_service service =
with_lock service_to_queue_m (fun () ->
Hashtbl.find_opt service_to_queue service
)

let list_services () =
with_lock service_to_queue_m (fun () ->
Hashtbl.fold (fun service _ acc -> service :: acc) service_to_queue []
Expand Down
14 changes: 0 additions & 14 deletions ocaml/xapi/system_domains.mli
Original file line number Diff line number Diff line change
Expand Up @@ -31,11 +31,6 @@ val storage_driver_domain_of_vbd :
(** [storage_driver_domain_of_vbd __context pbd] returns the VM which is hosting
the storage backends for [vbd] on this host *)

val record_pbd_storage_driver_domain :
__context:Context.t -> pbd:API.ref_PBD -> domain:API.ref_VM -> unit
(** [record_pbd_storage_driver_domain __context pbd domain] persists [domain]
as the driver domain for [pbd]. *)

val storage_driver_domain_of_sr_type :
__context:Context.t -> _type:string -> API.ref_VM
(** [storage_driver_domain_of_sr_type __context _type] returns the default VM which is hosting
Expand All @@ -45,12 +40,6 @@ val pbd_of_vm : __context:Context.t -> vm:API.ref_VM -> API.ref_PBD option
(** [pbd_of_vm __context vm] returns (Some pbd) if [vm] is a driver domain
for [pbd] and None otherwise. *)

val is_in_use : __context:Context.t -> self:API.ref_VM -> bool
(** [is_in_use __context self] returns true if [self] is in use as a system domain *)

val queryable : __context:Context.t -> Xmlrpc_client.transport -> unit -> bool
(** [queryable ip port ()] returns true if [ip]:[port] responsds to an XMLRPC query *)

(** One of many service running in a driver domain *)
type service = {uuid: string; ty: string; instance: string; url: string}

Expand All @@ -70,8 +59,5 @@ val register_service : service -> string -> unit
val unregister_service : service -> unit
(** [unregister_service service] forgets service [service] *)

val get_service : service -> string option
(** [get_service_address service] returns the queue_name associated with [service] or None *)

val list_services : unit -> services
(** [list_services ()] returns all the registered services *)
2 changes: 0 additions & 2 deletions ocaml/xapi/xapi_globs.ml
Original file line number Diff line number Diff line change
Expand Up @@ -242,8 +242,6 @@ let vbd_polling_idle_threshold_key = "polling-idle-threshold"

(* set in VBD other-config *)

let vbd_backend_local_key = "backend-local" (* set in VBD other-config *)

let mac_seed = "mac_seed" (* set in a VM to generate MACs by hash chaining *)

let ( ** ) = Int64.mul
Expand Down
11 changes: 1 addition & 10 deletions ocaml/xapi/xapi_xenops.ml
Original file line number Diff line number Diff line change
Expand Up @@ -678,16 +678,7 @@ module MD = struct
)
)
in
let backend_of_vbd vbd =
let vbd_oc = vbd.API.vBD_other_config in
if List.mem_assoc Xapi_globs.vbd_backend_local_key vbd_oc then (
let path = List.assoc Xapi_globs.vbd_backend_local_key vbd_oc in
warn "Using local override for VBD backend: %s -> %s" vbd.API.vBD_uuid
path ;
Some (Local path)
) else
disk_of_vdi ~__context ~self:vbd.API.vBD_VDI
in
let backend_of_vbd vbd = disk_of_vdi ~__context ~self:vbd.API.vBD_VDI in
let can_attach_early =
let sr_opt =
try Some (Db.VDI.get_SR ~__context ~self:vbd.API.vBD_VDI)
Expand Down
Loading