CP-12323: Integrate mock camldm with xenvm

Update the code to cope with the new camldm module hierarchy.

Add an argument `--mock-devmapper' to all subcommands of xenvm to
use the mock devmapper interfaces.

Signed-off-by: Kaifeng Zhu <[email protected]>

Author: Kaifeng Zhu

test/test.ml

@@ -103,7 +103,7 @@ let file_exists filename =
     true
   with Unix.Unix_error(Unix.ENOENT, _, _) -> false
 
-let dm_exists name = match Devmapper.stat name with
+let dm_exists name = match Devmapper.Linux.stat name with
   | None -> false
   | Some _ -> true
 

xenvm-local-allocator/local_allocator.ml

@@ -244,6 +244,7 @@ end
 (* Return the virtual size of the volume *)
 let sizeof volume =
   let open Devmapper in
+  let open Devmapper.Linux in
   let ends = List.map (fun t -> Int64.add t.Target.start t.Target.size) volume.targets in
   List.fold_left max 0L ends
 
@@ -255,6 +256,7 @@ let extend_volume device vg lv extents =
   let next_sector = sizeof lv in
   let _, segments, targets =
     let open Devmapper in
+    let open Devmapper.Linux in
     List.fold_left
       (fun (next_sector, segments, targets) (pvname, (psegment, size)) ->
         try
@@ -281,7 +283,7 @@ let extend_volume device vg lv extents =
    List.rev segments, List.rev targets
 
 let stat x =
-  match Devmapper.stat x with
+  match Devmapper.Linux.stat x with
   | Some x -> return (`Ok x)
   | None ->
     error "The device mapper device %s has disappeared." x;
@@ -355,13 +357,13 @@ let main config daemon socket journal fromLVM toLVM =
         fatal_error msg (return x)
         >>= fun to_device ->
         (* Append the physical blocks to toLV *)
-        let to_targets = to_device.Devmapper.targets @ t.device.ExpandDevice.targets in
-        Devmapper.suspend t.device.ExpandDevice.device;
+        let to_targets = to_device.Devmapper.Linux.targets @ t.device.ExpandDevice.targets in
+        Devmapper.Linux.suspend t.device.ExpandDevice.device;
         print_endline "Suspend local dm device";
-        Devmapper.reload t.device.ExpandDevice.device to_targets;
+        Devmapper.Linux.reload t.device.ExpandDevice.device to_targets;
         ToLVM.advance tolvm position
         >>= fun () ->
-        Devmapper.resume t.device.ExpandDevice.device;
+        Devmapper.Linux.resume t.device.ExpandDevice.device;
         print_endline "Resume local dm device";
         return ()
       ) ops
@@ -402,7 +404,7 @@ let main config daemon socket journal fromLVM toLVM =
         Lwt_mutex.with_lock m
           (fun () ->
             (* We may need to enlarge in multiple chunks if the free pool is depleted *)
-            let rec expand action = match Devmapper.stat device with
+            let rec expand action = match Devmapper.Linux.stat device with
               | None ->
                 (* Log this kind of error. This tapdisk may block but at least
                    others will keep going *)
@@ -446,7 +448,7 @@ let main config daemon socket journal fromLVM toLVM =
             expand action
           ) in
 
-    let ls = Devmapper.ls () in
+    let ls = Devmapper.Linux.ls () in
     debug "Visible device mapper devices: [ %s ]\n%!" (String.concat "; " ls);
 
     let rec stdin () =

xenvm/lvchange.ml

@@ -10,6 +10,7 @@ let dev_path_of vg_name lv_name =
   Printf.sprintf "/dev/%s/%s" vg_name lv_name
 
 let activate vg lv local_device =
+  let module Devmapper = (val !Xenvm_common.dm: Devmapper.S.DEVMAPPER) in
   let path = dev_path_of vg.Lvm.Vg.name lv.Lvm.Lv.name in
   Lwt.catch (fun () -> Lwt_unix.mkdir (Filename.dirname path) 0x755) (fun _ -> Lwt.return ()) >>= fun () -> 
   Mapper.read [ local_device ]
@@ -41,6 +42,7 @@ let lvchange_activate copts vg_name lv_name physical_device =
   )
 
 let deactivate vg lv =
+  let module Devmapper = (val !Xenvm_common.dm : Devmapper.S.DEVMAPPER) in
   let open Xenvm_common in
   let name = Mapper.name_of vg lv in
   (* This can fail with an EBUSY *)
@@ -68,6 +70,7 @@ let deactivate vg lv =
   Client.flush ~name:lv.Lvm.Lv.name
 
 let reload vg lv local_device =
+  let module Devmapper = (val !Xenvm_common.dm : Devmapper.S.DEVMAPPER) in
   let open Xenvm_common in
   Mapper.read [ local_device ]
   >>= fun devices ->

xenvm/lvrename.ml

@@ -4,6 +4,7 @@ open Cmdliner
 open Lwt
 
 let lvrename copts (vg_name,lv_opt) newname physical_device =
+  let module Devmapper = (val !Xenvm_common.dm : Devmapper.S.DEVMAPPER) in
   let lv_name = match lv_opt with | Some l -> l | None -> failwith "Need an LV name" in
   (* It seems you can say "vg/lv" or "lv" *)
   let newname = match newname with

