Merge pull request #141 from simonjbeaumont/cp-13469

CP-13469: upgrade/downgrade: Accept `--pvpath` argument and use `flock()`

Author: simonjbeaumont

.travis.oasis

@@ -20,7 +20,7 @@ Library xenvmidl
   Path:               idl
   Findlibname:        xenvmidl
   Modules:            Xenvm_interface, Xenvm_client, Log, Result, Errors, ResizeRequest, ResizeResponse, Pidfile
-  BuildDepends:       rpclib, rpclib.syntax, sexplib, sexplib.syntax, lvm, cohttp.lwt, threads, mirage-block-unix, devmapper, bisect
+  BuildDepends:       rpclib, rpclib.syntax, sexplib, sexplib.syntax, lvm, cohttp.lwt, threads, mirage-block-unix, devmapper, core, bisect
 
 Executable "xenvmd"
   ByteOpt:            -warn-error +a

_oasis

@@ -20,7 +20,7 @@ Library xenvmidl
   Path:               idl
   Findlibname:        xenvmidl
   Modules:            Xenvm_interface, Xenvm_client, Log, Result, Errors, ResizeRequest, ResizeResponse, Pidfile
-  BuildDepends:       rpclib, rpclib.syntax, sexplib, sexplib.syntax, lvm, cohttp.lwt, threads, mirage-block-unix, devmapper
+  BuildDepends:       rpclib, rpclib.syntax, sexplib, sexplib.syntax, lvm, cohttp.lwt, threads, mirage-block-unix, devmapper, core
 
 Executable "xenvmd"
   ByteOpt:            -warn-error +a

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: 2190fe0a8a00a6b8cc32c1b1dff4f3d1)
+# DO NOT EDIT (digest: 00f88924b9b0edd9fbbc611789a0ccdc)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -21,6 +21,7 @@ true: annot, bin_annot
 <idl/xenvmidl.{cma,cmxa}>: oasis_library_xenvmidl_native
 <idl/*.ml{,i,y}>: oasis_library_xenvmidl_native
 <idl/*.ml{,i,y}>: pkg_cohttp.lwt
+<idl/*.ml{,i,y}>: pkg_core
 <idl/*.ml{,i,y}>: pkg_devmapper
 <idl/*.ml{,i,y}>: pkg_lvm
 <idl/*.ml{,i,y}>: pkg_mirage-block-unix
@@ -36,6 +37,7 @@ true: annot, bin_annot
 <xenvmd/*.ml{,i,y}>: oasis_executable_xenvmd_native
 <xenvmd/xenvmd.{native,byte}>: pkg_cmdliner
 <xenvmd/xenvmd.{native,byte}>: pkg_cohttp.lwt
+<xenvmd/xenvmd.{native,byte}>: pkg_core
 <xenvmd/xenvmd.{native,byte}>: pkg_cstruct
 <xenvmd/xenvmd.{native,byte}>: pkg_devmapper
 <xenvmd/xenvmd.{native,byte}>: pkg_io-page
@@ -57,6 +59,7 @@ true: annot, bin_annot
 <xenvmd/xenvmd.{native,byte}>: use_xenvmidl
 <xenvmd/*.ml{,i,y}>: pkg_cmdliner
 <xenvmd/*.ml{,i,y}>: pkg_cohttp.lwt
+<xenvmd/*.ml{,i,y}>: pkg_core
 <xenvmd/*.ml{,i,y}>: pkg_cstruct
 <xenvmd/*.ml{,i,y}>: pkg_devmapper
 <xenvmd/*.ml{,i,y}>: pkg_io-page
@@ -84,6 +87,7 @@ true: annot, bin_annot
 <xenvm/*.ml{,i,y}>: oasis_executable_xenvm_native
 <xenvm/xenvm.{native,byte}>: pkg_cmdliner
 <xenvm/xenvm.{native,byte}>: pkg_cohttp.lwt
+<xenvm/xenvm.{native,byte}>: pkg_core
 <xenvm/xenvm.{native,byte}>: pkg_devmapper
 <xenvm/xenvm.{native,byte}>: pkg_io-page.unix
 <xenvm/xenvm.{native,byte}>: pkg_lvm
@@ -100,6 +104,7 @@ true: annot, bin_annot
 <xenvm/xenvm.{native,byte}>: use_xenvmidl
 <xenvm/*.ml{,i,y}>: pkg_cmdliner
 <xenvm/*.ml{,i,y}>: pkg_cohttp.lwt
+<xenvm/*.ml{,i,y}>: pkg_core
 <xenvm/*.ml{,i,y}>: pkg_devmapper
 <xenvm/*.ml{,i,y}>: pkg_io-page.unix
 <xenvm/*.ml{,i,y}>: pkg_lvm
@@ -122,6 +127,7 @@ true: annot, bin_annot
 <xenvm-local-allocator/*.ml{,i,y}>: oasis_executable_xenvm_local_allocator_native
 <xenvm-local-allocator/local_allocator.{native,byte}>: pkg_cmdliner
 <xenvm-local-allocator/local_allocator.{native,byte}>: pkg_cohttp.lwt
+<xenvm-local-allocator/local_allocator.{native,byte}>: pkg_core
 <xenvm-local-allocator/local_allocator.{native,byte}>: pkg_cstruct
 <xenvm-local-allocator/local_allocator.{native,byte}>: pkg_devmapper
 <xenvm-local-allocator/local_allocator.{native,byte}>: pkg_io-page
@@ -142,6 +148,7 @@ true: annot, bin_annot
 <xenvm-local-allocator/local_allocator.{native,byte}>: use_xenvmidl
 <xenvm-local-allocator/*.ml{,i,y}>: pkg_cmdliner
 <xenvm-local-allocator/*.ml{,i,y}>: pkg_cohttp.lwt
+<xenvm-local-allocator/*.ml{,i,y}>: pkg_core
 <xenvm-local-allocator/*.ml{,i,y}>: pkg_cstruct
 <xenvm-local-allocator/*.ml{,i,y}>: pkg_devmapper
 <xenvm-local-allocator/*.ml{,i,y}>: pkg_io-page
@@ -168,6 +175,7 @@ true: annot, bin_annot
 <test/*.ml{,i,y}>: oasis_executable_test_native
 <test/test.{native,byte}>: pkg_cmdliner
 <test/test.{native,byte}>: pkg_cohttp.lwt
+<test/test.{native,byte}>: pkg_core
 <test/test.{native,byte}>: pkg_cstruct
 <test/test.{native,byte}>: pkg_devmapper
 <test/test.{native,byte}>: pkg_io-page
@@ -188,6 +196,7 @@ true: annot, bin_annot
 <test/test.{native,byte}>: use_xenvmidl
 <test/*.ml{,i,y}>: pkg_cmdliner
 <test/*.ml{,i,y}>: pkg_cohttp.lwt
+<test/*.ml{,i,y}>: pkg_core
 <test/*.ml{,i,y}>: pkg_cstruct
 <test/*.ml{,i,y}>: pkg_devmapper
 <test/*.ml{,i,y}>: pkg_io-page

idl/META

@@ -1,9 +1,9 @@
 # OASIS_START
-# DO NOT EDIT (digest: c3cccf80e07baf5d9f5c7f24da44c61d)
+# DO NOT EDIT (digest: 363ecfeb8dd4c7e3e2f68952ef269e7c)
 version = "0.1"
 description = "LVM-like volume manager supporting thinly provisioned LVs"
 requires =
-"rpclib rpclib.syntax sexplib sexplib.syntax lvm cohttp.lwt threads mirage-block-unix devmapper"
+"rpclib rpclib.syntax sexplib sexplib.syntax lvm cohttp.lwt threads mirage-block-unix devmapper core"
 archive(byte) = "xenvmidl.cma"
 archive(byte, plugin) = "xenvmidl.cma"
 archive(native) = "xenvmidl.cmxa"

idl/flock.ml

@@ -0,0 +1,28 @@
+(*
+ * Copyright (C) 2015 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+open Core.Std
+
+exception Could_not_obtain_lock of string
+
+let with_flock path f =
+  Unix.mkdir_p ~perm:0o700 (Filename.dirname path);
+  let fd = Unix.(openfile path ~mode:[O_WRONLY; O_CREAT] ~perm:0o644) in
+  let rec try_lock tries =
+    if tries > 0 then
+      if Unix.(flock fd Flock_command.lock_exclusive) then ()
+      else begin Unix.sleep 1; try_lock (tries - 1) end
+    else raise (Could_not_obtain_lock path)
+  in
+  try_lock 5;
+  protect ~f ~finally:(fun () -> Unix.(ignore (flock fd Flock_command.unlock)))

opam

@@ -13,6 +13,7 @@ remove: [
 depends: [
   "cstruct" {>= "0.7.1"}
   "lwt"
+  "core"
   "ocamlfind"
   "shared-block-ring"
   "mirage-block-volume" {>= "0.9.2"}

test/test.ml

@@ -114,9 +114,9 @@ let upgrade =
           ~printer:string_of_int 2 (LVs.cardinal (Vg_IO.metadata_of vg).Vg.lvs);
 
         (* Upgrade the volume to journalled *)
-        xenvm [ "upgrade"; "vg" ] |> ignore_string;
+        xenvm [ "upgrade"; "--pvpath"; "vg"; "vg" ] |> ignore_string;
         (* Check it's idempotent *)
-        xenvm [ "upgrade"; "vg" ] |> ignore_string;
+        xenvm [ "upgrade"; "--pvpath"; "vg"; "vg" ] |> ignore_string;
 
         (* check the changing of the magic persisted *)
         let module Label_IO = Label.Make(Block) in
@@ -140,9 +140,9 @@ let upgrade =
         );
 
         (* Downgrade the volume to lvm2 *)
-        xenvm [ "downgrade"; "vg" ] |> ignore_string;
+        xenvm [ "downgrade"; "--pvpath"; "vg"; "vg" ] |> ignore_string;
         (* Check it's idempotent *)
-        xenvm [ "downgrade"; "vg" ] |> ignore_string;
+        xenvm [ "downgrade"; "--pvpath"; "vg"; "vg" ] |> ignore_string;
 
         (* check the changing of the magic persisted *)
         Label_IO.read block >>:= fun label ->

xenvm/xenvm.ml

@@ -82,15 +82,8 @@ let format config name filenames =
 (* LVM locking code can be seen here:
  * https://git.fedorahosted.org/cgit/lvm2.git/tree/lib/misc/lvm-flock.c#n141 *)
 let with_lvm_lock vg_name f =
-  let lock_dir = "/run/lock/lvm" in
-  let lock_path = Filename.concat lock_dir ("V_" ^ vg_name ^ ":aux") in
-  Lwt.catch (fun () ->
-    mkdir_rec lock_dir 0o0700;
-    Lwt_unix.(openfile lock_path [O_CREAT; O_TRUNC; O_RDWR] 0o644)
-    >>= fun fd ->
-    Lwt_unix.(lockf fd F_LOCK) 0;
-  ) (function _ -> fail (Failure "Could_not_obtain_lvm_lock")) >>= fun () ->
-  Lwt.finalize f (fun () -> Lwt_unix.unlink lock_path)
+  let lock_path = Filename.concat "/run/lock/lvm" ("V_" ^ vg_name ^ ":aux") in
+  Flock.with_flock lock_path f
 
 (* Change the label on the PV and revert it if the function [f] fails *)
 let with_label_change block magic f =
@@ -103,12 +96,11 @@ let with_label_change block magic f =
   Lwt.catch f (fun exn -> Label_IO.write block orig_label >>:= fun () -> fail exn)
 
 
-let upgrade config filename =
+let upgrade config physical_device (vg_name, _) =
   let module Vg_IO = Vg.Make(Log)(Block)(Time)(Clock) in
   let t =
-    let (vg_name, _) = parse_name filename in
     with_lvm_lock vg_name (fun () ->
-      with_block filename (fun block ->
+      with_block physical_device (fun block ->
         (* Change the label magic to be Journalled to hide from LVM *)
         with_label_change block `Journalled (fun () ->
           (* Create the redo log, first reconnect to pick up the label changes *)
@@ -129,12 +121,11 @@ let upgrade config filename =
     ) in
   Lwt_main.run t
 
-let downgrade config filename =
+let downgrade config physical_device (vg_name, _) =
   let module Vg_IO = Vg.Make(Log)(Block)(Time)(Clock) in
   let t =
-    let (vg_name, _) = parse_name filename in
     with_lvm_lock vg_name (fun () ->
-      with_block filename (fun block ->
+      with_block physical_device (fun block ->
         (* Change the label magic to be LVM to hide from XenVM *)
         with_label_change block `Lvm (fun () ->
           (* Destroy the redo log, first reconnect to pick up the label changes *)
@@ -375,7 +366,7 @@ let upgrade_cmd =
     `S "DESCRIPTION";
     `P "Upgrades the volume group metadata so that it will be usable by xenvmd and hidden from lvm."
   ] in
-  Term.(pure upgrade $ copts_t $ filename),
+  Term.(pure upgrade $ copts_t $ physical_device_arg_required $ name_arg),
   Term.info "upgrade" ~sdocs:copts_sect ~doc ~man
 
 let downgrade_cmd =
@@ -384,7 +375,7 @@ let downgrade_cmd =
     `S "DESCRIPTION";
     `P "Downgrades the volume group metadata so that it will be usable by lvm and hidden from xenvm."
   ] in
-  Term.(pure downgrade $ copts_t $ filename),
+  Term.(pure downgrade $ copts_t $ physical_device_arg_required $ name_arg),
   Term.info "downgrade" ~sdocs:copts_sect ~doc ~man
 
 let host_connect_cmd =