1717
1818let with_lock = Xapi_stdext_threads.Threadext.Mutex. execute
1919
20- module D = Debug. Make (struct let name = " system_domains" end )
21-
22- open D
23-
2420(* * If a VM is a system domain then xapi will perform lifecycle operations on demand,
2521 and will allow this VM to start even if a host is disabled. *)
26- let system_domain_key = " is_system_domain"
27-
28- let bool_of_string x = try bool_of_string x with _ -> false
2922
30- let is_system_domain snapshot =
31- snapshot.API. vM_is_control_domain
32- ||
33- let oc = snapshot.API. vM_other_config in
34- List. mem_assoc system_domain_key oc
35- && bool_of_string (List. assoc system_domain_key oc)
23+ let is_system_domain snapshot = snapshot.API. vM_is_control_domain
24+ (* NOTE: code that recognises the other_config:is_system_domain key has been dropped *)
3625
3726let get_is_system_domain ~__context ~self =
3827 is_system_domain (Db.VM. get_record ~__context ~self )
3928
40- (* Notes on other_config keys: in the future these should become first-class fields.
41- For now note that although two threads may attempt to update these keys in parallel,
42- order shouldn't matter because everyone will always update them to the same value.
43- It's therefore safe to throw away exceptions. *)
44-
45- let set_is_system_domain ~__context ~self ~value =
46- Helpers. log_exn_continue
47- (Printf. sprintf " set_is_system_domain self = %s" (Ref. string_of self))
48- (fun () ->
49- Db.VM. remove_from_other_config ~__context ~self ~key: system_domain_key ;
50- Db.VM. add_to_other_config ~__context ~self ~key: system_domain_key ~value
51- )
52- ()
53-
54- (* * If a VM is a driver domain then it hosts backends for either disk or network
55- devices. We link PBD.other_config:storage_driver_domain_key to
56- VM.other_config:storage_driver_domain_key and we ensure the VM is marked as
57- a system domain. *)
58- let storage_driver_domain_key = " storage_driver_domain"
59-
60- let pbd_set_storage_driver_domain ~__context ~self ~value =
61- Helpers. log_exn_continue
62- (Printf. sprintf " pbd_set_storage_driver_domain self = %s"
63- (Ref. string_of self)
64- )
65- (fun () ->
66- Db.PBD. remove_from_other_config ~__context ~self
67- ~key: storage_driver_domain_key ;
68- Db.PBD. add_to_other_config ~__context ~self ~key: storage_driver_domain_key
69- ~value
70- )
71- ()
72-
73- let vm_set_storage_driver_domain ~__context ~self ~value =
74- Helpers. log_exn_continue
75- (Printf. sprintf " vm_set_storage_driver_domain self = %s" (Ref. string_of self)
76- )
77- (fun () ->
78- Db.VM. remove_from_other_config ~__context ~self
79- ~key: storage_driver_domain_key ;
80- Db.VM. add_to_other_config ~__context ~self ~key: storage_driver_domain_key
81- ~value
82- )
83- ()
84-
85- let record_pbd_storage_driver_domain ~__context ~pbd ~domain =
86- set_is_system_domain ~__context ~self: domain ~value: " true" ;
87- pbd_set_storage_driver_domain ~__context ~self: pbd
88- ~value: (Ref. string_of domain) ;
89- vm_set_storage_driver_domain ~__context ~self: domain ~value: (Ref. string_of pbd)
90-
91- let pbd_of_vm ~__context ~vm =
92- let other_config = Db.VM. get_other_config ~__context ~self: vm in
93- if List. mem_assoc storage_driver_domain_key other_config then
94- Some (Ref. of_string (List. assoc storage_driver_domain_key other_config))
95- else
96- None
97-
98- let storage_driver_domain_of_pbd ~__context ~pbd =
99- let other_config = Db.PBD. get_other_config ~__context ~self: pbd in
100- let dom0 = Helpers. get_domain_zero ~__context in
101- if List. mem_assoc storage_driver_domain_key other_config then (
102- let v = List. assoc storage_driver_domain_key other_config in
103- if Db. is_valid_ref __context (Ref. of_string v) then
104- Ref. of_string v
105- else
106- try Db.VM. get_by_uuid ~__context ~uuid: v
107- with _ ->
108- error " PBD %s has invalid %s key: falling back to dom0"
109- (Ref. string_of pbd) storage_driver_domain_key ;
110- dom0
111- ) else
112- dom0
113-
114- let storage_driver_domain_of_pbd ~__context ~pbd =
115- let domain = storage_driver_domain_of_pbd ~__context ~pbd in
116- set_is_system_domain ~__context ~self: domain ~value: " true" ;
117- pbd_set_storage_driver_domain ~__context ~self: pbd
118- ~value: (Ref. string_of domain) ;
119- vm_set_storage_driver_domain ~__context ~self: domain ~value: (Ref. string_of pbd) ;
120- domain
121-
122- let storage_driver_domain_of_vbd ~__context ~vbd =
123- let dom0 = Helpers. get_domain_zero ~__context in
124- let vdi = Db.VBD. get_VDI ~__context ~self: vbd in
125- if Db. is_valid_ref __context vdi then
126- let sr = Db.VDI. get_SR ~__context ~self: vdi in
127- let sr_pbds = Db.SR. get_PBDs ~__context ~self: sr in
128- let my_pbds = List. map fst (Helpers. get_my_pbds __context) in
129- match Xapi_stdext_std.Listext.List. intersect sr_pbds my_pbds with
130- | pbd :: _ ->
131- storage_driver_domain_of_pbd ~__context ~pbd
132- | _ ->
133- dom0
134- else
135- dom0
136-
137- let storage_driver_domain_of_sr_type ~__context ~_type =
138- let dom0 = Helpers. get_domain_zero ~__context in
139- dom0
140-
141- let is_in_use ~__context ~self =
142- let other_config = Db.VM. get_other_config ~__context ~self in
143- List. mem_assoc storage_driver_domain_key other_config
144- &&
145- let pbd = Ref. of_string (List. assoc storage_driver_domain_key other_config) in
146- if Db. is_valid_ref __context pbd then
147- Db.PBD. get_currently_attached ~__context ~self: pbd
148- else
149- false
150-
151- let queryable ~__context transport () =
152- let open Xmlrpc_client in
153- let tracing = Context. set_client_span __context in
154- let http = xmlrpc ~version: " 1.0" " /" in
155- let http = Helpers.TraceHelper. inject_span_into_req tracing http in
156- let rpc =
157- XMLRPC_protocol. rpc ~srcstr: " xapi" ~dststr: " remote_smapiv2" ~transport ~http
158- in
159- let listMethods = Rpc. call " system.listMethods" [] in
160- try
161- let _ = rpc listMethods in
162- info " XMLRPC service found at %s" (string_of_transport transport) ;
163- true
164- with e ->
165- debug " Temporary failure querying storage service on %s: %s"
166- (string_of_transport transport)
167- (Printexc. to_string e) ;
168- false
29+ (* NOTE: the storage domain functionality used to be based on
30+ other-config:storage_driver_domain, which has been dropped *)
31+
32+ let pbd_of_vm ~__context :_ ~vm:_ = None
33+
34+ let storage_driver_domain_of_pbd ~__context ~pbd :_ =
35+ Helpers. get_domain_zero ~__context
36+
37+ let storage_driver_domain_of_vbd ~__context ~vbd :_ =
38+ Helpers. get_domain_zero ~__context
39+
40+ let storage_driver_domain_of_sr_type ~__context ~_type :_ =
41+ Helpers. get_domain_zero ~__context
16942
17043type service = {uuid : string ; ty : string ; instance : string ; url : string }
17144[@@ deriving rpc ]
@@ -186,11 +59,6 @@ let unregister_service service =
18659 Hashtbl. remove service_to_queue service
18760 )
18861
189- let get_service service =
190- with_lock service_to_queue_m (fun () ->
191- Hashtbl. find_opt service_to_queue service
192- )
193-
19462let list_services () =
19563 with_lock service_to_queue_m (fun () ->
19664 Hashtbl. fold (fun service _ acc -> service :: acc) service_to_queue []
0 commit comments