diff --git a/CHANGES b/CHANGES index c5a6f5f..3d8c8cc 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,6 @@ +0.3.0 (24-Apr-2015) +- Update to message-switch.0.11.0 + 0.2.0 (4-Apr-2015) - Update to SMAPIv2 with o_direct, o_direct_reason - Update to using json marshalling for exception backtraces diff --git a/VERSION b/VERSION index 0ea3a94..0d91a54 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.2.0 +0.3.0 diff --git a/_oasis b/_oasis index 7132500..a518c61 100644 --- a/_oasis +++ b/_oasis @@ -1,6 +1,6 @@ OASISFormat: 0.2 Name: xapi-script-storage -Version: 0.1 +Version: 0.3 Synopsis: Adapter which allows xapi to call storage scripts Authors: David Scott License: LGPL-2.1 with OCaml linking exception @@ -13,4 +13,4 @@ Executable xapi_script_storage MainIs: main.ml Custom: true Install: false - BuildDepends: xcp, xcp.storage, async_inotify, threads, message_switch.async, rpclib, xapi-storage, sexplib, sexplib.syntax, rpclib, rpclib.syntax + BuildDepends: xcp, xcp.storage, async_inotify, threads, message_switch.async (>= 0.11.0), rpclib, xapi-storage, sexplib, sexplib.syntax, rpclib, rpclib.syntax diff --git a/main.ml b/main.ml index 21585b3..448db85 100644 --- a/main.ml +++ b/main.ml @@ -450,24 +450,38 @@ let process root_dir name x = (* Active servers, one per sub-directory of the root_dir *) let servers = String.Table.create () ~size:4 -let create switch_port root_dir name = +(* XXX: need a better error-handling strategy *) +let get_ok = function + | `Ok x -> x + | `Error e -> + let b = Buffer.create 16 in + let fmt = Format.formatter_of_buffer b in + Protocol_unix.Server.pp_error fmt e; + Format.pp_print_flush fmt (); + failwith (Buffer.contents b) + +let create switch_path root_dir name = if Hashtbl.mem servers name then return () else begin info "Adding %s" name >>= fun () -> - Protocol_async.M.connect switch_port >>= fun c -> - let server = Protocol_async.Server.listen (process root_dir name) c (Filename.basename name) in + Protocol_async.Server.listen ~process:(process root_dir name) ~switch:switch_path ~queue:(Filename.basename name) () + >>= fun result -> + let server = get_ok result in Hashtbl.add_exn servers name server; return () end -let destroy switch_port name = +let destroy switch_path name = info "Removing %s" name >>= fun () -> - Protocol_async.M.connect switch_port >>= fun c -> - Hashtbl.remove servers name; - return () + if Hashtbl.mem servers name then begin + let t = Hashtbl.find_exn servers name in + Protocol_async.Server.shutdown ~t () >>= fun () -> + Hashtbl.remove servers name; + return () + end else return () let rec diff a b = match a with | [] -> [] @@ -475,21 +489,21 @@ let rec diff a b = match a with if List.mem b a then diff aa b else a :: (diff aa b) (* Ensure the right servers are started *) -let sync ~root_dir ~switch_port = +let sync ~root_dir ~switch_path = Sys.readdir root_dir >>= fun names -> let needed : string list = Array.to_list names in let got_already : string list = Hashtbl.keys servers in - Deferred.all_ignore (List.map ~f:(create switch_port root_dir) (diff needed got_already)) + Deferred.all_ignore (List.map ~f:(create switch_path root_dir) (diff needed got_already)) >>= fun () -> - Deferred.all_ignore (List.map ~f:(destroy switch_port) (diff got_already needed)) + Deferred.all_ignore (List.map ~f:(destroy switch_path) (diff got_already needed)) -let main ~root_dir ~switch_port = +let main ~root_dir ~switch_path = (* We watch and create queues for the Volume plugins only *) let root_dir = Filename.concat root_dir "volume" in Async_inotify.create ~recursive:false ~watch_new_dirs:false root_dir >>= fun (watch, _) -> - sync ~root_dir ~switch_port + sync ~root_dir ~switch_path >>= fun () -> let pipe = Async_inotify.pipe watch in let open Async_inotify.Event in @@ -501,24 +515,24 @@ let main ~root_dir ~switch_port = Shutdown.exit 1 | `Ok (Created path) | `Ok (Moved (Into path)) -> - create switch_port root_dir (Filename.basename path) + create switch_path root_dir (Filename.basename path) | `Ok (Unlinked path) | `Ok (Moved (Away path)) -> - destroy switch_port (Filename.basename path) + destroy switch_path (Filename.basename path) | `Ok (Modified _) -> return () | `Ok (Moved (Move (path_a, path_b))) -> - destroy switch_port (Filename.basename path_a) + destroy switch_path (Filename.basename path_a) >>= fun () -> - create switch_port root_dir (Filename.basename path_b) + create switch_path root_dir (Filename.basename path_b) | `Ok Queue_overflow -> - sync ~root_dir ~switch_port + sync ~root_dir ~switch_path ) >>= fun () -> loop () in loop () -let main ~root_dir ~switch_port = - let (_: unit Deferred.t) = main ~root_dir ~switch_port in +let main ~root_dir ~switch_path = + let (_: unit Deferred.t) = main ~root_dir ~switch_path in never_returns (Scheduler.go ()) open Xcp_service @@ -558,5 +572,5 @@ let _ = use_syslog := true; Core.Syslog.openlog ~id:"xapi-storage-script" ~facility:Core.Syslog.Facility.DAEMON (); end; - main ~root_dir:!root_dir ~switch_port:!Xcp_client.switch_port + main ~root_dir:!root_dir ~switch_path:!Xcp_client.switch_path diff --git a/setup.ml b/setup.ml index 2baac48..5d35a58 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.4.4 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 357e519346d191c046f831856e592460) *) +(* DO NOT EDIT (digest: 2cebb0f2ebccebc1740714c72972c587) *) (* Regenerated by OASIS v0.4.5 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6673,7 +6673,7 @@ let setup_t = alpha_features = []; beta_features = []; name = "xapi-script-storage"; - version = "0.1"; + version = "0.3"; license = OASISLicense.DEP5License (OASISLicense.DEP5Unit @@ -6743,7 +6743,9 @@ let setup_t = FindlibPackage ("xcp.storage", None); FindlibPackage ("async_inotify", None); FindlibPackage ("threads", None); - FindlibPackage ("message_switch.async", None); + FindlibPackage + ("message_switch.async", + Some (OASISVersion.VGreaterEqual "0.11.0")); FindlibPackage ("rpclib", None); FindlibPackage ("xapi-storage", None); FindlibPackage ("sexplib", None); @@ -6770,7 +6772,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.5"; - oasis_digest = Some "#8c\151\238J\181\240\231Z\r\141PQ\248h"; + oasis_digest = Some "\223w\129*\2508n\224(\131\015\249\232\225\232\031"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -6778,6 +6780,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 6782 "setup.ml" +# 6784 "setup.ml" (* OASIS_STOP *) let () = setup ();;