# HG changeset patch
# User Jonathan Ludlam <Jonathan.Ludlam@xxxxxxxxxxxxx>
# Date 1261408275 0
# Node ID fe8ef0c4a5ea1ce0deb059074b3467851dd509fa
# Parent  820f16fdbb7d6069828d84ff48ddb9476b57b693
MLVM library

This is a reimplementation of LVM in ocaml. It has had light testing, and therefore might corrupt data - use with caution! It only implements simple LVM functionality - creating/destroying/activating linear LVs (code exists for striped LVs but is untested). It also features a redo log so that LVM operation can be committed to disk in constant time.

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

diff -r 820f16fdbb7d -r fe8ef0c4a5ea Makefile.in
--- a/Makefile.in	Mon Dec 21 15:11:15 2009 +0000
+++ b/Makefile.in	Mon Dec 21 15:11:15 2009 +0000
@@ -30,6 +30,7 @@
 	$(MAKE) -C camldm
 endif
 	$(MAKE) -C forking_executioner
+	$(MAKE) -C mlvm
 
 .PHONY: allxen
 allxen:
@@ -65,6 +66,7 @@
 	$(MAKE) -C camldm install
 endif
 	$(MAKE) -C forking_executioner install
+	$(MAKE) -C mlvm install
 
 installxen:
 ifeq ($(HAVE_XEN),1)
@@ -99,6 +101,7 @@
 	$(MAKE) -C camldm uninstall
 endif
 	$(MAKE) -C forking_executioner uninstall
+	$(MAKE) -C mlvm uninstall
 
 uninstallxen:
 ifeq ($(HAVE_XEN),1)
@@ -156,6 +159,7 @@
 	$(MAKE) -C xsrpc doc
 	$(MAKE) -C mmap doc
 	$(MAKE) -C forking_executioner doc
+	$(MAKE) -C mlvm doc
 
 .PHONY: clean
 clean:
@@ -174,6 +178,7 @@
 	make -C sexpr clean
 	make -C doc clean
 	make -C forking_executioner clean
