Permalink
Browse files

Merge pull request #408 from robhoes/idl

Update Storage_interface clients to use new functor
  • Loading branch information...
djs55 committed Nov 29, 2011
2 parents 78dfed0 + 6be0cd2 commit 0bb53c60344818987b1645174bb13aa8edd54092
View
@@ -22,11 +22,14 @@ open Xmlrpc_client
let url = ref (Http.Url.File ({ Http.Url.path = "/var/xapi/storage" }, "/"))
+module RPC = struct
let rpc call =
XMLRPC_protocol.rpc ~transport:(transport_of_url !url)
~http:(xmlrpc ~version:"1.0" ?auth:(Http.Url.auth_of !url) (Http.Url.uri_of !url)) call
+end
open Storage_interface
+module Client = Client(RPC)
let task = "sm-cli"
@@ -52,14 +55,14 @@ let _ =
let args = List.filter (not ++ (String.startswith "url=")) args |> List.tl in
match args with
| [ "sr-list" ] ->
- let srs = Client.SR.list rpc ~task in
+ let srs = Client.SR.list ~task in
List.iter
(fun sr ->
Printf.printf "%s\n" sr
) srs
| [ "sr-scan"; sr ] ->
if Array.length Sys.argv < 3 then usage_and_exit ();
- begin match Client.SR.scan rpc ~task ~sr with
+ begin match Client.SR.scan ~task ~sr with
| Success (Vdis vs) ->
List.iter
(fun v ->
@@ -96,14 +99,14 @@ let _ =
then Some (String.sub k l (String.length k - l), v)
else None) kvpairs in
- begin match Client.VDI.create rpc ~task ~sr ~vdi_info ~params with
+ begin match Client.VDI.create ~task ~sr ~vdi_info ~params with
| Success (Vdi v) ->
Printf.printf "%s\n" (string_of_vdi_info v)
| x ->
Printf.fprintf stderr "Unexpected result: %s\n" (string_of_result x)
end
| [ "vdi-destroy"; sr; vdi ] ->
- begin match Client.VDI.destroy rpc ~task ~sr ~vdi with
+ begin match Client.VDI.destroy ~task ~sr ~vdi with
| Success Unit -> ()
| x ->
Printf.fprintf stderr "Unexpected result: %s\n" (string_of_result x)
View
@@ -30,6 +30,7 @@ let rpc call =
~http:(xmlrpc ~version:"1.0" "/") call
open Storage_interface
+module Client = Storage_interface.Client(struct let rpc = rpc end)
let task = "sm-test"
@@ -41,7 +42,7 @@ let usage_and_exit () =
exit 1
let find_vdi_in_scan sr vdi =
- match Client.SR.scan rpc ~task ~sr with
+ match Client.SR.scan ~task ~sr with
| Success (Vdis results) ->
begin
try
@@ -52,7 +53,7 @@ let find_vdi_in_scan sr vdi =
| x ->
failwith (Printf.sprintf "Unexpected result from SR.scan: %s\n" (string_of_result x))
-let test_query sr _ = let (_: query_result) = Client.query rpc () in ()
+let test_query sr _ = let (_: query_result) = Client.query () in ()
let missing_vdi = "missing"
@@ -62,7 +63,7 @@ let test_scan_missing_vdi sr _ =
| None -> ()
let test_destroy_missing_vdi sr _ =
- begin match Client.VDI.destroy rpc ~task ~sr ~vdi:missing_vdi with
+ begin match Client.VDI.destroy ~task ~sr ~vdi:missing_vdi with
| Failure Vdi_does_not_exist -> ()
| x -> failwith (Printf.sprintf "Unexpected result from VDI.destroy: %s\n" (string_of_result x))
end
@@ -104,7 +105,7 @@ let example_vdi_info =
let test_create_destroy sr _ =
let vdi_info = example_vdi_info in
- let vdi_info' = begin match Client.VDI.create rpc ~task ~sr ~vdi_info ~params:[] with
+ let vdi_info' = begin match Client.VDI.create ~task ~sr ~vdi_info ~params:[] with
| Success (Vdi vdi_info') ->
vdi_info_assert_equal vdi_info vdi_info';
vdi_info'
@@ -115,7 +116,7 @@ let test_create_destroy sr _ =
| None -> failwith (Printf.sprintf "SR.scan failed to find vdi: %s" (string_of_vdi_info vdi_info'))
| Some vdi_info'' -> vdi_info_assert_equal vdi_info' vdi_info''
end;
- begin match Client.VDI.destroy rpc ~task ~sr ~vdi:vdi_info'.vdi with
+ begin match Client.VDI.destroy ~task ~sr ~vdi:vdi_info'.vdi with
| Success Unit -> ()
| x -> failwith (Printf.sprintf "Unexpected result: %s\n" (string_of_result x))
end;
@@ -125,18 +126,18 @@ let test_create_destroy sr _ =
end
let test_attach_activate sr _ =
- let vdi_info = match Client.VDI.create rpc ~task ~sr ~vdi_info:example_vdi_info ~params:[] with
+ let vdi_info = match Client.VDI.create ~task ~sr ~vdi_info:example_vdi_info ~params:[] with
| Success (Vdi x) -> x
| x -> failwith (Printf.sprintf "Unexpected result: %s\n" (string_of_result x)) in
let dp = "test_attach_activate" in
- let (_: string) = match Client.VDI.attach rpc ~task ~sr ~dp ~vdi:vdi_info.vdi ~read_write:true with
+ let (_: string) = match Client.VDI.attach ~task ~sr ~dp ~vdi:vdi_info.vdi ~read_write:true with
| Success (Params x) -> x
| x -> failwith (Printf.sprintf "Unexpected result: %s\n" (string_of_result x)) in
- begin match Client.VDI.activate rpc ~task ~sr ~dp ~vdi:vdi_info.vdi with
+ begin match Client.VDI.activate ~task ~sr ~dp ~vdi:vdi_info.vdi with
| Success Unit -> ()
| x -> failwith (Printf.sprintf "Unexpected result: %s\n" (string_of_result x))
end;
- begin match Client.VDI.destroy rpc ~task ~sr ~vdi:vdi_info.vdi with
+ begin match Client.VDI.destroy ~task ~sr ~vdi:vdi_info.vdi with
| Success Unit -> ()
| x -> failwith (Printf.sprintf "Unexpected result: %s\n" (string_of_result x))
end
@@ -426,6 +426,8 @@ let unbind ~__context ~pbd =
let rpc call = Storage_mux.Server.process None call
+module Client = Client(struct let rpc = rpc end)
+
let start () =
let open Storage_impl.Local_domain_socket in
start Xapi_globs.storage_unix_domain_socket Storage_mux.Server.process
@@ -480,7 +482,8 @@ let of_vbd ~__context ~vbd ~domid =
let is_attached ~__context ~vbd ~domid =
let rpc, task, dp, sr, vdi = of_vbd ~__context ~vbd ~domid in
let open Vdi_automaton in
- match Client.VDI.stat rpc ~task ~sr ~vdi () with
+ let module C = Storage_interface.Client(struct let rpc = rpc end) in
+ match C.VDI.stat ~task ~sr ~vdi () with
| Success (Stat { superstate = Detached }) -> false
| Success _ -> true
| Failure _ as r -> error "Unable to query state of VDI: %s, %s" vdi (string_of_result r); false
@@ -489,7 +492,8 @@ let is_attached ~__context ~vbd ~domid =
useful for executing Storage_interface.Client.VDI functions *)
let on_vdi ~__context ~vbd ~domid f =
let rpc, task, dp, sr, vdi = of_vbd ~__context ~vbd ~domid in
- let dp = Client.DP.create rpc task dp in
+ let module C = Storage_interface.Client(struct let rpc = rpc end) in
+ let dp = C.DP.create task dp in
f rpc task dp sr vdi
let reset ~__context ~vm =
@@ -499,7 +503,7 @@ let reset ~__context ~vm =
let sr = Db.SR.get_uuid ~__context ~self:(Db.PBD.get_SR ~__context ~self:pbd) in
info "Resetting all state associated with SR: %s" sr;
expect_unit (fun () -> ())
- (Client.SR.reset rpc (Ref.string_of task) sr);
+ (Client.SR.reset (Ref.string_of task) sr);
Db.PBD.set_currently_attached ~__context ~self:pbd ~value:false;
) (System_domains.pbd_of_vm ~__context ~vm)
@@ -511,13 +515,14 @@ let attach_and_activate ~__context ~vbd ~domid ~hvm f =
let read_write = Db.VBD.get_mode ~__context ~self:vbd = `RW in
let result = on_vdi ~__context ~vbd ~domid
(fun rpc task dp sr vdi ->
+ let module C = Storage_interface.Client(struct let rpc = rpc end) in
expect_params
(fun path ->
expect_unit
(fun () ->
f path
- ) (Client.VDI.activate rpc task dp sr vdi)
- ) (Client.VDI.attach rpc task dp sr vdi read_write)
+ ) (C.VDI.activate task dp sr vdi)
+ ) (C.VDI.attach task dp sr vdi read_write)
) in
Qemu_blkfront.create ~__context ~self:vbd ~read_write hvm;
result
@@ -534,24 +539,25 @@ let deactivate_and_detach ~__context ~vbd ~domid ~unplug_frontends =
automatically detached and deactivated. *)
on_vdi ~__context ~vbd ~domid
(fun rpc task dp sr vdi ->
+ let module C = Storage_interface.Client(struct let rpc = rpc end) in
expect_unit (fun () -> ())
- (Client.DP.destroy rpc task dp false)
+ (C.DP.destroy task dp false)
)
let diagnostics ~__context =
expect_string (fun x -> x)
- (Storage_interface.Client.DP.diagnostics rpc ())
+ (Client.DP.diagnostics ())
let dp_destroy ~__context dp allow_leak =
let task = Context.get_task_id __context in
expect_unit (fun () -> ())
- (Client.DP.destroy rpc (Ref.string_of task) dp allow_leak)
+ (Client.DP.destroy (Ref.string_of task) dp allow_leak)
(* Set my PBD.currently_attached fields in the Pool database to match the local one *)
let resynchronise_pbds ~__context ~pbds =
let task = Context.get_task_id __context in
- let srs = Client.SR.list rpc (Ref.string_of task) in
+ let srs = Client.SR.list (Ref.string_of task) in
debug "Currently-attached SRs: [ %s ]" (String.concat "; " srs);
List.iter
(fun self ->
@@ -569,7 +575,7 @@ let resynchronise_pbds ~__context ~pbds =
(* This is a layering violation. The layers are:
xapi: has a pool-wide view
storage_impl: has a host-wide view of SRs and VDIs
- SM: has a SR-wide view
+ SM: has a SR-wide viep
Unfortunately the SM is storing some of its critical state (VDI-host locks) in the xapi
metadata rather than on the backend storage. The xapi metadata is generally not authoritative
and must be synchronised against the state of the world. Therefore we must synchronise the
@@ -620,14 +626,14 @@ let refresh_local_vdi_activations ~__context =
(fun () -> Hashtbl.replace Builtin_impl.VDI.vdi_read_write key (ro_rw = RW)) in
let task = Ref.string_of (Context.get_task_id __context) in
- let srs = Client.SR.list rpc task in
+ let srs = Client.SR.list task in
List.iter
(fun (vdi_ref, vdi_rec) ->
let sr = Db.SR.get_uuid ~__context ~self:vdi_rec.API.vDI_SR in
let vdi = vdi_rec.API.vDI_location in
if List.mem sr srs
then
- match Client.VDI.stat rpc ~task ~sr ~vdi () with
+ match Client.VDI.stat ~task ~sr ~vdi () with
| Success (Stat { superstate = Activated RO }) ->
lock_vdi (vdi_ref, vdi_rec) RO;
remember (sr, vdi) RO
@@ -666,11 +672,11 @@ let destroy_sr ~__context ~sr =
bind ~__context ~pbd;
let task = Ref.string_of (Context.get_task_id __context) in
expect_unit (fun () -> ())
- (Client.SR.attach rpc task (Db.SR.get_uuid ~__context ~self:sr) pbd_t.API.pBD_device_config);
+ (Client.SR.attach task (Db.SR.get_uuid ~__context ~self:sr) pbd_t.API.pBD_device_config);
(* The current backends expect the PBD to be temporarily set to currently_attached = true *)
Db.PBD.set_currently_attached ~__context ~self:pbd ~value:true;
expect_unit (fun () -> ())
- (Client.SR.destroy rpc task (Db.SR.get_uuid ~__context ~self:sr));
+ (Client.SR.destroy task (Db.SR.get_uuid ~__context ~self:sr));
(* All PBDs are clearly currently_attached = false now *)
Db.PBD.set_currently_attached ~__context ~self:pbd ~value:false;
unbind ~__context ~pbd
View
@@ -76,40 +76,64 @@ module Mux = struct
version = "0.1";
features = [];
}
-
module DP = struct
let create context ~task ~id = id (* XXX: is this pointless? *)
let destroy context ~task ~dp ~allow_leak =
(* Tell each plugin about this *)
- fail_or choose (multicast (Client.DP.destroy ~task ~dp ~allow_leak))
+ fail_or choose (multicast (fun rpc ->
+ let module C = Client(struct let rpc = rpc end) in
+ C.DP.destroy ~task ~dp ~allow_leak))
let diagnostics context () =
let combine results =
let all = List.fold_left (fun acc (sr, result) ->
Printf.sprintf "For SR: %s" sr :: (string_of_result result) :: acc) [] results in
Success (String (String.concat "\n" all)) in
- fail_or combine (multicast (fun rpc -> Client.DP.diagnostics rpc ()))
+ fail_or combine (multicast (fun rpc ->
+ let module C = Client(struct let rpc = rpc end) in
+ C.DP.diagnostics ()))
end
-
module SR = struct
- let attach context ~task ~sr = Client.SR.attach (of_sr sr) ~task ~sr
- let detach context ~task ~sr = Client.SR.detach (of_sr sr) ~task ~sr
- let destroy context ~task ~sr = Client.SR.destroy (of_sr sr) ~task ~sr
- let scan context ~task ~sr = Client.SR.scan (of_sr sr) ~task ~sr
+ let attach context ~task ~sr =
+ let module C = Client(struct let rpc = of_sr sr end) in
+ C.SR.attach ~task ~sr
+ let detach context ~task ~sr =
+ let module C = Client(struct let rpc = of_sr sr end) in
+ C.SR.detach ~task ~sr
+ let destroy context ~task ~sr =
+ let module C = Client(struct let rpc = of_sr sr end) in
+ C.SR.destroy ~task ~sr
+ let scan context ~task ~sr =
+ let module C = Client(struct let rpc = of_sr sr end) in
+ C.SR.scan ~task ~sr
let list context ~task =
- List.fold_left (fun acc (sr, list) -> list @ acc) [] (multicast (Client.SR.list ~task))
+ List.fold_left (fun acc (sr, list) -> list @ acc) [] (multicast (fun rpc ->
+ let module C = Client(struct let rpc = rpc end) in
+ C.SR.list ~task))
let reset context ~task ~sr = assert false
end
module VDI = struct
let create context ~task ~sr ~vdi_info ~params =
- Client.VDI.create (of_sr sr) ~task ~sr ~vdi_info ~params
-
- let stat context ~task ~sr ~vdi = Client.VDI.stat (of_sr sr) ~task ~sr ~vdi
- let destroy context ~task ~sr ~vdi = Client.VDI.destroy (of_sr sr) ~task ~sr ~vdi
+ let module C = Client(struct let rpc = of_sr sr end) in
+ C.VDI.create ~task ~sr ~vdi_info ~params
+
+ let stat context ~task ~sr ~vdi =
+ let module C = Client(struct let rpc = of_sr sr end) in
+ C.VDI.stat ~task ~sr ~vdi
+ let destroy context ~task ~sr ~vdi =
+ let module C = Client(struct let rpc = of_sr sr end) in
+ C.VDI.destroy ~task ~sr ~vdi
let attach context ~task ~dp ~sr ~vdi ~read_write =
- Client.VDI.attach (of_sr sr) ~task ~dp ~sr ~vdi ~read_write
- let activate context ~task ~dp ~sr ~vdi = Client.VDI.activate (of_sr sr) ~task ~dp ~sr ~vdi
- let deactivate context ~task ~dp ~sr ~vdi = Client.VDI.deactivate (of_sr sr) ~task ~dp ~sr ~vdi
- let detach context ~task ~dp ~sr ~vdi = Client.VDI.detach (of_sr sr) ~task ~dp ~sr ~vdi
+ let module C = Client(struct let rpc = of_sr sr end) in
+ C.VDI.attach ~task ~dp ~sr ~vdi ~read_write
+ let activate context ~task ~dp ~sr ~vdi =
+ let module C = Client(struct let rpc = of_sr sr end) in
+ C.VDI.activate ~task ~dp ~sr ~vdi
+ let deactivate context ~task ~dp ~sr ~vdi =
+ let module C = Client(struct let rpc = of_sr sr end) in
+ C.VDI.deactivate ~task ~dp ~sr ~vdi
+ let detach context ~task ~dp ~sr ~vdi =
+ let module C = Client(struct let rpc = of_sr sr end) in
+ C.VDI.detach ~task ~dp ~sr ~vdi
end
end
@@ -24,29 +24,31 @@ end
module Proxy = functor(RPC: RPC) -> struct
type context = Smint.request
- let query _ = Client.query RPC.rpc
+ module Client = Client(RPC)
+
+ let query _ = Client.query
module DP = struct
- let create _ = Client.DP.create RPC.rpc
- let destroy _ = Client.DP.destroy RPC.rpc
- let diagnostics _ = Client.DP.diagnostics RPC.rpc
+ let create _ = Client.DP.create
+ let destroy _ = Client.DP.destroy
+ let diagnostics _ = Client.DP.diagnostics
end
module SR = struct
- let attach _ = Client.SR.attach RPC.rpc
- let detach _ = Client.SR.detach RPC.rpc
- let reset _ = Client.SR.reset RPC.rpc
- let destroy _ = Client.SR.destroy RPC.rpc
- let scan _ = Client.SR.scan RPC.rpc
- let list _ = Client.SR.list RPC.rpc
+ let attach _ = Client.SR.attach
+ let detach _ = Client.SR.detach
+ let reset _ = Client.SR.reset
+ let destroy _ = Client.SR.destroy
+ let scan _ = Client.SR.scan
+ let list _ = Client.SR.list
end
module VDI = struct
- let attach _ = Client.VDI.attach RPC.rpc
- let activate _ = Client.VDI.activate RPC.rpc
- let deactivate _ = Client.VDI.deactivate RPC.rpc
- let detach _ = Client.VDI.detach RPC.rpc
+ let attach _ = Client.VDI.attach
+ let activate _ = Client.VDI.activate
+ let deactivate _ = Client.VDI.deactivate
+ let detach _ = Client.VDI.detach
- let stat _ = Client.VDI.stat RPC.rpc
+ let stat _ = Client.VDI.stat
- let create _ = Client.VDI.create RPC.rpc
- let destroy _ = Client.VDI.destroy RPC.rpc
+ let create _ = Client.VDI.create
+ let destroy _ = Client.VDI.destroy
end
end
@@ -146,7 +146,8 @@ let queryable ip port () =
let open Xmlrpc_client in
let rpc = XMLRPC_protocol.rpc ~transport:(TCP(ip, port)) ~http:(xmlrpc ~version:"1.0" "/") in
try
- let q = Storage_interface.Client.query rpc () in
+ let module C = Storage_interface.Client(struct let rpc = rpc end) in
+ let q = C.query () in
info "%s:%s:%s at %s:%d" q.Storage_interface.name q.Storage_interface.vendor q.Storage_interface.version ip port;
true
with _ -> false
Oops, something went wrong.

0 comments on commit 0bb53c6

Please sign in to comment.