Add rpc-light support to MLVM to allow it to marshal its data structures as an RPC.t

Signed-off-by: Jon Ludlam <Jonathan.Ludlam@eu.citrix.com>

diff --git a/mlvm/Makefile b/mlvm/Makefile
index da97d27c08145f2cd24111e3b7f498d8bd717a25..68e261751c21c64dfe4b49527815085271cd925e 100644 (file)
--- a/mlvm/Makefile
+++ b/mlvm/Makefile
@@ -4,9 +4,10 @@ CFLAGS = -Wall -fPIC -O2 -I/opt/xensource/lib/ocaml
 LDFLAGS = -cclib -L./
 VERSION = 0.1
 
+PP = camlp4o -I ../rpc-light -I $(shell ocamlfind query type-conv) pa_type_conv.cmo pa_rpc.cma
+
 DESTDIR ?= /
 VERSION := $(shell hg parents --template "{rev}" 2>/dev/null || echo 0.0)
-OCAMLOPTFLAGS = -g -dtypes 
 
 OCAMLABI := $(shell ocamlc -version)
 OCAMLLIBDIR := $(shell ocamlc -where)
@@ -17,7 +18,8 @@ INTF = $(foreach obj, $(LIBOBJS),$(obj).cmi)
 CMDOBJS = messages.cmx mlvm.cmx
 OCAMLC = ocamlfind ocamlc -g
 OCAMLOPT = ocamlfind ocamlopt 
-COMPFLAG = -dtypes -g -I ../stdext -I ../camldm -I ../uuid -for-pack Lvm
+COMPFLAG = -dtypes -g -I ../stdext -I ../camldm -I ../uuid -for-pack Lvm -pp '${PP}' -I ../rpc-light
+
 LIBS = lvm.cma lvm.cmxa
 
 DOCDIR = /myrepos/xen-api-libs.hg/doc

diff --git a/mlvm/allocator.ml b/mlvm/allocator.ml
index 3192dcc3ca749f6fa95e3f031e7cc1d4a62c662d..6a53632e52201277b360af64ba5d13b1601f26ff 100644 (file)
--- a/mlvm/allocator.ml
+++ b/mlvm/allocator.ml
@@ -1,4 +1,4 @@
-type t = (string * (int64 * int64)) list
+type t = (string * (int64 * int64)) list with rpc
 
 let create name size = [(name,(0L,size))]
 

diff --git a/mlvm/lv.ml b/mlvm/lv.ml
index d1afe8b8513d0e93fb90aa77df9d51e79a46e351..d5e6aae2f579ca1eb52da8a7f4ab19b6aadc8cfd 100644 (file)
--- a/mlvm/lv.ml
+++ b/mlvm/lv.ml
@@ -6,32 +6,32 @@ type stat =
     | Write
     | Visible
        
