# HG changeset patch
# User Jonathan Ludlam <Jonathan.Ludlam@xxxxxxxxxxxxx>
# Date 1261408275 0
# Node ID 71d488cbcda8e2fa2ce316e4637fd530b45944f7
# Parent  3dfa078d2b22ec7f821ac2388c420d10f00d546f
A few bits and pieces to support the vhd daemon

 * Introduce a dereferencing type to camldm so that PVs can be referenced by ID rather than by device name. This is useful for passing a device-mapper table between hosts where the physical device for a particular PV is different.
 * Implement device-mapper reload/suspend/resume so that a table can be changed without tearing down the device
 * A few more helper functions for stdext

Signed-off-by: Jon Ludlam <Jonathan.Ludlam@xxxxxxxxxxxxx>

diff -r 3dfa078d2b22 -r 71d488cbcda8 camldm/camldm.ml
--- a/camldm/camldm.ml	Sat Dec 19 16:37:00 2009 +0000
+++ b/camldm/camldm.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -11,13 +11,18 @@
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU Lesser General Public License for more details.
  *)
+
+type devty = 
+    | Dereferenced of string (* e.g. PV id *)
+    | Real of string (* device *)
+	
 type dev = {
-  device : string;
+  device : devty;
   offset : int64;
 }
-
+    
 type stripety = {
-  chunk_size : int64;
+  chunk_size : int64;  (* In sectors - must be a power of 2 and at least as large as the system's PAGE_SIZE *)
   dests : dev array;
 }
 
@@ -27,7 +32,7 @@
 
 type mapping = {
   start : int64;
-  len : int64;
+  len : int64; 
   map : mapty;
 }
 
@@ -45,33 +50,82 @@
 }
 
 external _create : string -> (int64 * int64 * string * string) array -> unit = "camldm_create"
+external _reload : string -> (int64 * int64 * string * string) array -> unit = "camldm_reload"
 external _table : string -> status = "camldm_table"
 external _mknods : string -> unit = "camldm_mknods"
 external _remove : string -> unit = "camldm_remove"
+external _suspend : string -> unit = "camldm_suspend"
+external _resume : string -> unit = "camldm_resume"
 external _mknod : string -> int -> int -> int -> unit = "camldm_mknod"
 
 (* Helper to convert from our type to the string*string 
  * type expected by libdevmapper *)
-let convert_mapty m =
+let resolve_device dev deref_table =
+  match dev with
+    | Real d -> d
+    | Dereferenced d -> List.assoc d deref_table
+
+let convert_mapty m deref_table =
   let array_concat sep a = String.concat sep (Array.to_list a) in
   match m with
     | Linear dev -> 
-	"linear",Printf.sprintf "%s %Ld" dev.device dev.offset
+	"linear",Printf.sprintf "%s %Ld" (resolve_device dev.device deref_table) dev.offset
     | Striped st ->
 	"striped",
 	Printf.sprintf "%d %Ld %s" (Array.length st.dests) st.chunk_size 
 	  (array_concat " " 
 	      (Array.map (fun dev -> 
-		Printf.sprintf "%s %Ld" dev.device dev.offset) st.dests))
+		Printf.sprintf "%s %Ld" (resolve_device dev.device deref_table) dev.offset) st.dests))
 
-let create dev map =
-  let newmap = Array.map (fun m ->
-    let (ty,params) = convert_mapty m.map in
-    (m.start, m.len, ty, params)) map in
-  _create dev newmap
+exception CreateError of (int64 * int64 * string * string) array
+exception ReloadError of (int64 * int64 * string * string) array
+ 
+let _writemap dev map =
+  let oc = open_out (Printf.sprintf "/tmp/%s.map" dev) in
+  Printf.fprintf oc "%s" (String.concat " " (Array.to_list (Array.map (fun (start,len,ty,params) -> Printf.sprintf "(start: %Ld len: %Ld ty: %s params: %s)" start len ty params) map)));
+  close_out oc
+    
+let _getmap map dereference_table =  
+  Array.map (fun m ->
+    let (ty,params) = convert_mapty m.map dereference_table in
+    (m.start, m.len, ty, params)) map 
+    
+let create dev map ?(dereference_table=[]) =
+  let newmap = _getmap map dereference_table in
+  try 
+    _writemap dev newmap;
+    _create dev newmap
+  with e ->
+    raise (CreateError newmap)
+      
+let reload dev map ?(dereference_table=[]) =
+  let newmap = _getmap map dereference_table in
+  try 
+    _writemap dev newmap;
+    _reload dev newmap
+  with e ->
+    raise (ReloadError newmap)
 