+	make -C mlvm clean
 
 cleanxen:
 	$(MAKE) -C mmap clean
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/META.in
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/META.in	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,4 @@
+version = "@VERSION@"
+description = "LVM2 ocaml interface"
+archive(byte) = "lvm.cma"
+archive(native) = "lvm.cmxa"
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/Makefile
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/Makefile	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,85 @@
+
+CC = gcc
+CFLAGS = -Wall -fPIC -O2 -I/opt/xensource/lib/ocaml
+LDFLAGS = -cclib -L./
+VERSION = 0.1
+
+DESTDIR ?= /
+VERSION := $(shell hg parents --template "{rev}" 2>/dev/null || echo 0.0)
+OCAMLOPTFLAGS = -g -dtypes 
+
+OCAMLABI := $(shell ocamlc -version)
+OCAMLLIBDIR := $(shell ocamlc -where)
+OCAMLDESTDIR ?= $(OCAMLLIBDIR)
+
+LIBOBJS = constants lvm_uuid crc utils absty lvmconfigparser lvmconfiglex lvmmarshal allocator debug redo lv pv vg 
+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
+LIBS = lvm.cma lvm.cmxa
+
+default : $(LIBS)
+
+lvm.cmx: $(foreach obj,$(LIBOBJS),$(obj).cmx)
+	$(OCAMLOPT) -pack -g -o $@ $(foreach obj,$(LIBOBJS),$(obj).cmx)
+
+lvm.cmo: $(foreach obj,$(LIBOBJS),$(obj).cmo)
+	$(OCAMLC) -pack -g -o $@ $(foreach obj,$(LIBOBJS),$(obj).cmo)
+
+lvm.cmxa: lvm.cmx
+	$(OCAMLOPT) -a -g -o $@ lvm.cmx
+
+lvm.cma: lvm.cmo
+	$(OCAMLC) -a -g -o $@ lvm.cmo
+
+META: META.in
+	sed 's/@VERSION@/$(VERSION)/g' < $< > $@
+
+.PHONY: install
+install: $(LIBS) META
+	ocamlfind install -destdir $(DESTDIR)$(shell ocamlfind printconf destdir) -ldconf ignore lvm META lvm.cmi lvm.cmxa lvm.cma lvm.a
+
+.PHONY: uninstall
+uninstall:
+	ocamlfind remove lvm
+
+clean : 
+	rm -f *.cmo *.cmi *.cmx *.o *~ *.annot lvmconfiglex.ml \
+	lvmconfigparser.mli lvmconfigparser.ml
+
+lvmconfigparser.ml : lvmconfigparser.mly
+	ocamlyacc lvmconfigparser.mly
+	$(OCAMLOPT) $(COMPFLAG) -c lvmconfigparser.mli
+
+lvmconfiglex.ml : lvmconfiglex.mll lvmconfigparser.mli
+	ocamllex lvmconfiglex.mll
+
+.SUFFIXES: .ml .mli .cmo .cmi .cmx
+
+.ml.cmo:
+	$(OCAMLC) $(COMPFLAG) -c $<
+
+.mli.cmi:
+	$(OCAMLOPT) $(COMPFLAG) -c $<
+
+.ml.cmx:
+	$(OCAMLOPT) $(COMPFLAG) -c $<
+
+.c.o:
+	$(OCAMLC) $(COMPFLAG) -c $<
+
+lvmcmd.cmo: messages.cmo 
+lvmcmd.cmx: messages.cmx 
+lv.cmo: absty.cmo 
+lv.cmx: absty.cmx 
+mlvm.cmo: vg.cmo pv.cmo messages.cmo lv.cmo 
+mlvm.cmx: vg.cmx pv.cmx messages.cmx lv.cmx 
+pv.cmo: utils.cmo lvmmarshal.cmo lvm_uuid.cmo crc.cmo constants.cmo \
+    allocator.cmo absty.cmo 
+pv.cmx: utils.cmx lvmmarshal.cmx lvm_uuid.cmx crc.cmx constants.cmx \
+    allocator.cmx absty.cmx 
+vg.cmo: debug.cmo pv.cmo lvm_uuid.cmo lv.cmo allocator.cmo absty.cmo 
+vg.cmx: debug.cmx pv.cmx lvm_uuid.cmx lv.cmx allocator.cmx absty.cmx 
+
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/absty.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/absty.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,57 @@
+(* Useful helper fns *)
+let quote s = Printf.sprintf "\"%s\"" s 
+let o = fun f g x -> f (g x) 
+
+type absty = | AInt of int64
+	     | AStr of string
+	     | AStruct of (string * absty) list
+	     | AArr of absty list
+		 
+let rec fieldstr f =
+  match f with 
+    | AInt x -> Printf.sprintf "%Ld" x
+    | AStr x -> Printf.sprintf "'%s'" x
+    | AStruct x -> "{\n" ^ (String.concat "," (List.map (fun (x,y) -> Printf.sprintf "%s: %s\n" x (fieldstr y)) x)) ^ "}\n"
+    | AArr x -> "[" ^ (String.concat "," (List.map fieldstr x)) ^ "]"
+
+let expect_string name field =
+  match field with 
+    | AStr s -> s
+    | AInt n -> Printf.sprintf "%Ld" n
+    | _ -> failwith (Printf.sprintf "Expecting string for identifier '%s'" name)
+
+let expect_int name field =
+  match field with 
+    | AInt n -> n
+    | _ -> failwith (Printf.sprintf "Expecting string for identifier '%s'" name)
+
+let expect_struct name field =
+  match field with
+    | AStruct fields -> fields
+    | _ -> failwith (Printf.sprintf "Expecting struct for identifier '%s'" name)
+
+let expect_array name field =
+  match field with
+    | AArr a -> a
+    | _ -> failwith (Printf.sprintf "Expecting array for identifier '%s'" name)
+     
+let expect_mapped_field transform name alist =
+  let field = List.assoc name alist in
+  transform name field
+	
+let expect_mapped_string = expect_mapped_field expect_string 
+let expect_mapped_int = expect_mapped_field expect_int
+let expect_mapped_struct = expect_mapped_field expect_struct
+let expect_mapped_array = expect_mapped_field expect_array
+
+let map_expected_mapped_array name fn alist =
+  let a = expect_mapped_array name alist in 
+  List.map fn a
+
+let filter_structs alist = 
+  List.filter (fun (a,b) -> match b with | AStruct _ -> true | _ -> false) alist
+
+
+
+
+  
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/allocator.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/allocator.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,101 @@
+type t = (string * (int64 * int64)) list
+
+let create name size = [(name,(0L,size))]
+
+let get_size (_,(_,s)) = s
+let get_start (_,(s,_)) = s
+let get_name (n,(_,_)) = n
+
+let make_area name start size = (name,(start,size))
+
+let alloc_specified_area (t : t) a =
+  let size = get_size a in
+  let start = get_start a in
+  let name = get_name a in
+  let test a2 = 
+    let size2 = get_size a2 in
+    let start2 = get_start a2 in
+    let name2 = get_name a2 in
+    name=name2 && start >= start2 && start < Int64.add size2 start2 
+  in
+  let containing_areas,other_areas = List.partition test t in
+  let containing_area = List.hd containing_areas in
+  let ca_start = get_start containing_area in
+  let ca_size = get_size containing_area in
+  let ca_name = get_name containing_area in
+  let new_areas = 
+    if start=ca_start then other_areas else (make_area ca_name ca_start (Int64.sub start ca_start))::other_areas
+  in
+  let new_areas =
+    if (Int64.add start size) = (Int64.add ca_start ca_size) 
+    then new_areas 
+    else (make_area ca_name (Int64.add start size) (Int64.sub (Int64.add ca_start ca_size) (Int64.add start size)))::new_areas
+  in
+  new_areas
+
+let alloc_specified_areas =
+  List.fold_left alloc_specified_area
+  
+let rec alloc t newsize = 
+  let l = List.sort (fun a1 a2 -> compare (get_size a1) (get_size a2)) t in
+  let rec find xs ys =
+    match ys with
+      | seg::[] ->
+	  (* If there's only one segment left, it's the largest. Allocate. *)
+	  seg,xs
+      |	seg::rest -> 
+	  let size = get_size seg in
+	  if size >= newsize 
+	  then seg,(xs@rest)
+	  else find (seg::xs) rest
+      | _ -> failwith "Failed to find individual segment!"
+  in
+  let seg,rest = find [] l in
+  let size = get_size seg in
+  if (size < newsize) then
+    (* We couldn't find one contiguous region to allocate. Call alloc again
+       with the remainder of the size and the new list of allocated segments *)
+    let allocd,newt = alloc (rest) (Int64.sub newsize size) in
+    (seg::allocd, newt)
+  else
+    let name = get_name seg in
+    let start = get_start seg in
+    let area = make_area name start newsize in
+    ([area], alloc_specified_area t area)
+
+let rec setify = function
+        | [] -> []
+        | (x::xs) -> if List.mem x xs then setify xs else x::(setify xs)
+
+let free t segs =
+  let l = List.sort (fun a1 a2 -> compare (get_start a1) (get_start a2)) (t@segs) in
+  let pvs = List.map get_name l in
+  let pvs = setify pvs in
+
+  let rec test acc segs =
+    match segs with
+      | a1::a2::rest ->
+	  let start1 = get_start a1 in
+	  let size1 = get_size a1 in
+	  let start2 = get_start a2 in
+	  let size2 = get_size a2 in
+	  let name = get_name a1 in
+	  if (Int64.add start1 size1) = start2 then
+	    test acc ((make_area name start1 (Int64.add size1 size2))::rest)
+	  else
+	    test ((List.hd segs)::acc) (List.tl segs)
+      | [x] -> x::acc
+      | [] -> acc (* shouldn't be necessary! *)
+  in
+  
+  List.fold_left (fun acc pv -> test acc (List.filter (fun seg -> get_name seg = pv) l)) [] pvs
+
+let to_string t =
+  String.concat ", "
+    (List.map (fun (p,(s,l)) -> Printf.sprintf "(%s: [%Ld,%Ld])" p s l) t)
+
+let dotest a n =
+    let before = List.sort compare a in
+    let (alloced,after)=alloc a n in
+    let dealloced = List.sort compare (free after alloced) in
+    before=dealloced
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/constants.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/constants.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,29 @@
+let label_id = "LABELONE"
+let sector_size = 512
+let sector_sizeL = 512L
+let label_size = sector_size
+let label_scan_sectors = 4
+let label_scan_size = label_scan_sectors * sector_size
+
+let label_type = "LVM2 001"
+
+let extent_size = Int64.mul 4096L 1024L
+let extent_size_minus_one = Int64.sub extent_size 1L
+let extent_size_in_sectors = Int64.div extent_size sector_sizeL
+
+let fmtt_magic = Stringext.String.implode (List.map Char.chr [0o040;0o114;0o126;0o115;0o062;0o040;0o170;0o133;0o065;0o101;0o045;0o162;0o060;0o116;0o052;0o076])
+
+let mdah_start = 4096L
+let mdah_size = Int64.mul 10240L 1024L 
+
+let pe_align = 65536L
+
+let redo_log_lv_name = "mlvm_redo_log"
+
+let mib = Int64.mul 1024L 1024L
+let tib = Int64.mul mib mib
+
+let dummy_mode = ref false 
+let dummy_base = ref "/tmp"
+let mapper_name = ref "mapper"
+let full_provision = ref false
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/crc.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/crc.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,26 @@
+(* LVM uses CRC to verify data *)
+
+let initial_crc = 0xf597a6cfl
+
+let crctab = [| 
+  0x00000000l; 0x1db71064l; 0x3b6e20c8l; 0x26d930acl;
+  0x76dc4190l; 0x6b6b51f4l; 0x4db26158l; 0x5005713cl;
+  0xedb88320l; 0xf00f9344l; 0xd6d6a3e8l; 0xcb61b38cl;
+  0x9b64c2b0l; 0x86d3d2d4l; 0xa00ae278l; 0xbdbdf21cl;
+|]
+
+let crc buf init =
+  let (>>) a b = Int32.shift_right_logical a b in
+  let (^^) a b = Int32.logxor a b in
+  let (&&&) a b = Int32.to_int (Int32.logand a b) in
+
+  let size = String.length buf in
+  let rec loop i cur =
+    if i=size then cur else
+      let a1 = cur ^^ (Int32.of_int (int_of_char buf.[i])) in
+      let a2 = (a1 >> 4) ^^ crctab.( a1 &&& 0xfl ) in
+      let a3 = (a2 >> 4) ^^ crctab.( a2 &&& 0xfl ) in
+      loop (i+1) a3
+  in
+
+  loop 0 init
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/debug.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/debug.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,3 @@
+
+let debug_hook : (('b, unit, string, unit) format4 -> 'b) option ref = ref None
+let debug string = match !debug_hook with Some x -> x "%s" string | None -> Printf.fprintf stderr "%s\n" string
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/lv.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/lv.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,166 @@
+open Absty
+open Listext
+
+type stat = 
+    | Read
+    | Write
+    | Visible
+	
+type striped_segment = {
+  st_stripe_size : int64; (* In sectors *)
+  st_stripes : (string * int64) list; (* pv name * start extent *)
+}
+
+type linear_segment = {
+  l_pv_name : string;
+  l_pv_start_extent : int64;
+}
+
+type segclass = 
+  | Linear of linear_segment
+  | Striped of striped_segment
+
+type segment = 
+    { s_start_extent : int64; 
+      s_extent_count : int64;
+      s_cls : segclass; }
+
+type logical_volume = {
+  name : string;
+  id : string;
+  tags : string list;
+  status : stat list;
+  segments : segment list;
+}
+
+let status_to_string s =
+  match s with
+    | Read -> "READ"
+    | Write -> "WRITE"
+    | Visible -> "VISIBLE"
+
+let status_of_string s =
+  match s with
+    | "READ" -> Read
+    | "WRITE" -> Write
+    | "VISIBLE" -> Visible
+    | _ -> failwith "Bad LV status string"
+	
+let write_to_buffer b lv =
+  let bprintf = Printf.bprintf in
+  bprintf b "\n%s {\nid = \"%s\"\nstatus = [%s]\n" lv.name lv.id 
+    (String.concat ", " (List.map (o quote status_to_string) lv.status));
+  if List.length lv.tags > 0 then 
+    bprintf b "tags = [%s]\n" (String.concat ", " (List.map quote lv.tags));
+  bprintf b "segment_count = %d\n\n" (List.length lv.segments);
+  Listext.List.iteri_right 
+    (fun i s -> 
+      bprintf b "segment%d {\nstart_extent = %Ld\nextent_count = %Ld\n\n"
+	(i+1) s.s_start_extent s.s_extent_count;
+       match s.s_cls with
+	 | Linear l ->
+	     bprintf b "type = \"striped\"\nstripe_count = 1\t#linear\n\n";
+	     bprintf b "stripes = [\n\"%s\", %Ld\n]\n}\n" l.l_pv_name l.l_pv_start_extent
+	 | Striped st ->
+	     let stripes = List.length st.st_stripes in
+	     bprintf b "type = \"striped\"\nstripe_count = %d\nstripe_size = %Ld\n\nstripes = [\n"
+	       stripes st.st_stripe_size;
+	     List.iter (fun (pv,offset) -> bprintf b "%s, %Ld\n" (quote pv) offset) st.st_stripes;
+	     bprintf b "]\n}\n") lv.segments;
+  bprintf b "}\n"
+
+let segment_of_metadata name config =
+  let start_extent = expect_mapped_int "start_extent" config in
+  let extent_count = expect_mapped_int "extent_count" config in
+  let ty = expect_mapped_string "type" config in
+  if ty<>"striped" then failwith (Printf.sprintf "Cannot handle LV segment type '%s'" ty);
+  let stripes = expect_mapped_array "stripes" config in
+  let rec handle_stripes ss =
+    match ss with
+      | name::offset::rest ->
+	  let name = expect_string "name" name in
+	  let offset = expect_int "offset" offset in
+	  (name,offset)::handle_stripes rest
+      | _ -> []
+  in 
+  {s_start_extent = start_extent;
+   s_extent_count = extent_count;
+   s_cls = 
+      if List.length stripes = 2 then 
+	match stripes with 
+	  | [name;offset] ->
+	      Linear { l_pv_name=expect_string "name" name;
+		       l_pv_start_extent=expect_int "offset" offset }
+	  | _ -> failwith "Invalid format of segment"
+      else 
+	let stripe_size = expect_mapped_int "stripe_size" config in
+	let stripes = (handle_stripes stripes) in
+	Striped {st_stripe_size=stripe_size;
+		 st_stripes=stripes}
+  }
+
+let of_metadata name config =
+  let id = expect_mapped_string "id" config in
+  let status = map_expected_mapped_array "status" 
+    (fun a -> status_of_string (expect_string "status" a)) config in
+  let segments = filter_structs config in
+  let segments = List.map 
+    (fun (a,_) -> 
+      segment_of_metadata a (expect_mapped_struct a segments)) segments in
+  let tags = 
+    if List.mem_assoc "tags" config 
+    then map_expected_mapped_array "tags" (expect_string "tag") config 
+    else [] 
+  in
+  { name=name;
+    id=id;
+    status=status;
+    tags=tags;
+    segments=segments }
+
+let allocation_of_segment s =
+  match s.s_cls with
+    | Linear l ->
+	[(l.l_pv_name, (l.l_pv_start_extent, s.s_extent_count))]
+    | Striped st ->
+(* LVM appears to always round up the number of extents allocated such
+   that it's divisible by the number of stripes, so we always fully allocate
+   each extent in each PV. Let's be tolerant to broken metadata when this
+   isn't the case by rounding up rather than down, so partially allocated
+   extents are included in the allocation *)
+	let extent_count = s.s_extent_count in
+	let nstripes = Int64.of_int (List.length st.st_stripes) in
+	List.map (fun (name,start) ->
+		    let allocated_extents = 
+		      Int64.div 
+			(Int64.sub 
+			   (Int64.add 
+			      extent_count nstripes) 1L) nstripes
+		    in
+		    (name,(start,allocated_extents)))
+	  (st.st_stripes)
+
+let allocation_of_lv lv =
+  List.flatten 
+    (List.map allocation_of_segment lv.segments)
+
+let size_in_extents lv =
+  List.fold_left (Int64.add) 0L
+    (List.map (fun seg -> seg.s_extent_count) lv.segments)
+	    
+let reduce_size_to lv new_seg_count =
+  let cur_size = size_in_extents lv in
+  if cur_size < new_seg_count then (failwith (Printf.sprintf "Cannot reduce size: current size (%Ld) is less than requested size (%Ld)" cur_size new_seg_count));
+  let rec doit segs left acc =
+    match segs with 
+      | s::ss ->
+	  if left > s.s_extent_count then
+	    doit ss (Int64.sub left s.s_extent_count) (s::acc)
+	  else
+	    {s with s_extent_count = left}::acc
+      | _ -> acc
+  in
+  {lv with segments = (doit lv.segments new_seg_count [])}
+
+let increase_allocation lv new_segs =
+  {lv with segments=lv.segments @ new_segs}
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/lvm_uuid.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/lvm_uuid.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,43 @@
+(* LVM uses uuids that aren't really proper uuids. This module manipulates them *)
+
+type t = string
+
+let format = [6; 4; 4; 4; 4; 4; 6] 
+
+let charlist = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!#"
+
+let dev_random = "/dev/urandom"
+
+let read_random n = 
+  let ic = open_in_bin dev_random in
+  try
+    let result = Array.init n (fun _ -> input_byte ic) in
+    close_in ic;
+    result
+  with e ->
+    close_in ic;
+    raise e
+
+let create () =
+(*  let bytes = read_random 32 in*)
+  let s = String.make (32+6) '-' in
+  let rec make i j n f =
+    if n=0 then match f with
+      | n'::ns -> make i (j+1) n' ns
+      | _ -> ()
+    else (s.[j] <- charlist.[Random.int 62]; make (i+1) (j+1) (n-1) f)
+  in
+  make 0 0 (List.hd format) (List.tl format);
+    s
+
+let add_hyphens str =
+  let str2 = String.make (32+6) '-' in
+  let foldfn (i,j) n = String.blit str i str2 j n; (i+n,j+n+1) in
+  ignore(List.fold_left foldfn (0,0) format);
+  str2
+
+let remove_hyphens str =
+  let str2 = String.create 32 in
+  let foldfn (i,j) n = String.blit str i str2 j n; (i+n+1, j+n) in
+  ignore(List.fold_left foldfn (0,0) format);
+  str2
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/lvmconfig.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/lvmconfig.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,60 @@
+
+let size=65536 (* 64k. no particular reason *)
+
+let parse text =
+  let lexbuf = Lexing.from_string text in
+  Lvmconfigparser.start Lvmconfiglex.lvmtok lexbuf
+
+let to_text vg =
+  let b = Buffer.create size in
+  let bp = Printf.bprintf in
+  bp b "%s {\nid = \"%s\"\nseqno = %d\nstatus = [%s]\nextent_size = %Ld\nmax_lv = %d\nmax_pv = %d\n\n"
+    vg.Lvmty.VG.name vg.Lvmty.VG.id vg.Lvmty.VG.seqno
+    (String.concat ", " (List.map (fun x -> Printf.sprintf "\"%s\"" (Lvmty.VG.status_to_string x)) vg.Lvmty.VG.status))
+    vg.Lvmty.VG.extent_size vg.Lvmty.VG.max_lv vg.Lvmty.VG.max_pv;
+
+  let write_pv pv =
+    bp b "\n%s {\nid = \"%s\"\ndevice = \"%s\"\n\nstatus = [%s]\ndev_size = %Ld\npe_start = %Ld\npe_count = %Ld\n}\n" pv.Lvmty.PV.name pv.Lvmty.PV.id pv.Lvmty.PV.dev 
+      (String.concat ", " (List.map (fun x -> Printf.sprintf "\"%s\"" (Lvmty.PV.status_to_string x)) pv.Lvmty.PV.status))
+      pv.Lvmty.PV.dev_size pv.Lvmty.PV.pe_start pv.Lvmty.PV.pe_count
+  in
+
+  bp b "physical_volumes {\n";
+  List.iter write_pv vg.Lvmty.VG.pvs;
+  bp b "}\n\n";
+
+  let write_lv lv =
+    bp b "\n%s {\nid = \"%s\"\nstatus = [%s]\n" lv.Lvmty.LV.name lv.Lvmty.LV.id 
+      (String.concat ", " (List.map (fun x -> Printf.sprintf "\"%s\"" (Lvmty.LV.status_to_string x)) lv.Lvmty.LV.status));
+    if List.length lv.Lvmty.LV.tags > 0 then 
+      bp b "tags = [%s]\n" (String.concat ", " (List.map (fun s -> Printf.sprintf "\"%s\"" s) lv.Lvmty.LV.tags));
+    bp b "segment_count = %d\n\n" (Array.length lv.Lvmty.LV.segments);
+    Array.iteri (fun i s -> 
+      let stripes = Array.length s.Lvmty.LV.stripes in
+      bp b "segment%d {\nstart_extent = %Ld\nextent_count = %Ld\n\ntype = \"striped\"\nstripe_count = %d%s\n\nstripes = [\n" (i+1) s.Lvmty.LV.start_extent s.Lvmty.LV.extent_count
+	stripes (if stripes=1 then "\t# linear" else "");
+      Array.iter (fun (pv,offset) -> bp b "\"%s\", %Ld\n" pv offset) s.Lvmty.LV.stripes;
+      bp b "]\n}\n") lv.Lvmty.LV.segments;
+    bp b "}\n"
+  in
+
+  bp b "logical_volumes {\n";
+  List.iter write_lv vg.Lvmty.VG.lvs;
+  bp b "}\n}\n";
+
+  bp b "# Generated by MLVM version 0.1: \n\n";
+  bp b "contents = \"Text Format Volume Group\"\n";
+  bp b "version = 1\n\n";
+  bp b "description = \"\"\n\n";
+  bp b "creation_host = \"%s\"\n" "<need uname!>";
+  bp b "creation_time = %Ld\n\n" (Int64.of_float (Unix.time ()));
+  Buffer.contents b
+
+  
+      
+      
+	
+
+
+    
+  
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/lvmconfiglex.mll
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/lvmconfiglex.mll	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,29 @@
+{
+open Lvmconfigparser
+}
+
+let digit = ['0'-'9']
+let name = ['a'-'z' 'A'-'Z' '0'-'9' '.' '_' '+'] ['a'-'z' 'A'-'Z' '0'-'9' '.' '_' '+' '-']*
+ 
+rule lvmtok = parse
+  | '#' [^ '\n']* '\n' 
+      { lvmtok lexbuf } (* Ignore comments *)
+  | ['\t' '\n' ' '] 
+      { lvmtok lexbuf } (* Ignore whitespace *)
+  | digit+ as inum 
+      { Integer (Int64.of_string inum) }
+  | '\"' [^ '\"']* '\"' as str 
+      { String (String.sub str 1 (String.length str - 2)) }
+  | '{' { BeginStruct } 
+  | '}' { EndStruct } 
+  | '[' { BeginArray }
+  | ']' { EndArray }
+  | '=' { Equals }
+  | ',' { Comma }
+  | name as str 
+      { Ident str }
+  | _ as c
+      { Printf.printf "Unrecognized character: '%c'\n" c;
+	lvmtok lexbuf
+      }
+  | eof { Eof } 
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/lvmconfigparser.mly
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/lvmconfigparser.mly	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,46 @@
+%{
+
+ open Absty
+
+ let rec fieldstr f =
+   match f with 
+     | AInt x -> Printf.sprintf "%Ld" x
+     | AStr x -> Printf.sprintf "'%s'" x
+     | AStruct x -> "{\n" ^ (String.concat "," (List.map (fun (x,y) -> Printf.sprintf "%s: %s\n" x (fieldstr y)) x)) ^ "}\n"
+     | AArr x -> "[" ^ (String.concat "," (List.map fieldstr x)) ^ "]"
+
+%}
+
+%token <int64> Integer
+%token <string> String
+%token BeginStruct EndStruct BeginArray EndArray Comma Equals Eof
+%token <string> Ident
+
+%start start
+
+%type <Absty.absty> start
+
+%%
+
+start:  fields { AStruct $1 }
+;
+
+fields: 
+| Ident BeginStruct fields EndStruct fields { ($1,AStruct $3)::$5 }
+| Ident Equals Integer fields { ($1,AInt $3)::$4 }
+| Ident Equals String fields { ($1,AStr $3)::$4 }
+| Ident Equals BeginArray array EndArray fields { ($1,AArr $4)::$6 }
+| Eof { [] }
+| /* nothing */ { [] }
+
+array:
+| String morearray { (AStr $1)::$2 }
+| Integer morearray { (AInt $1)::$2 }
+| { [] }
+
+morearray:
+| Comma String morearray { (AStr $2)::$3 }
+| Comma Integer morearray { (AInt $2)::$3 }
+| { [] }
+
+
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/lvmmarshal.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/lvmmarshal.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,107 @@
+(** Guarantee to read 'n' bytes from a file descriptor or raise End_of_file *)
+let really_read (fd: Unix.file_descr) n = 
+  let buffer = String.make n '\000' in
+  let rec really_read off n =
+    if n=0 then buffer else
+      let m = Unix.read fd buffer off n in
+      if m = 0 then raise End_of_file;
+      really_read (off+m) (n-m)
+  in
+  really_read 0 n
+
+let unmarshal_uint8 (s, offset) =
+  int_of_char s.[offset], (s, offset+1)
+
+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 = int_of_char (s.[offset + offsets.(0)]) 
+  and b = int_of_char (s.[offset + offsets.(1)]) in
+  (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 = 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)
+
+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 = 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)])) 
+  and d = Int64.of_int (int_of_char (s.[offset + offsets.(3)])) 
+  and e = Int64.of_int (int_of_char (s.[offset + offsets.(4)])) 
+  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)
+
+let unmarshal_string len (s,offset) =
+  String.sub s offset len, (s, offset + len)
+
+let skip len (s,offset) =
+  (s,offset+len)
+
+let marshal_int8 (s,offset) x =
+  s.[offset] <- char_of_int x;
+  (s,offset+1)
+
+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
+  and (&&) a b = a land b 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
+  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
+  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);
+  s.[offset+offsets.(3)] <- char_of_int (Int32.to_int d);
+  (s,offset+4)
+
+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
+  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
+  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);
+  s.[offset+offsets.(3)] <- char_of_int (Int64.to_int d);
+  s.[offset+offsets.(4)] <- char_of_int (Int64.to_int e);
+  s.[offset+offsets.(5)] <- char_of_int (Int64.to_int f);
+  s.[offset+offsets.(6)] <- char_of_int (Int64.to_int g);
+  s.[offset+offsets.(7)] <- char_of_int (Int64.to_int h);
+  (s,offset+8)
+
+let marshal_string (s,offset) x =
+  let l = String.length x in
+  String.blit x 0 s offset l;
+  (s,offset+l)
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/pv.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/pv.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,552 @@
+(** Physical Volume module *)
+
+open Absty
+
+(** Start with the meta-metadata - this is how we actually locate the 
+    metadata on disk. It's a bit backwards, because a PV is part of a 
+    volume group, but it's the PV that contains the volume group info *)
+
+open Lvmmarshal
+
+(** Dummy mode stuff *)
+
+let dummy_fname dev ty =
+  let fname = Printf.sprintf "%s/%s/%s" (!Constants.dummy_base) dev ty in
+  let basedir = Filename.dirname fname in
+  Unixext.mkdir_rec basedir 0o755;
+  fname
+
+    
+(** Label bits and pieces *)
+
+module Label = struct 
+  type label_header = {
+    id : string; (* 8 bytes, equal to label_id in Constants *)
+    sector : int64;
+    crc : int32;
+    offset : int32;
+    ty : string (* 8 bytes, equal to "LVM2 001" - Constants.label_type*)
+  }
+      
+  type disk_locn = {
+    dl_offset : int64;
+    dl_size : int64;
+  }
+
+  type 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 = {
+    device : string;
+    label_header : label_header;
+    pv_header : pv_header;
+  }
+
+  let unmarshal_header b0 =
+    let id,b = unmarshal_string 8 b0 in
+    let sector_xl,b = unmarshal_uint64 b in
+    let crc_xl,b = unmarshal_uint32 b in
+    let offset,b = unmarshal_uint32 b in
+    let ty,b = unmarshal_string 8 b in
+    let crc_check = String.sub (fst b0) (20 + snd b0) (Constants.label_size - 20) in (* wtf? *)
+    let calculated_crc = Crc.crc crc_check Crc.initial_crc in
+    if calculated_crc <> crc_xl then
+      failwith "Bad checksum in PV Label";
+    {id=id;
+     sector=sector_xl;
+     crc=crc_xl;
+     offset=offset;
+     ty=ty}
+      
+  let find_label dev =
+    let fd = Unix.openfile (if !Constants.dummy_mode then dummy_fname dev "pvh" else dev) [Unix.O_RDONLY] 0o000 in
+    let buf = really_read fd (if !Constants.dummy_mode then (Constants.sector_size * 2) else Constants.label_scan_size) in
+    Unix.close fd;
+    let rec find n =
+      if n>3 then failwith "No label found" else begin
+	let b = (buf,n*Constants.sector_size) in
+	let (s,b') = unmarshal_string 8 b in
+	Printf.fprintf stderr "String='%s' (looking for %s)\n" s Constants.label_id;
+	if s=Constants.label_id then (unmarshal_header b,b) else find (n+1)
+      end
+    in find 0
+    
+  let label_header_to_ascii label =
+    Printf.sprintf "id: %s\nsector: %Ld\ncrc: %ld\noffset: %ld\nty: %s\n" label.id label.sector label.crc label.offset label.ty
+      
+  let read_pv_header label b =
+    let b = skip (Int32.to_int label.offset) b in
+    let id,b = unmarshal_string 32 b in
+    let size,b = unmarshal_uint64 b in
+    let rec do_disk_locn b acc =
+      let offset,b = unmarshal_uint64 b in
+      if offset=0L 
+      then (List.rev acc,skip 8 b) 
+      else 
+	let size,b = unmarshal_uint64 b in
+	do_disk_locn b ({dl_offset=offset; dl_size=size}::acc)
+    in 
+    let disk_areas,b = do_disk_locn b [] in
+    let disk_areas2,b = do_disk_locn b [] in
+    { pvh_id=Lvm_uuid.add_hyphens id;
+      pvh_device_size=size;
+      pvh_extents=disk_areas;
+      pvh_metadata_areas=disk_areas2},b
+
+  let write_label_and_pv_header l =
+    let label = l.label_header in
+    let pvh = l.pv_header in
+    let dev = l.device in
+
+    let header = (String.make Constants.sector_size '\000', 0) in (* label header is 1 sector long *)
+    let pos = Int64.mul label.sector (Int64.of_int Constants.sector_size) in
+    assert(label.offset=32l);
+    
+    let header = marshal_string header label.id in
+    let header = marshal_int64  header label.sector in
+    
+    let crc_pos = header in (* Set later! *)
+    let header = marshal_int32  header 0l in
+    
+    let (do_crc_str,do_crc_from) = header in
+    let header = marshal_int32  header label.offset in
+    let header = marshal_string header label.ty in
+    
+    assert(snd header = 32);
+    
+    (* 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
+    
+    let do_disk_locn header l =       
+      let header = List.fold_left (fun header e ->
+        let header = marshal_int64 header e.dl_offset in
+        marshal_int64 header e.dl_size) header l
+      in
+      marshal_int64 (marshal_int64 header 0L) 0L
+    in
+    
+    let header = do_disk_locn header pvh.pvh_extents in
+    let header = do_disk_locn header pvh.pvh_metadata_areas in
+    
+    (* Now calc CRC *)
+    let crc = Crc.crc (String.sub do_crc_str do_crc_from (Constants.label_size - do_crc_from)) Crc.initial_crc in
+    ignore(marshal_int32 crc_pos crc);
+    
+    let fd = 
+      if !Constants.dummy_mode then begin
+	let fname = dummy_fname dev "pvh" in 
+	Unix.openfile fname [Unix.O_RDWR; Unix.O_DSYNC; Unix.O_CREAT] 0o644
+      end else begin
+	let fd = Unix.openfile dev [Unix.O_RDWR; Unix.O_DSYNC] 0o000 in
+	fd
+      end
+    in
+
+    ignore(Unix.LargeFile.lseek fd pos Unix.SEEK_SET);
+      
+    let str = fst header in
+    let len = String.length str in
+    if len <> (Unix.write fd str 0 len) then failwith "Short write!";
+    
+    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
+
+  let get_pv_id label =
+    label.pv_header.pvh_id
+
+  let get_device label = 
+    label.device
+
+  let find device =
+    let label,b = find_label device in
+    let pvh,b' = read_pv_header label b in    
+    { device = device;
+      label_header = label;
+      pv_header = pvh; }
+      
+  let create device id size extents_start extents_size mda_start mda_size =
+    let label = {
+      id=Constants.label_id;
+      sector=1L;
+      crc=0l;
+      offset=32l;
+      ty=Constants.label_type;
+    } in
+    let pvh = {
+      pvh_id=id;
+      pvh_device_size=size;
+      pvh_extents=[{dl_offset=(Int64.add mda_start mda_size); dl_size=0L}];
+      pvh_metadata_areas=[{dl_offset=mda_start; dl_size=mda_size}];
+    } in
+    { device = device;
+      label_header = label;
+      pv_header = pvh }
+
+  let to_ascii label =
+    Printf.sprintf "Label header:\n%s\nPV Header:\n%s\n" 
+      (label_header_to_ascii label.label_header)
+      (pvh_to_ascii label.pv_header)
+
+end
+    
+module MDAHeader = struct
+  type mda_raw_locn = {
+    mrl_offset: int64;
+    mrl_size: int64;
+    mrl_checksum: int32;
+    mrl_filler: int32;
+  }
+
+  let mda_header_size = Constants.sector_size
+
+  type mda_header = {
+    mdah_checksum : int32;
+    mdah_magic : string;
+    mdah_version : int32;
+    mdah_start: int64;
+    mdah_size: int64;
+    mdah_raw_locns : mda_raw_locn list;
+  }
+
+  let unmarshal_mda_header device location =
+    let offset,fd = 
+      if !Constants.dummy_mode 
+      then (0L,Unix.openfile (dummy_fname device "mdah") [Unix.O_RDONLY] 0o000) 
+      else (location.Label.dl_offset,Unix.openfile device [Unix.O_RDONLY] 0o000) in
+    ignore(Unix.LargeFile.lseek fd offset Unix.SEEK_SET);
+    let buf = really_read fd (mda_header_size) in
+    Unix.close fd;
+    let checksum,b = unmarshal_uint32 (buf,0) in
+    let magic,b = unmarshal_string 16 b in
+    let version,b = unmarshal_uint32 b in
+    let start,b = unmarshal_uint64 b in
+    let size,b = unmarshal_uint64 b in
+    let rec read_raw_locns b acc =
+      let offset,b = unmarshal_uint64 b in
+      let size,b = unmarshal_uint64 b in
+      let checksum,b = unmarshal_uint32 b in
+      let filler,b = unmarshal_uint32 b in
+      if (offset=0L) 
+      then (List.rev acc),b
+      else 
+	read_raw_locns b ({mrl_offset=offset;mrl_size=size;mrl_checksum=checksum;mrl_filler=filler}::acc)
+    in
+    let raw_locns,b = read_raw_locns b [] in
+    let crc_to_check = String.sub buf 4 (mda_header_size - 4) in
+    let crc = Crc.crc crc_to_check Crc.initial_crc in
+    if crc <> checksum then
+      failwith "Bad checksum in MDA header";
+    {mdah_checksum=checksum;
+     mdah_magic=magic;
+     mdah_version=version;
+     mdah_start=start;
+     mdah_size=size;
+     mdah_raw_locns=raw_locns}
+
+  let to_ascii mdah =
+    let rl2ascii r = Printf.sprintf "{offset:%Ld,size:%Ld,checksum:%ld,filler:%ld}" r.mrl_offset r.mrl_size r.mrl_checksum r.mrl_filler in
+    Printf.sprintf "checksum: %ld\nmagic: %s\nversion: %ld\nstart: %Ld\nsize: %Ld\nraw_locns:[%s]\n"
+      mdah.mdah_checksum mdah.mdah_magic mdah.mdah_version mdah.mdah_start mdah.mdah_size (String.concat "," (List.map rl2ascii mdah.mdah_raw_locns))
+          
+  let write_mda_header mdah device  =
+    Debug.debug "Writing MDA header";
+    Debug.debug (Printf.sprintf "Writing: %s" (to_ascii mdah));
+    let realheader = (String.make mda_header_size '\000', 0) in (* Mda header is 1 sector long *)
+    let header = marshal_int32 realheader 0l in (* Write the checksum later *)
+    let header = marshal_string header mdah.mdah_magic in
+    let header = marshal_int32 header mdah.mdah_version in
+    let header = marshal_int64 header mdah.mdah_start in
+    let header = marshal_int64 header mdah.mdah_size in
+    let write_raw_locn header locn =
+      let header = marshal_int64 header locn.mrl_offset in
+      let header = marshal_int64 header locn.mrl_size in
+      let header = marshal_int32 header locn.mrl_checksum in
+      let header = marshal_int32 header locn.mrl_filler in
+      header
+    in
+    let header = List.fold_left write_raw_locn header mdah.mdah_raw_locns in
+    let header = write_raw_locn header {mrl_offset=0L; mrl_size=0L; mrl_checksum=0l; mrl_filler=0l} in
+    let crcable = String.sub (fst realheader) 4 (mda_header_size - 4) in
+    let crc = Crc.crc crcable Crc.initial_crc in
+    let _ = marshal_int32 realheader crc in
+    
+    let fd = 
+      if !Constants.dummy_mode then begin
+	Unix.openfile (dummy_fname device "mdah") [Unix.O_RDWR; Unix.O_DSYNC; Unix.O_CREAT] 0o644
+      end else begin
+        let fd = Unix.openfile device [Unix.O_RDWR; Unix.O_DSYNC] 0o000 in
+	ignore(Unix.LargeFile.lseek fd mdah.mdah_start Unix.SEEK_SET);
+	fd
+      end
+    in
+    let written = Unix.write fd (fst header) 0 mda_header_size in
+    if written <> Constants.sector_size then failwith "Wrote short!";
+    Unix.close fd
+      
+  let read_md dev mdah n =
+    (* debug *)
+    let oc = open_out "/tmp/hdr" in
+    Printf.fprintf oc "%s\n%!" (to_ascii mdah);
+    close_out oc;
+
+    let locn = List.nth mdah.mdah_raw_locns n in
+    let fd = 
+      if !Constants.dummy_mode then begin
+	Unix.openfile (dummy_fname dev "md") [Unix.O_RDONLY] 0o000
+      end else begin
+	let fd = Unix.openfile dev [Unix.O_RDONLY] 0o000 in
+	ignore(Unix.LargeFile.lseek fd (Int64.add mdah.mdah_start locn.mrl_offset) Unix.SEEK_SET);  
+	fd
+      end
+    in
+    let md = 
+      if(Int64.add locn.mrl_offset locn.mrl_size > mdah.mdah_size) 
+      then
+	let firstbit = Int64.to_int (Int64.sub mdah.mdah_size locn.mrl_offset) in
+	let firstbitstr = really_read fd firstbit in
+	let secondbit = (Int64.to_int locn.mrl_size) - firstbit - 1 in
+	if not !Constants.dummy_mode then ignore(Unix.LargeFile.lseek fd (Int64.add mdah.mdah_start 512L) Unix.SEEK_SET);  
+	let secondbitstr = really_read fd secondbit in
+	firstbitstr ^ secondbitstr
+      else
+	really_read fd (Int64.to_int locn.mrl_size - 1) in
+    let checksum = Crc.crc md Crc.initial_crc in
+    Unix.close fd;
+    if checksum <> locn.mrl_checksum then
+      Printf.fprintf stderr "Checksum invalid in metadata: Found %lx, expecting %lx\n" checksum locn.mrl_checksum;
+    md
+      
+  let write_md device mdah md =
+    (* Find the current raw location of the metadata, assuming there's only one copy *)
+    let current = List.hd mdah.mdah_raw_locns in
+    
+    (* Find the new place to write (as an offset from the position of the metadata area)
+     * LVM always rounds up to the next sector, so we'll do the same. *)
+    let newpos = Utils.int64_round_up (Int64.add current.mrl_offset current.mrl_size) 512L in
+
+    (* Check if we've gone outside the mda *)
+    let newpos = 
+      if newpos >= mdah.mdah_size then
+	(Int64.add 512L (Int64.sub newpos mdah.mdah_size))
+      else 
+	newpos
+    in
+
+    (* debug *)
+    let oc = open_out "/tmp/hdr" in
+    Printf.fprintf oc "%s\n%!" (to_ascii mdah);
+    close_out oc;
+
+    (* Add on the position of the metadata area *)
+    let absnewpos = Int64.add newpos mdah.mdah_start in
+
+    let size = String.length md in
+
+    let fd = 
+      if !Constants.dummy_mode then begin
+	Unix.openfile (dummy_fname device "md") [Unix.O_RDWR; Unix.O_DSYNC; Unix.O_CREAT] 0o644
+      end else begin
+	let fd = Unix.openfile device [Unix.O_RDWR; Unix.O_DSYNC] 0o000 in
+	ignore(Unix.LargeFile.lseek fd absnewpos Unix.SEEK_SET);          
+	fd
+      end
+    in
+
+    (* Check whether we're going to wrap or not *)
+    if Int64.add newpos (Int64.of_int size) > mdah.mdah_size 
+    then begin
+      let firstbit = Int64.to_int (Int64.sub mdah.mdah_size newpos) in
+      if (Unix.write fd md 0 firstbit) <> firstbit then failwith "Wrote short!";
+      let secondbit = size - firstbit in
+      if not !Constants.dummy_mode then ignore(Unix.LargeFile.lseek fd (Int64.add 512L mdah.mdah_start) Unix.SEEK_SET);
+      if (Unix.write fd md firstbit secondbit) <> secondbit then failwith "Wrote short!"; 
+      Unix.close fd;
+    end else begin    
+      if (Unix.write fd md 0 size) <> size then 
+	failwith "Wrote short!";
+      Unix.close fd;
+    end;
+
+
+    (* Now we have to update the crc and pointer to the metadata *)
+    
+    let checksum = Crc.crc md Crc.initial_crc in
+    let new_raw_locn = {
+      mrl_offset=newpos;
+      mrl_size=Int64.of_int size;
+      mrl_checksum=checksum;
+      mrl_filler=0l;
+    } in
+
+    let mdah = {mdah with mdah_raw_locns=[new_raw_locn]} in
+    write_mda_header mdah device;
+    mdah
+
+
+  let create_blank () =
+    let mda_raw_locn = {
+      mrl_offset = 512L;
+      mrl_size = 0L;
+      mrl_checksum = 0l;
+      mrl_filler=0l;
+    } in
+    let mda_header = {
+      mdah_checksum = 0l;
+      mdah_magic = Constants.fmtt_magic;
+      mdah_version = 1l;
+      mdah_start = Constants.mdah_start;
+      mdah_size = Constants.mdah_size;
+      mdah_raw_locns = [mda_raw_locn]
+    } in
+    mda_header
+end
+
+  (** Here's the actual PV data that's part of the volume group *)
+  
+type status = 
+    | Allocatable
+	
+type physical_volume = {
+  name : string;
+  id : string;
+  dev : string;
+  real_device : string; (* Actual device we're reading/writing to/from *)
+  status : status list;
+  dev_size : int64;
+  pe_start : int64;
+  pe_count : int64;
+  label : Label.t;  (* The one label for this PV *)
+  mda_headers : MDAHeader.mda_header list; 
+}
+
+let status_to_string s =
+  match s with
+    | Allocatable -> "ALLOCATABLE"
+
+let status_of_string s =
+  match s with
+    | "ALLOCATABLE" -> Allocatable
+    | _ -> failwith "Bad status string"
+
+let write_to_buffer b pv =
+  let bprintf = Printf.bprintf in
+  bprintf b "\n%s {\nid = \"%s\"\ndevice = \"%s\"\n\n" pv.name pv.id pv.dev;
+  bprintf b "status = [%s]\ndev_size = %Ld\npe_start = %Ld\npe_count = %Ld\n}\n" 
+    (String.concat ", " (List.map (o quote status_to_string) pv.status))
+    pv.dev_size pv.pe_start pv.pe_count
+
+let of_metadata name config pvdatas =
+  let id = expect_mapped_string "id" config in
+  let device = expect_mapped_string "device" config in
+  let status = map_expected_mapped_array "status" 
+    (fun a -> status_of_string (expect_string "status" a)) config in
+  let dev_size = expect_mapped_int "dev_size" config in
+  let pe_start = expect_mapped_int "pe_start" config in
+  let pe_count = expect_mapped_int "pe_count" config in
+  let label,mdahs = 
+    try 
+      let res = List.find (fun (label,mdahs) -> id=Label.get_pv_id label) pvdatas in
+      Printf.fprintf stderr "Found cached PV label data\n";
+      res
+    with Not_found -> 
+      try
+	Printf.fprintf stderr "No cached PV data found - loading from device '%s'\n" device;
+	let label = Label.find device in
+	let mda_locs = Label.get_metadata_locations label in
+	let mdahs = List.map (MDAHeader.unmarshal_mda_header device) mda_locs in
+	(label,mdahs)
+      with e ->
+	Printf.fprintf stderr "Error: Could not find label and/or MDA headers on device '%s'\n" 
+	  device;
+	raise e
+  in
+  let real_device = Label.get_device label in
+  if real_device <> device then
+    Printf.fprintf stderr "WARNING: PV.device and real_device are not the same";
+  {name=name;
+   id=id;
+   dev=device;
+   real_device=real_device;
+   status=status;
+   dev_size=dev_size;
+   pe_start=pe_start;
+   pe_count=pe_count;
+   label=label;
+   mda_headers=mdahs;
+  }
+
+(** 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); *)
+  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  
+  (mdt, (label, mdahs))
+
+let human_readable pv =
+  let label=pv.label in
+  let b=Buffer.create 1000 in
+  let label_str=Label.to_ascii label in
+  let mdah_ascii = String.concat "\n" (List.map MDAHeader.to_ascii pv.mda_headers) in
+  write_to_buffer b pv;
+  Printf.sprintf "Label:\n%s\nMDA Headers:\n%s\n%s\n" 
+    label_str mdah_ascii (Buffer.contents b)
+
+let create_new dev name =
+  let size = 
+    if !Constants.dummy_mode then 
+      Constants.tib
+    else 
+      let fd = Unix.openfile dev [Unix.O_RDONLY] 0 in
+      let size = Unixext.blkgetsize64 fd in
+      Unix.close fd;
+      size
+  in
+  (* Arbitrarily put the MDA at 4096. We'll have a 10 meg MDA too *)
+  let dev_size = Int64.div size (Int64.of_int Constants.sector_size) in
+  let mda_pos = Constants.mdah_start in
+  let mda_len = Constants.mdah_size in
+  let pe_start_byte = 
+    Utils.int64_round_up (Int64.add mda_pos mda_len) Constants.pe_align in
+  let pe_start_sector = Int64.div pe_start_byte 
+    (Int64.of_int Constants.sector_size) in
+  let pe_count = Int64.div (Int64.sub size pe_start_byte) Constants.extent_size in
+  let mda_len = Int64.sub pe_start_byte mda_pos in
+  let id=Lvm_uuid.create () in
+  let label = Label.create dev id size pe_start_sector 
+    (Int64.mul pe_count Constants.extent_size)
+    mda_pos mda_len in
+  let mda_header = MDAHeader.create_blank () in
+  Label.write_label_and_pv_header label;
+  MDAHeader.write_mda_header mda_header dev;
+  let pv = { name=name;
+	     id=id;
+	     dev=dev;
+	     real_device=dev;
+	     status=[Allocatable];
+	     dev_size = dev_size;
+	     pe_start=pe_start_sector;
+	     pe_count=pe_count;
+	     label = label;
+	     mda_headers = [mda_header]; }
+  in
+  pv
+      
+      
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/redo.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/redo.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,111 @@
+
+type lvcreate_t = {
+  lvc_id : string;
+  lvc_segments : Allocator.t
+}
+
+type lvrename_t = {
+  lvmv_new_name : string;
+}
+
+type lvreduce_t = {
+  lvrd_new_extent_count : int64;
+}
+
+type lvexpand_t = {
+  lvex_segments : Allocator.t;
+}
+    
+type 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 = {
+  so_seqno : int;
+  so_op : operation
+}
+
+open Debug
+
+(** Marshal to and from a string *)
+let redo_to_string (l : sequenced_op) = 
+  let s = Marshal.to_string l [] in
+  let len = String.length s in
+  Printf.sprintf "%012d%s" len s
+
+(** Return tuple of operation * int where int is total length of the marshalled operation *)
+let redo_of_string s ofs = 
+  let len = int_of_string (String.sub s ofs 12) in
+  let res = String.sub s (ofs+12) len in
+  ((Marshal.from_string res 0 : sequenced_op),(12+len))
+
+
+exception OutOfSize of int
+
+(** The initial pos is the absolute position of the first unset byte in the LV *)
+let read_initial_pos fd offset =
+  ignore(Unix.LargeFile.lseek fd offset Unix.SEEK_SET);
+  let pos = try Int64.of_string (Unixext.really_read_string fd 12) with _ -> (Int64.add offset 12L) in
+  pos
+    
+let write_initial_pos fd offset pos =
+  ignore(Unix.LargeFile.lseek fd offset Unix.SEEK_SET);
+  let pos_str = Printf.sprintf "%012Ld" pos in
+  ignore(Unix.write fd pos_str 0 12)
+  
+let write fd offset size ops =
+  let pos = read_initial_pos fd offset in
+  let rec write ofs ops =
+    match ops with
+      | op::ops ->
+	  let str = redo_to_string op in
+	  debug ("LVM REDO: " ^ str);
+	  let len = String.length str in
+	  if (Int64.add ofs (Int64.of_int len)) > (Int64.add offset size) then
+	    raise (OutOfSize op.so_seqno)
+	  else begin
+	    ignore(Unix.LargeFile.lseek fd ofs Unix.SEEK_SET);
+	    Unix.write fd str 0 len;
+	    let new_pos = Int64.add ofs (Int64.of_int len) in
+	    write_initial_pos fd offset new_pos;
+	    write new_pos ops
+	  end
+      | [] -> ()
+  in write pos (List.rev ops)
+
+let read fd offset size =
+  debug "Redo.read";
+  let end_ofs = read_initial_pos fd offset in
+  let start_ofs = Int64.add offset 12L in
+  let size = Int64.sub end_ofs start_ofs in
+  debug (Printf.sprintf "start_ofs: %Ld end_ofs: %Ld size: %Ld" start_ofs end_ofs size);
+  ignore(Unix.LargeFile.lseek fd start_ofs Unix.SEEK_SET);
+  let string = Unixext.really_read_string fd (Int64.to_int size) in
+  let rec read_ops pos ops =
+    debug (Printf.sprintf "Reading from pos: %d" pos);
+    if pos>=String.length string 
+    then ops 
+    else 
+      let (op,length)=redo_of_string string pos in
+      read_ops (pos+length) (op::ops)
+  in
+  let result = read_ops 0 [] in
+  debug "Redo.read finished";
+  result
+
+let reset fd offset =
+  write_initial_pos fd offset (Int64.add offset 12L)
+  
+let redo_to_human_readable op =
+  let opstr = 
+    match op.so_op with
+      | LvCreate (name,_) -> Printf.sprintf "LvCreate(%s)" name
+      | LvRemove name -> Printf.sprintf "LvRemove(%s)" name
+      | LvReduce (name,_) -> Printf.sprintf "LvReduce(%s)" name
+      | LvExpand (name,_) -> Printf.sprintf "LvExpand(%s)" name
+      | LvRename (name,_) -> Printf.sprintf "LvRename(%s)" name
+  in
+  Printf.sprintf "{seqno=%d; op=%s}" op.so_seqno opstr
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/utils.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/utils.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,7 @@
+let (--) = Int64.sub
+let (++) = Int64.add
+let (//) = Int64.div
+let ( *** ) = Int64.mul
+
+let int64_round_up value blocksize =
+  blocksize *** ((value ++ blocksize -- 1L) // blocksize)
diff -r 820f16fdbb7d -r fe8ef0c4a5ea mlvm/vg.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/mlvm/vg.ml	Mon Dec 21 15:11:15 2009 +0000
@@ -0,0 +1,467 @@
+open Absty
+open Redo
+open Debug
+
+type status =
+    | Read
+    | Write
+    | Resizeable
+    | Clustered
+
+type vg = {
+  name : string;
+  id : string;
+  seqno : int;
+  status : status list;
+  extent_size : int64;
+  max_lv : int;
+  max_pv : int;
+  pvs : Pv.physical_volume list; (* Device to pv map *)
+  lvs : Lv.logical_volume list;
+  free_space : Allocator.t;
+  redo_lv : string option; (* Name of the redo LV *)
+  ops : sequenced_op list;
+}
+  
+let status_to_string s =
+  match s with
+    | Resizeable -> "RESIZEABLE"
+    | Write -> "WRITE"
+    | Read -> "READ"
+    | Clustered -> "CLUSTERED"
+
+let status_of_string s =
+  match s with 
+    | "RESIZEABLE" -> Resizeable
+    | "WRITE" -> Write
+    | "READ" -> Read
+    | "CLUSTERED" -> Clustered
+    | _ -> failwith (Printf.sprintf "Unknown VG status string '%s'" s)
+
+let write_to_buffer b vg =
+  let bprintf = Printf.bprintf in
+  bprintf b "%s {\nid = \"%s\"\nseqno = %d\n"
+    vg.name vg.id vg.seqno;
+  bprintf b "status = [%s]\nextent_size = %Ld\nmax_lv = %d\nmax_pv = %d\n\n"
+    (String.concat ", " (List.map (o quote status_to_string) vg.status))
+    vg.extent_size vg.max_lv vg.max_pv;
+
+  bprintf b "physical_volumes {\n";
+  List.iter (Pv.write_to_buffer b) vg.pvs;
+  bprintf b "}\n\n";
+
+  bprintf b "logical_volumes {\n";
+  List.iter (Lv.write_to_buffer b) vg.lvs;
+  bprintf b "}\n}\n";
+
+  bprintf b "# Generated by MLVM version 0.1: \n\n";
+  bprintf b "contents = \"Text Format Volume Group\"\n";
+  bprintf b "version = 1\n\n";
+  bprintf b "description = \"\"\n\n";
+  bprintf b "creation_host = \"%s\"\n" "<need uname!>";
+  bprintf b "creation_time = %Ld\n\n" (Int64.of_float (Unix.time ()))
+    
+
+let to_string vg = 
+  let size=65536 in (* 64k. no particular reason *)
+  let b = Buffer.create size in
+  write_to_buffer b vg;
+  Buffer.contents b
+
+
+(*************************************************************)
+(* METADATA CHANGING OPERATIONS                              *)
+(*************************************************************)
+
+let do_op vg op =
+  (if vg.seqno <> op.so_seqno then failwith "Failing to do VG operation out-of-order");
+  let rec createsegs ss lstart = 
+    match ss with 
+      | a::ss ->
+	  let length = Allocator.get_size a in
+	  let pv_name = Allocator.get_name a in
+	  ({Lv.s_start_extent=lstart; s_extent_count=length; 
+	    s_cls=Lv.Linear {Lv.l_pv_name=pv_name; 
+			     l_pv_start_extent=Allocator.get_start a}})::createsegs ss (Int64.add lstart length)
+      | _ -> []
+  in
+  let change_lv lv_name fn =
+    let lv,others = List.partition (fun lv -> lv.Lv.name=lv_name) vg.lvs in
+    match lv with 
+      | [lv] ->
+	  fn lv others
+      | _ -> failwith "Unknown LV"
+  in
+  let vg = {vg with seqno = vg.seqno + 1; ops=op::vg.ops} in
+  match op.so_op with
+    | LvCreate (name,l) ->
+	let new_free_space = Allocator.alloc_specified_areas vg.free_space l.lvc_segments in
+	let segments = (createsegs l.lvc_segments 0L) in	
+	let lv = { Lv.name=name;
+		   id=l.lvc_id;
+		   tags=[];
+		   status=[Lv.Read; Lv.Visible];
+		   segments=segments } 
+	in
+	{ vg with     
+	  lvs = lv::vg.lvs;
+	  free_space=new_free_space }
+    | LvExpand (name,l) ->
+	change_lv name (fun lv others ->
+	  let old_size = Lv.size_in_extents lv in
+	  let free_space = Allocator.alloc_specified_areas vg.free_space l.lvex_segments in
+	  let segments = createsegs l.lvex_segments old_size in
+	  let lv = { lv with Lv.segments = segments @ lv.Lv.segments } in
+	  { vg with 
+	    lvs = lv::others; free_space=free_space})
+    | LvReduce (name,l) ->
+	change_lv name (fun lv others ->
+	  let allocation = Lv.allocation_of_lv lv in
+	  let lv = Lv.reduce_size_to lv l.lvrd_new_extent_count in
+	  let new_allocation = Lv.allocation_of_lv lv in
+	  let free_space = Allocator.alloc_specified_areas (Allocator.free vg.free_space allocation) new_allocation in
+	  {vg with
+	    lvs = lv::others; free_space=free_space})
+    | LvRemove name ->
+	change_lv name (fun lv others ->
+	  let allocation = Lv.allocation_of_lv lv in
+	  { vg with
+	    lvs = others;
+	    free_space = Allocator.free vg.free_space allocation })
+    | LvRename (name,l) ->
+	change_lv name (fun lv others ->
+	  { vg with
+	    lvs = {lv with Lv.name=l.lvmv_new_name}::others })
+
+let create_lv vg name size =
+  let id = Lvm_uuid.create () in
+  let new_segments,new_free_space = Allocator.alloc vg.free_space size in
+  do_op vg {so_seqno=vg.seqno; so_op=LvCreate (name,{lvc_id=id; lvc_segments=new_segments})}
+
+let rename_lv vg old_name new_name =
+  do_op vg {so_seqno=vg.seqno; so_op=LvRename (old_name,{lvmv_new_name=new_name})}
+
+let resize_lv vg name new_size =
+  let lv,others = List.partition (fun lv -> lv.Lv.name=name) vg.lvs in
+  let op = match lv with 
+    | [lv] ->
+	let current_size = Lv.size_in_extents lv in
+	if new_size > current_size then
+	  let new_segs,_ = Allocator.alloc vg.free_space (Int64.sub new_size current_size) in
+	  LvExpand (name,{lvex_segments=new_segs})
+	else
+	  LvReduce (name,{lvrd_new_extent_count=new_size})
+    | _ -> failwith "Can't find LV"
+  in
+  do_op vg {so_seqno=vg.seqno; so_op=op}
+
+let remove_lv vg name =
+  do_op vg {so_seqno=vg.seqno; so_op=LvRemove name}
+
+(******************************************************************************)
+
+
+
+
+
+let human_readable vg =
+  let pv_strings = List.map Pv.human_readable vg.pvs in
+    String.concat "\n" pv_strings
+
+let dm_map_of_lv vg lv use_pv_id =
+  let segments = List.sort (fun s1 s2 -> compare s1.Lv.s_start_extent s2.Lv.s_start_extent) 
+    (lv.Lv.segments) in
+
+  (* Sanity check - make sure the segments are logically contiguous *)
+
+  let extent_to_phys_sector pv extent = Int64.add pv.Pv.pe_start (Int64.mul extent vg.extent_size) in
+  let extent_to_sector extent = (Int64.mul extent vg.extent_size) in
+
+  let rec test expected_start segs =
+    match segs with
+      |	s::ss -> 
+	  if s.Lv.s_start_extent <> expected_start 
+	  then failwith "Segments aren't contiguous!";
+	  test (Int64.add expected_start s.Lv.s_extent_count) ss
+      | _ -> ()
+  in
+
+  test 0L segments;
+
+  let rec construct_dm_map segs =
+    match segs with
+      | s::ss ->
+	  let start = extent_to_sector s.Lv.s_start_extent in
+	  let len = extent_to_sector s.Lv.s_extent_count in
+	  { Camldm.start=start;
+	    len = len;
+	    map = 	  
+	      match s.Lv.s_cls with
+		| Lv.Linear l ->
+		    let pv = List.find (fun pv -> pv.Pv.name=l.Lv.l_pv_name) vg.pvs in
+		    Camldm.Linear {
+		      Camldm.device = 
+			if use_pv_id 
+			then Camldm.Dereferenced pv.Pv.label.Pv.Label.pv_header.Pv.Label.pvh_id 
+			else Camldm.Real pv.Pv.dev; 
+		      offset=extent_to_phys_sector pv l.Lv.l_pv_start_extent }
+		| Lv.Striped st ->
+		    failwith "Not implemented"
+	  }::construct_dm_map ss 
+      | _ -> []
+  in
+
+  Array.of_list (construct_dm_map segments)
+
+let find_lv vg lv_name =
+  List.find (fun lv -> lv.Lv.name = lv_name) vg.lvs
+    
+let dm_name_of vg lv =
+  let vgname = String.concat "--" (Stringext.String.split '-' vg.name) in
+  let lvname = String.concat "--" (Stringext.String.split '-' lv.Lv.name) in
+  Printf.sprintf "%s-%s" vgname lvname
+
+let dev_path_of vg lv =
+  if !Constants.dummy_mode then begin
+    let fname = Printf.sprintf "%s/%s/%s" (!Constants.dummy_base) (!Constants.mapper_name) (dm_name_of vg lv) in
+    let dirname = Filename.dirname fname in
+    Unixext.mkdir_rec dirname 0o755;
+    fname
+  end else
+    Printf.sprintf "/dev/mapper/%s" (dm_name_of vg lv)
+
+let dev_path_of_dm_name dm_name =
+  if !Constants.dummy_mode then 
+    Printf.sprintf "%s/%s/%s" (!Constants.dummy_base) (!Constants.mapper_name) dm_name
+  else
+    Printf.sprintf "/dev/mapper/%s" dm_name
+
+let lv_activate_internal name dm_map dereference_table use_tmp dev =
+  let realname = if use_tmp then (Uuid.to_string (Uuid.make_uuid ())) else name in
+  let nod = dev_path_of_dm_name realname in
+  debug (Printf.sprintf "Using dm_name=%s (use_tmp=%b)" realname use_tmp);
+  if not !Constants.dummy_mode then begin
+    Camldm.create realname dm_map dereference_table;
+    let s = Camldm.table realname in
+    let (major,minor) = s.Camldm.major,s.Camldm.minor in
+    Camldm.mknod nod 0o644 (Int32.to_int major) (Int32.to_int minor);
+  end else begin
+    let fname = (Printf.sprintf "%s/%s/%s" !Constants.dummy_base dev name) in
+    (* Make sure that a file corresponding to the LV is existant *)
+    begin 
+      try 
+	ignore(Unix.stat fname);
+      with _ ->
+	let fd = Unix.openfile fname [Unix.O_RDWR; Unix.O_CREAT] 0o644 in
+(*	let size = Int64.mul Constants.extent_size (Lv.size_in_extents lv) in
+	if !Constants.full_provision then 
+	  ignore(Unix.LargeFile.lseek fd (Int64.sub size 1L) Unix.SEEK_SET);*)
+	Unix.write fd "\000" 0 1;
+	Unix.close fd;
+    end;
+    (* Let's also make sure that the dir exists for the dev node! *)
+    Unixext.mkdir_rec (Filename.dirname nod) 0o755;
+    Unixext.unlink_safe nod;
+    Unix.symlink fname nod;
+  end;
+  (nod,realname)
+
+let lv_activate vg lv =
+  let name = dm_name_of vg lv in
+  let dm_map = dm_map_of_lv vg lv false in
+  let dev = (List.hd vg.pvs).Pv.dev in
+  fst (lv_activate_internal name dm_map [] false dev)
+
+let lv_deactivate_internal nod dm_name =
+  let nod = match nod with None -> dev_path_of_dm_name dm_name | Some x -> x in
+  if not !Constants.dummy_mode then Camldm.remove dm_name;
+  Unix.unlink nod
+    
+let lv_deactivate vg lv =
+  let dm_name = dm_name_of vg lv in
+  let nod = dev_path_of_dm_name dm_name in
+  lv_deactivate_internal None dm_name
+
+let lv_change_internal dm_name dm_map dereference_table =
+  Camldm.reload dm_name dm_map dereference_table;
+  Camldm.suspend dm_name;
+  Camldm.resume dm_name
+
+let with_active_lv vg lv use_tmp fn =
+  let name = dm_name_of vg lv in
+  let dm_map = dm_map_of_lv vg lv false in
+  let dev = (List.hd vg.pvs).Pv.dev in
+  let (nod,name) = lv_activate_internal name dm_map [] use_tmp dev in
+  Pervasiveext.finally 
+    (fun () -> fn nod)
+    (fun () -> lv_deactivate_internal (Some nod) name)
+       
+let get_absolute_pos_of_sector vg lv sector_num =
+  let map = dm_map_of_lv vg lv false in
+  let rec find i offset =
+    if offset > map.(i).Camldm.len
+    then find (i+1) (Int64.sub offset map.(i).Camldm.len)
+    else 
+      let (device,offset) = Camldm.get_sector_pos_of map.(i) offset [] in
+      (device,Int64.mul offset (Int64.of_int Constants.sector_size))
+  in 
+  find 0 sector_num
+      
+let with_open_redo vg f =
+  let Some lv_name = vg.redo_lv in
+  let lv = List.find (fun lv -> lv.Lv.name=lv_name) vg.lvs in
+  let dev = (List.hd vg.pvs).Pv.dev in
+  let (dev,pos) = 
+    if !Constants.dummy_mode then 
+      (Printf.sprintf "%s/%s/redo" !Constants.dummy_base dev,0L)
+    else 
+      get_absolute_pos_of_sector vg lv 0L in  
+  let fd = Unix.openfile dev [Unix.O_RDWR; Unix.O_CREAT] 0o644 in
+  Pervasiveext.finally (fun () -> f (fd,pos)) (fun () -> Unix.close fd)
+
+let read_redo vg =
+  with_open_redo vg (fun (fd,pos) ->
+    Redo.read fd pos (Constants.extent_size))
+
+let write_redo vg =
+  with_open_redo vg (fun (fd,pos) ->
+    Redo.write fd pos (Constants.extent_size) vg.ops;
+    {vg with ops=[]})
+    
+let reset_redo vg =
+  with_open_redo vg (fun (fd,pos) ->
+    Redo.reset fd pos)
+
+let apply_redo vg  =
+  let ops = List.rev (read_redo vg) in
+  let rec apply vg ops =
+    match ops with
+      | op::ops ->
+	  if op.so_seqno=vg.seqno 
+	  then begin
+	    debug (Printf.sprintf "Applying operation op=%s" (Redo.redo_to_human_readable op));
+	    apply (do_op vg op) ops
+	  end else begin
+	    debug (Printf.sprintf "Ignoring operation op=%s" (Redo.redo_to_human_readable op));
+	    apply vg ops
+	  end
+      | _ -> vg
+  in apply vg ops
+
+let write_full vg =
+  let pvs = vg.pvs in
+  let md = to_string vg in
+  let vg = 
+    {vg with pvs = List.map (fun pv -> 
+      Pv.Label.write_label_and_pv_header pv.Pv.label;
+      { pv with Pv.mda_headers = 
+	  List.map (fun mdah -> 
+	    Pv.MDAHeader.write_md pv.Pv.real_device mdah md) pv.Pv.mda_headers}) pvs}
+  in
+  (match vg.redo_lv with Some _ -> reset_redo vg | None -> ());
+  vg
+
+let init_redo_log vg =
+  match vg.redo_lv with 
+    | Some _ -> vg 
+    | None ->
+	let vg = write_full (create_lv vg Constants.redo_log_lv_name 1L) in
+	{vg with redo_lv=Some Constants.redo_log_lv_name}
+
+let write vg force_full =
+  if force_full 
+  then write_full vg
+  else 
+    match vg.redo_lv with None -> write_full vg | Some _ -> write_redo vg
+
+let of_metadata config pvdatas =
+  let config = 
+    match config with 
+      | AStruct c -> c 
+      | _ -> failwith "Bad metadata" in
+  let vg = filter_structs config in
+  if List.length vg <> 1 then 
+    failwith "Could not find singleton volume group";
+  let (name, _) = List.hd vg in
+  let alist = expect_mapped_struct name vg in
+  let id = expect_mapped_string "id" alist in
+  let seqno = expect_mapped_int "seqno" alist in
+  let status = map_expected_mapped_array "status" 
+    (fun a -> status_of_string (expect_string "status" a)) alist in
+  let extent_size = expect_mapped_int "extent_size" alist in
+  let max_lv = Int64.to_int (expect_mapped_int "max_lv" alist) in
+  let max_pv = Int64.to_int (expect_mapped_int "max_pv" alist) in
+  let pvs = expect_mapped_struct "physical_volumes" alist in
+  let pvs = List.map (fun (a,_) -> Pv.of_metadata a (expect_mapped_struct a pvs) pvdatas) pvs in
+  let lvs = try expect_mapped_struct "logical_volumes" alist with _ -> [] in
+  let lvs = List.map (fun (a,_) -> Lv.of_metadata a (expect_mapped_struct a lvs)) lvs in
+
+  (* Now we need to set up the free space structure in the PVs *)
+  let free_space = List.flatten (List.map (fun pv -> Allocator.create pv.Pv.name pv.Pv.pe_count) pvs) in
+
+  let free_space = List.fold_left (fun free_space lv -> 
+    let lv_allocations = Lv.allocation_of_lv lv in
+    debug (Printf.sprintf "Allocations for lv %s:\n%s\n" lv.Lv.name (Allocator.to_string lv_allocations));
+    Allocator.alloc_specified_areas free_space lv_allocations) free_space lvs in
+  
+  let got_redo_lv = List.exists (fun lv -> lv.Lv.name = Constants.redo_log_lv_name) lvs in
+
+  let vg = {
+    name=name;
+   id=id;
+   seqno=Int64.to_int seqno;
+   status=status;
+   extent_size=extent_size;
+   max_lv=max_lv;
+   max_pv=max_pv;
+   pvs=pvs;
+   lvs=lvs; 
+   free_space=free_space; 
+   redo_lv=if got_redo_lv then Some Constants.redo_log_lv_name else None;
+   ops=[]; 
+  } in
+  
+  if got_redo_lv then apply_redo vg else vg
+
+let create_new name devices_and_names =
+  let pvs = List.map (fun (dev,name) -> Pv.create_new dev name) devices_and_names in
+  let free_space = List.flatten (List.map (fun pv -> Allocator.create pv.Pv.name pv.Pv.pe_count) pvs) in
+  let vg = 
+    { name=name;
+      id=Lvm_uuid.create ();
+      seqno=1;
+      status=[Read; Write];
+      extent_size=Constants.extent_size_in_sectors;
+      max_lv=0;
+      max_pv=0;
+      pvs=pvs;
+      lvs=[];
+      free_space=free_space;
+      redo_lv=None;
+      ops=[];
+    }
+  in
+  write vg true
+
+let parse text pvdatas =
+  let lexbuf = Lexing.from_string text in
+  of_metadata (Lvmconfigparser.start Lvmconfiglex.lvmtok lexbuf) pvdatas
+
+let load devices =
+  debug "Vg.load";
+  let mds_and_pvdatas = List.map Pv.find_metadata devices in
+  let md = fst (List.hd mds_and_pvdatas) in
+  let pvdatas = List.map snd mds_and_pvdatas in
+  let oc = open_out "/tmp/metadata" in
+    Printf.fprintf oc "%s" md;
+    parse md pvdatas
+
+let set_dummy_mode base_dir mapper_name full_provision =
+  Constants.dummy_mode := true;
+  Constants.dummy_base := base_dir;
+  Constants.mapper_name := mapper_name;
+  Constants.full_provision := full_provision
+
+
+
+