-type striped_segment = {
+and striped_segment = {
   st_stripe_size : int64; (* In sectors *)
   st_stripes : (string * int64) list; (* pv name * start extent *)
 }
 
-type linear_segment = {
+and linear_segment = {
   l_pv_name : string;
   l_pv_start_extent : int64;
 }
 
-type segclass = 
+and segclass = 
   | Linear of linear_segment
   | Striped of striped_segment
 
-type segment = 
+and segment = 
     { s_start_extent : int64; 
       s_extent_count : int64;
       s_cls : segclass; }
 
-type logical_volume = {
+and logical_volume = {
   name : string;
   id : string;
   tags : string list;
   status : stat list;
   segments : segment list;
-}
+} with rpc
 
 let status_to_string s =
   match s with

diff --git a/mlvm/lvmmarshal.ml b/mlvm/lvmmarshal.ml
index 553afc6d1ebac938cafba56315f81dcd455b4775..4654649720238118b5c8dbde0ad486308486a129 100644 (file)
--- a/mlvm/lvmmarshal.ml
+++ b/mlvm/lvmmarshal.ml
@@ -14,26 +14,26 @@ let unmarshal_uint8 (s, offset) =
 
 let unmarshal_uint16 ?(bigendian=false) (s, offset) =
   let offsets = if bigendian then [|1;0|] else [|0;1|] in
-  let (<<) a b = a lsl b 
-  and (||) a b = a lor b in
+  let (<!<) a b = a lsl b 
+  and (|!|) a b = a lor b in
   let a = int_of_char (s.[offset + offsets.(0)]) 
   and b = int_of_char (s.[offset + offsets.(1)]) in
-  (a << 0) || (b << 8), (s, offset + 2)
+  (a <!< 0) |!| (b <!< 8), (s, offset + 2)
 
 let unmarshal_uint32 ?(bigendian=false) (s, offset) = 
   let offsets = if bigendian then [|3;2;1;0|] else [|0;1;2;3|] in
-  let (<<) a b = Int32.shift_left a b 
-  and (||) a b = Int32.logor a b in
+  let (<!<) a b = Int32.shift_left a b 
+  and (|!|) a b = Int32.logor a b in
   let a = Int32.of_int (int_of_char (s.[offset + offsets.(0)])) 
   and b = Int32.of_int (int_of_char (s.[offset + offsets.(1)])) 
   and c = Int32.of_int (int_of_char (s.[offset + offsets.(2)])) 
   and d = Int32.of_int (int_of_char (s.[offset + offsets.(3)])) in
-  (a << 0) || (b << 8) || (c << 16) || (d << 24), (s, offset + 4)
+  (a <!< 0) |!| (b <!< 8) |!| (c <!< 16) |!| (d <!< 24), (s, offset + 4)
 
 let unmarshal_uint64 ?(bigendian=false) (s, offset) = 
   let offsets = if bigendian then [|7;6;5;4;3;2;1;0|] else [|0;1;2;3;4;5;6;7|] in
-  let (<<) a b = Int64.shift_left a b 
-  and (||) a b = Int64.logor a b in
+  let (<!<) a b = Int64.shift_left a b 
+  and (|!|) a b = Int64.logor a b in
   let a = Int64.of_int (int_of_char (s.[offset + offsets.(0)])) 
   and b = Int64.of_int (int_of_char (s.[offset + offsets.(1)])) 
   and c = Int64.of_int (int_of_char (s.[offset + offsets.(2)])) 
@@ -42,8 +42,8 @@ let unmarshal_uint64 ?(bigendian=false) (s, offset) =
   and f = Int64.of_int (int_of_char (s.[offset + offsets.(5)])) 
   and g = Int64.of_int (int_of_char (s.[offset + offsets.(6)])) 
   and h = Int64.of_int (int_of_char (s.[offset + offsets.(7)])) in
-  (a << 0) || (b << 8) || (c << 16) || (d << 24)
-  || (e << 32) || (f << 40) || (g << 48) || h << (56), (s, offset + 8)
+  (a <!< 0) |!| (b <!< 8) |!| (c <!< 16) |!| (d <!< 24)
+  |!| (e <!< 32) |!| (f <!< 40) |!| (g <!< 48) |!| (h <!< 56), (s, offset + 8)
 
 let unmarshal_string len (s,offset) =
   String.sub s offset len, (s, offset + len)
@@ -57,22 +57,22 @@ let marshal_int8 (s,offset) x =
 
 let marshal_int16 (s,offset) ?(bigendian=false) x = 
   let offsets = if bigendian then [|1;0|] else [|0;1|] in
-  let (>>) a b = a lsr b
+  let (>!>) a b = a lsr b
   and (&&) a b = a land b in
-  let a = (x >> 0) && 0xff 
-  and b = (x >> 8) && 0xff in
+  let a = (x >!> 0) && 0xff 
+  and b = (x >!> 8) && 0xff in
   s.[offset+offsets.(0)] <- char_of_int a;
   s.[offset+offsets.(1)] <- char_of_int b;
   (s,offset+2)
 
 let marshal_int32 (s,offset) ?(bigendian=false) x = 
   let offsets = if bigendian then [|3;2;1;0|] else [|0;1;2;3|] in
-  let (>>) a b = Int32.shift_right_logical a b
+  let (>!>) a b = Int32.shift_right_logical a b
   and (&&) a b = Int32.logand a b in
-  let a = (x >> 0) && 0xffl 
-  and b = (x >> 8) && 0xffl
-  and c = (x >> 16) && 0xffl
-  and d = (x >> 24) && 0xffl in
+  let a = (x >!> 0) && 0xffl 
+  and b = (x >!> 8) && 0xffl
+  and c = (x >!> 16) && 0xffl
+  and d = (x >!> 24) && 0xffl in
   s.[offset+offsets.(0)] <- char_of_int (Int32.to_int a);
   s.[offset+offsets.(1)] <- char_of_int (Int32.to_int b);
   s.[offset+offsets.(2)] <- char_of_int (Int32.to_int c);
@@ -81,16 +81,16 @@ let marshal_int32 (s,offset) ?(bigendian=false) x =
 
 let marshal_int64 (s,offset) ?(bigendian=false) x = 
   let offsets = if bigendian then [|7;6;5;4;3;2;1;0|] else [|0;1;2;3;4;5;6;7|] in
-  let (>>) a b = Int64.shift_right_logical a b
+  let (>!>) a b = Int64.shift_right_logical a b
   and (&&) a b = Int64.logand a b in
-  let a = (x >> 0) && 0xffL
-  and b = (x >> 8) && 0xffL
-  and c = (x >> 16) && 0xffL
-  and d = (x >> 24) && 0xffL 
-  and e = (x >> 32) && 0xffL 
-  and f = (x >> 40) && 0xffL
-  and g = (x >> 48) && 0xffL
-  and h = (x >> 56) && 0xffL in
+  let a = (x >!> 0) && 0xffL
+  and b = (x >!> 8) && 0xffL
+  and c = (x >!> 16) && 0xffL
+  and d = (x >!> 24) && 0xffL 
+  and e = (x >!> 32) && 0xffL 
+  and f = (x >!> 40) && 0xffL
+  and g = (x >!> 48) && 0xffL
+  and h = (x >!> 56) && 0xffL in
   s.[offset+offsets.(0)] <- char_of_int (Int64.to_int a);
   s.[offset+offsets.(1)] <- char_of_int (Int64.to_int b);
   s.[offset+offsets.(2)] <- char_of_int (Int64.to_int c);

diff --git a/mlvm/pv.ml b/mlvm/pv.ml
index 3b571756b4659b2397d88be3294acc76ed1a93d6..528f23b33c1071aed2fd2c6be50500bea1ab86ee 100644 (file)
--- a/mlvm/pv.ml
+++ b/mlvm/pv.ml
@@ -28,23 +28,23 @@ module Label = struct
     ty : string (* 8 bytes, equal to "LVM2 001" - Constants.label_type*)
   }
       
-  type disk_locn = {
+  and disk_locn = {
     dl_offset : int64;
     dl_size : int64;
   }
 
-  type pv_header = {
+  and pv_header = {
     pvh_id : string; (* 32 bytes, 'uuid' *)
     pvh_device_size : int64;
     pvh_extents: disk_locn list;
     pvh_metadata_areas: disk_locn list;
   }
 
-  type t = {
+  and t = {
     device : string;
     label_header : label_header;
     pv_header : pv_header;
-  }
+  } with rpc 
 
   let unmarshal_header b0 =
     let id,b = unmarshal_string 8 b0 in
@@ -97,6 +97,14 @@ module Label = struct
       pvh_extents=disk_areas;
       pvh_metadata_areas=disk_areas2},b
 
+  let pvh_to_ascii pvh =
+    let disk_area_list_to_ascii l =
+      (String.concat "," (List.map (fun da -> Printf.sprintf "{offset=%Ld,size=%Ld}" da.dl_offset da.dl_size) l)) in  
+    Printf.sprintf "pvh_id: %s\npvh_device_size: %Ld\npvh_areas1: %s\npvh_areas2: %s\n"
+      pvh.pvh_id pvh.pvh_device_size 
+      (disk_area_list_to_ascii pvh.pvh_extents)
+      (disk_area_list_to_ascii pvh.pvh_metadata_areas)
+
   let write_label_and_pv_header l =
     let label = l.label_header in
     let pvh = l.pv_header in
@@ -117,7 +125,9 @@ module Label = struct
     let header = marshal_string header label.ty in
     
     assert(snd header = 32);
-    
+
+    Debug.debug (Printf.sprintf "write_label_and_pv_header:\nPV header:\n%s" (pvh_to_ascii pvh));
+
     (* PV header *)
     let header = marshal_string header (Lvm_uuid.remove_hyphens pvh.pvh_id) in
     let header = marshal_int64 header pvh.pvh_device_size in
@@ -155,14 +165,6 @@ module Label = struct
     
     Unix.close fd
 
-  let pvh_to_ascii pvh =
-    let disk_area_list_to_ascii l =
-      (String.concat "," (List.map (fun da -> Printf.sprintf "{offset=%Ld,size=%Ld}" da.dl_offset da.dl_size) l)) in  
-    Printf.sprintf "pvh_id: %s\npvh_device_size: %Ld\npvh_areas1: %s\npvh_areas2: %s\n"
-      pvh.pvh_id pvh.pvh_device_size 
-      (disk_area_list_to_ascii pvh.pvh_extents)
-      (disk_area_list_to_ascii pvh.pvh_metadata_areas)
-
   let get_metadata_locations label = 
     label.pv_header.pvh_metadata_areas
 
@@ -205,6 +207,8 @@ module Label = struct
 end
     
 module MDAHeader = struct
+  let mda_header_size = Constants.sector_size
+
   type mda_raw_locn = {
     mrl_offset: int64;
     mrl_size: int64;
@@ -212,16 +216,14 @@ module MDAHeader = struct
     mrl_filler: int32;
   }
 
-  let mda_header_size = Constants.sector_size
-
-  type mda_header = {
+  and mda_header = {
     mdah_checksum : int32;
     mdah_magic : string;
     mdah_version : int32;
     mdah_start: int64;
     mdah_size: int64;
     mdah_raw_locns : mda_raw_locn list;
-  }
+  } with rpc
 
   let unmarshal_mda_header device location =
     let offset,fd = 
@@ -421,7 +423,7 @@ end
 type status = 
     | Allocatable
        
-type physical_volume = {
+and physical_volume = {
   name : string;
   id : string;
   dev : string;
@@ -432,7 +434,7 @@ type physical_volume = {
   pe_count : int64;
   label : Label.t;  (* The one label for this PV *)
   mda_headers : MDAHeader.mda_header list; 
-}
+} with rpc 
 
 let status_to_string s =
   match s with
@@ -493,8 +495,8 @@ let of_metadata name config pvdatas =
 (** Find the metadata area on a device and return the text of the metadata *)
 let find_metadata device =
   let label = Label.find device in
-  (*  Printf.printf "Label found: \n%s\nPV header found:\n%s\n" 
-      (Pv.Label.label_to_ascii label) (Pv.Label.pvh_to_ascii pvh); *)
+  Debug.debug (Printf.sprintf "Label found: \n%s\n" 
+    (Label.to_ascii label));
   let mda_locs = Label.get_metadata_locations label in
   let mdahs = List.map (MDAHeader.unmarshal_mda_header device) mda_locs in
   let mdt = MDAHeader.read_md device (List.hd mdahs) 0 in  

diff --git a/mlvm/redo.ml b/mlvm/redo.ml
index 5a8e0873dbedaf20e7ca5812026442e27399be2a..05b122f5bc2ec6132ad6eb0e4e1617f8f661d8cd 100644 (file)
--- a/mlvm/redo.ml
+++ b/mlvm/redo.ml
@@ -4,29 +4,29 @@ type lvcreate_t = {
   lvc_segments : Allocator.t
 }
 
-type lvrename_t = {
+and lvrename_t = {
   lvmv_new_name : string;
 }
 
-type lvreduce_t = {
+and lvreduce_t = {
   lvrd_new_extent_count : int64;
 }
 
-type lvexpand_t = {
+and lvexpand_t = {
   lvex_segments : Allocator.t;
 }
     
-type operation =
+and operation =
     | LvCreate of string * lvcreate_t
     | LvReduce of string * lvreduce_t
     | LvExpand of string * lvexpand_t
     | LvRename of string * lvrename_t
     | LvRemove of string
 
-type sequenced_op = {
+and sequenced_op = {
   so_seqno : int;
   so_op : operation
-}
+} with rpc
 
 open Debug
 

diff --git a/mlvm/vg.ml b/mlvm/vg.ml
index 00b6792c9a430ec7027522c7b239ad0b88c64922..250437f3be7de250643a85962ce7b147ba6cf899 100644 (file)
--- a/mlvm/vg.ml
+++ b/mlvm/vg.ml
@@ -8,7 +8,7 @@ type status =
     | Resizeable
     | Clustered
 
-type vg = {
+and vg = {
   name : string;
   id : string;
   seqno : int;
@@ -21,7 +21,7 @@ type vg = {
   free_space : Allocator.t;
   redo_lv : string option; (* Name of the redo LV *)
   ops : sequenced_op list;
-}
+} with rpc
   
 let status_to_string s =
   match s with
@@ -425,6 +425,7 @@ let of_metadata config pvdatas =
 
 let create_new name devices_and_names =
   let pvs = List.map (fun (dev,name) -> Pv.create_new dev name) devices_and_names in
+  debug "PVs created";
   let free_space = List.flatten (List.map (fun pv -> Allocator.create pv.Pv.name pv.Pv.pe_count) pvs) in
   let vg = 
     { name=name;
@@ -441,7 +442,8 @@ let create_new name devices_and_names =
       ops=[];
     }
   in
-  write vg true
+  write vg true;
+  debug "VG created"
 
 let parse text pvdatas =
   let lexbuf = Lexing.from_string text in