+let get_sector_pos_of map sector ~dereference_table =
+  match map.map with 
+    | Linear l -> (resolve_device l.device dereference_table, Int64.add l.offset sector)
+    | Striped s ->
+	(* Untested *)
+	let ndevs = Int64.of_int (Array.length s.dests) in
+	let chunk_num = Int64.div sector s.chunk_size in
+	let offset_in_chunk = Int64.rem sector s.chunk_size in
+	let dev_num = Int64.to_int (Int64.rem chunk_num ndevs) in
+	let dev_off = Int64.div chunk_num ndevs in
+	let device = s.dests.(dev_num) in
+	let offset_from_start = Int64.add (Int64.mul dev_off s.chunk_size) offset_in_chunk in   
+	let total_offset = Int64.add offset_from_start device.offset in
+	(resolve_device device.device dereference_table, total_offset)
+      
 let remove = _remove
 let table = _table
 let mknods = _mknods
 let mknod = _mknod
- 
+let suspend = _suspend
+let resume = _resume 
+let to_string (m : mapping array) = Marshal.to_string m []
+let of_string s = (Marshal.from_string s 0 : mapping array)
diff -r 3dfa078d2b22 -r 71d488cbcda8 camldm/camldm.mli
--- a/camldm/camldm.mli	Sat Dec 19 16:37:00 2009 +0000
+++ b/camldm/camldm.mli	Mon Dec 21 15:11:15 2009 +0000
@@ -11,7 +11,9 @@
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU Lesser General Public License for more details.
  *)
-type dev = { device : string; offset : int64; }
+
+type devty = | Dereferenced of string | Real of string
+type dev = { device : devty; offset : int64; }
 type stripety = { chunk_size : int64; dests : dev array; }
 type mapty = Linear of dev | Striped of stripety
 type mapping = { start : int64; len : int64; map : mapty; }
@@ -27,9 +29,19 @@
   read_only : bool;
   targets : (int64 * int64 * string * string) list;
 }
-val convert_mapty : mapty -> string * string
-val create : string -> mapping array -> unit
+
+exception CreateError of (int64 * int64 * string * string) array
+exception ReloadError of (int64 * int64 * string * string) array
+
+val convert_mapty : mapty -> (string * string) list -> string * string
+val create : string -> mapping array -> ?dereference_table : (string * string) list -> unit
+val reload : string -> mapping array -> ?dereference_table : (string * string) list -> unit
+val suspend : string -> unit
+val resume : string -> unit
 val remove : string -> unit
 val table : string -> status
 val mknods : string -> unit
 val mknod : string -> int -> int -> int -> unit
+val get_sector_pos_of : mapping -> int64 -> dereference_table:(string * string) list -> string * int64
+val to_string : mapping array -> string
+val of_string : string -> mapping array
diff -r 3dfa078d2b22 -r 71d488cbcda8 camldm/camldm_stubs.c
--- a/camldm/camldm_stubs.c	Sat Dec 19 16:37:00 2009 +0000
+++ b/camldm/camldm_stubs.c	Mon Dec 21 15:11:15 2009 +0000
@@ -67,6 +67,46 @@
   CAMLreturn0;  
 }
 
+void camldm_reload(value name, value map) 
+{
+  CAMLparam2(name,map);
+
+  struct dm_task *dmt;
+  int i;
+  uint64_t start, size;
+  char *ty,*params;
+
+  if(!(dmt = dm_task_create(DM_DEVICE_RELOAD)))
+    caml_failwith("Failed to create task!");
+
+  if(!dm_task_set_name(dmt, String_val(name))) 
+    goto out;
+
+  for(i=0; i<Wosize_val(map); i++) {
+    start=Int64_val(Field(Field(map,i),0));
+    size=Int64_val(Field(Field(map,i),1));
+    ty=String_val(Field(Field(map,i),2));
+    params=String_val(Field(Field(map,i),3));
+
+    printf("%" PRIu64 " %" PRIu64 " %s %s\n", start, size, ty, params);
+
+    if(!dm_task_add_target(dmt, start, size, ty, params))
+      goto out;
+  }
+  
+  if(!dm_task_run(dmt))
+    goto out;
+
+  goto win;
+
+ out:
+  dm_task_destroy(dmt);
+  caml_failwith("Failed!");
+
+ win:
+  CAMLreturn0;  
+}
+
 
 void camldm_mknods(value dev)
 {
@@ -177,6 +217,20 @@
   CAMLreturn0;
 }
 