xenvm/lvresize.ml

@@ -4,6 +4,7 @@ open Cmdliner
 open Lwt
 
 let lvresize copts live (vg_name,lv_opt) real_size percent_size =
+  let module Devmapper = (val !Xenvm_common.dm : Devmapper.S.DEVMAPPER) in
   let lv_name = match lv_opt with | Some l -> l | None -> failwith "Need an LV name" in
   let open Xenvm_common in
   let size = match parse_size real_size percent_size with

xenvm/xenvm.ml

@@ -84,6 +84,7 @@ let create config name size =
      Client.create ~name ~size:size_in_bytes ~tags:[])
 
 let activate config lvname path pv =
+  let module Devmapper = (val !Xenvm_common.dm : Devmapper.S.DEVMAPPER) in
   set_uri config None;
   Lwt_main.run
     (Client.get_lv ~name:lvname

xenvm/xenvm_common.ml

@@ -3,6 +3,8 @@ open Cmdliner
 open Lwt
 open Errors
 
+let dm = ref (module Devmapper.Linux : Devmapper.S.DEVMAPPER)
+
 let syslog = Lwt_log.syslog ~facility:`Daemon ()
 
 let stdout fmt = Printf.ksprintf (fun s ->
@@ -40,24 +42,28 @@ type field = { key: string; name: string; fn:fieldfn }
 (* see https://git.fedorahosted.org/cgit/lvm2.git/tree/lib/metadata/lv.c?id=v2_02_117#n643 
    for canonical description of this field. *)
 
-(* Since we're single-shot, cache the active devices here *)
-let devmapper_ls =
-  let cache = ref None in
-  fun () ->
-    match !cache with
-    | None ->
-      let ls = Devmapper.ls () in
-      cache := Some ls;
-      ls
-    | Some ls ->
-      ls
+let attr_of_lv vg lv =
+  let module Devmapper = (val !dm: Devmapper.S.DEVMAPPER) in
+
+  (* Since we're single-shot, cache the active devices here *)
+  let devmapper_ls =
+    let cache = ref None in
+    fun () ->
+      match !cache with
+      | None ->
+        let ls = Devmapper.ls () in
+        cache := Some ls;
+        ls
+      | Some ls ->
+        ls
+  in
 
-let devmapper_stat name =
-  if List.mem name (devmapper_ls ())
-  then Devmapper.stat name
-  else None
+  let devmapper_stat name =
+    if List.mem name (devmapper_ls ())
+    then Devmapper.stat name
+    else None
+  in
 
-let attr_of_lv vg lv =
   let name = Mapper.name_of vg lv in
   let info = devmapper_stat name in
   Printf.sprintf "%c%c%c%c%c%c%c%c%c%c"
@@ -208,7 +214,9 @@ type copts_t = {
   config : string;
 }
 
-let make_copts config uri_override sockpath_override = {uri_override; config; sockpath_override }
+let make_copts config uri_override sockpath_override mock_dm =
+  dm := if mock_dm then (module Devmapper.Mock : Devmapper.S.DEVMAPPER) else (module Devmapper.Linux : Devmapper.S.DEVMAPPER);
+  { uri_override; config; sockpath_override }
 
 let config =
   let doc = "Path to the config directory" in
@@ -295,8 +303,12 @@ let output_arg default_fields =
   let a = Arg.(value & opt (some string) None & info ["o";"options"] ~doc) in
   Term.(pure (parse_output default_fields) $ a)
 
+let mock_dm_arg =
+  let doc = "Enable mock interfaces on device mapper." in
+  Arg.(value & flag & info ["mock-devmapper"] ~doc)
+
 let copts_t =
-  Term.(pure make_copts $ config $ uri_arg $ sock_path_arg)
+  Term.(pure make_copts $ config $ uri_arg $ sock_path_arg $ mock_dm_arg)
 
 let kib = 1024L
 let sectors = 512L
@@ -382,8 +394,8 @@ let set_vg_info_t copts uri local_device local_allocator_path unix_domain_sock_p
       exit 1
     |e -> Lwt.fail e)
 
-let run_set_vg_info_t config uri local_allocator_path local_device unix_domain_sock_path vg_name =
-  let copts = make_copts config (Some uri) unix_domain_sock_path in
+let run_set_vg_info_t config uri local_allocator_path local_device unix_domain_sock_path vg_name mock_dm =
+  let copts = make_copts config (Some uri) unix_domain_sock_path mock_dm in
   Lwt_main.run (set_vg_info_t copts uri local_device local_allocator_path unix_domain_sock_path vg_name)
 
 let get_vg_info_t copts vg_name =
@@ -405,7 +417,7 @@ let set_vg_info_cmd =
     `P "This command takes a physical device path and a URI, and will write these to the
 filesystem. Subsequent xenvm commands will use these as defaults.";
   ] in
-  Term.(pure run_set_vg_info_t $ config $ uri_arg_required $ local_allocator_path $ physical_device_arg_required $ sock_path_arg $ name_arg),
+  Term.(pure run_set_vg_info_t $ config $ uri_arg_required $ local_allocator_path $ physical_device_arg_required $ sock_path_arg $ name_arg $ mock_dm_arg),
   Term.info "set-vg-info" ~sdocs:copts_sect ~doc ~man