+void camldm_suspend(value device)
+{
+  CAMLparam1(device);
+  _simple(DM_DEVICE_SUSPEND,String_val(device));
+  CAMLreturn0;
+}
+
+void camldm_resume(value device)
+{
+  CAMLparam1(device);
+  _simple(DM_DEVICE_RESUME,String_val(device));
+  CAMLreturn0;
+}
+
 void camldm_mknod(value path, value mode, value major, value minor)
 {
   CAMLparam4(path, mode, major, minor);
diff -r 3dfa078d2b22 -r 71d488cbcda8 stdext/listext.ml
--- a/stdext/listext.ml	Sat Dec 19 16:37:00 2009 +0000
+++ b/stdext/listext.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -22,6 +22,7 @@
 let set_equiv s1 s2 = (subset s1 s2) && (subset s2 s1)
 
 let iteri f list = ignore (fold_left (fun i x -> f i x; i+1) 0 list)
+let iteri_right f list = ignore (fold_right (fun x i -> f i x; i+1) list 0)
 
 let rec inv_assoc k = function
 	| [] -> raise Not_found
diff -r 3dfa078d2b22 -r 71d488cbcda8 stdext/listext.mli
--- a/stdext/listext.mli	Sat Dec 19 16:37:00 2009 +0000
+++ b/stdext/listext.mli	Mon Dec 21 15:11:15 2009 +0000
@@ -77,6 +77,8 @@
 
     val iteri : (int -> 'a -> unit) -> 'a list -> unit
 
+    val iteri_right : (int -> 'a -> unit) -> 'a list -> unit
+
     (** Map the given function over a list in reverse order. *)
     val rev_mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
 
diff -r 3dfa078d2b22 -r 71d488cbcda8 stdext/unixext.ml
--- a/stdext/unixext.ml	Sat Dec 19 16:37:00 2009 +0000
+++ b/stdext/unixext.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -460,6 +460,7 @@
 external set_tcp_nodelay : Unix.file_descr -> bool -> unit = "stub_unixext_set_tcp_nodelay"
 
 external fsync : Unix.file_descr -> unit = "stub_unixext_fsync"
+external blkgetsize64 : Unix.file_descr -> int64 = "stub_unixext_blkgetsize64"
 
 external get_max_fd : unit -> int = "stub_unixext_get_max_fd"
 
@@ -541,6 +542,18 @@
 	let select_wo w t = _select_wo w t
 end
 
+let wait_for_path path delay timeout =
+  let rec inner ttl =
+    if ttl=0 then failwith "No path!";
+    try 
+      ignore(Unix.stat path)
+    with _ ->
+      delay 0.5;
+      inner (ttl - 1)
+  in
+  inner (timeout * 2)
+	
+
 let _ = Callback.register_exception "unixext.unix_error" (Unix_error (0))
 
 (* HTTP helpers *)
diff -r 3dfa078d2b22 -r 71d488cbcda8 stdext/unixext.mli
--- a/stdext/unixext.mli	Sat Dec 19 16:37:00 2009 +0000
+++ b/stdext/unixext.mli	Mon Dec 21 15:11:15 2009 +0000
@@ -83,6 +83,8 @@
   = "stub_unixext_set_tcp_nodelay"
 external fsync : Unix.file_descr -> unit = "stub_unixext_fsync"
 external get_max_fd : unit -> int = "stub_unixext_get_max_fd"
+external blkgetsize64 : Unix.file_descr -> int64 = "stub_unixext_blkgetsize64"
+
 val int_of_file_descr : Unix.file_descr -> int
 val file_descr_of_int : int -> Unix.file_descr
 val close_all_fds_except : Unix.file_descr list -> unit
@@ -106,6 +108,8 @@
 	val select_wo : t -> float -> t
 end
 
+val wait_for_path : string -> (float -> unit) -> int -> unit
+
 (** Download a file via an HTTP GET *)
 val http_get: open_tcp:(server:string -> (in_channel * out_channel)) -> uri:string -> filename:string -> server:string -> unit
 (** Upload a file via an HTTP PUT *)
diff -r 3dfa078d2b22 -r 71d488cbcda8 stdext/unixext_stubs.c
--- a/stdext/unixext_stubs.c	Sat Dec 19 16:37:00 2009 +0000
+++ b/stdext/unixext_stubs.c	Mon Dec 21 15:11:15 2009 +0000
@@ -20,6 +20,8 @@
 #include <string.h>
 #include <unistd.h> /* needed for _SC_OPEN_MAX */
 #include <stdio.h> /* snprintf */
+#include <sys/ioctl.h>
+#include <linux/fs.h> 
 
 #include <caml/mlvalues.h>
 #include <caml/memory.h>
@@ -59,6 +61,16 @@
 	CAMLreturn(Val_unit);
 }
 	
+CAMLprim value stub_unixext_blkgetsize64(value fd)
+{
+  CAMLparam1(fd);
+  uint64_t size;
+  int c_fd = Int_val(fd);
+  if(ioctl(c_fd,BLKGETSIZE64,&size)) {
+    failwith_errno();
+  }
+  CAMLreturn(caml_copy_int64(size));
+}
 
 CAMLprim value stub_unixext_get_max_fd (value unit)
 {