commit 69e2f609afa3764406ddd0b2c10543bc77d9fd6c
Author: Jon Ludlam <jon@dhcp-3-31.uk.xensource.com>
Date:   Fri Jul 1 13:38:03 2011 +0100

    Upgrade MLVM to latest version

--- a/mlvm/Makefile
+++ b/mlvm/Makefile
@@ -1,6 +1,6 @@
 include ../config.mk
 
-LIBOBJS = constants lvm_uuid crc utils absty lvmconfigparser lvmconfiglex lvmmarshal allocator debug redo lv pv vg 
+LIBOBJS = constants lvm_uuid crc utils tag absty lvmconfigparser lvmconfiglex lvmmarshal allocator debug redo lv pv vg 
 INTF = $(foreach obj, $(LIBOBJS),$(obj).cmi)
 CMDOBJS = messages.cmx mlvm.cmx
 COMPFLAG = -package uuid -dtypes -g -I ../stdext -I ../camldm -for-pack Lvm $(RPCLIGHTFLAGS)
@@ -36,7 +36,7 @@
 	ocamlfind remove lvm
 
 clean : 
-	rm -f *.cmo *.cmi *.cmx *.o *~ *.annot $(SPOT) lvmconfiglex.ml \
+	rm -f *.cmo *.cmi *.cmx *.o *~ *.cma *.cmxa *.a *.annot $(SPOT) lvmconfiglex.ml \
 	lvmconfigparser.mli lvmconfigparser.ml
 	rm -f test_allocator
 
@@ -72,5 +72,18 @@
 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
-redo.cmo: debug.cmo allocator.cmo
-redo.cmx: debug.cmx allocator.cmx
+redo.cmo: tag.cmi debug.cmo allocator.cmo
+redo.cmx: tag.cmx debug.cmx allocator.cmx
+tag.cmo: debug.cmo tag.cmi
+tag.cmx: debug.cmx tag.cmi
+
+test_allocator: default
+	$(OCAMLOPT) -package kaputt -linkpkg -dtypes -g  -I ../stdext -I ../camldm -I ../uuid -I +kaputt $(INCLUDES) ./lvm.cmxa test_allocator.ml -o $@
+
+INCLUDES = unix.cmxa ../rpc-light/rpc.cmx ../rpc-light/jsonrpc.cmx ../camldm/camldm.cmxa ../uuid/uuid.cmxa ../stdext/stdext.cmxa
+
+test_fragment: lvm.cmxa $(LIBCMXS) test_fragment.ml
+	$(OCAMLOPT) $(COMPFLAG) $(INCLUDES) $^ -o $@
+
+tag_is_valid_test: $(LIBCMXS) tag.cmx tag_is_valid_test.ml
+	$(OCAMLOPT) $(COMPFLAG) $(INCLUDES) $^ -o $@
--- a/mlvm/lv.ml
+++ b/mlvm/lv.ml
@@ -1,4 +1,5 @@
 open Absty
+open Fun
 open Listext
 
 type stat = 
@@ -28,7 +29,7 @@
 and logical_volume = {
   name : string;
   id : string;
-  tags : string list;
+  tags : Tag.t list;
   status : stat list;
   segments : segment list;
 } with rpc
@@ -54,7 +55,7 @@
   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 "tags = [%s]\n" (String.concat ", " (List.map (quote ++ Tag.string_of) lv.tags));
   bprintf b "segment_count = %d\n\n" (List.length lv.segments);
   Listext.List.iteri
     (fun i s -> 
@@ -102,24 +103,25 @@
 		 st_stripes=stripes}
   }
 
+(** Builds a logical_volume structure out of a name and metadata. *)
 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=sort_segments segments }
+	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 tags =
+		List.map Tag.of_string
+			(if List.mem_assoc "tags" config
+			 then map_expected_mapped_array "tags" (expect_string "tags") config
+			 else []) in
+	let segments = filter_structs config in
+	let segments = List.map
+		(fun (a,_) ->
+			 segment_of_metadata a (expect_mapped_struct a segments)) segments in
+	{ name = name;
+	  id = id;
+	  status = status;
+	  tags = tags;
+	  segments = sort_segments segments }
 
 let allocation_of_segment s =
   match s.s_cls with
--- a/mlvm/redo.ml
+++ b/mlvm/redo.ml
@@ -1,3 +1,4 @@
+open Debug
 
 type lvcreate_t = {
   lvc_id : string;
@@ -15,21 +16,22 @@
 and lvexpand_t = {
   lvex_segments : Allocator.t;
 }
-    
+
+(** First string corresponds to the name of the LV. *)
 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
+	| LvCreate of string * lvcreate_t
+	| LvReduce of string * lvreduce_t
+	| LvExpand of string * lvexpand_t
+	| LvRename of string * lvrename_t
+	| LvRemove of string
+	| LvAddTag of string * Tag.t
+	| LvRemoveTag of string * Tag.t
 
 and sequenced_op = {
   so_seqno : int;
   so_op : operation
 } with rpc
 
-open Debug
-
 (** Marshal to and from a string *)
 let redo_to_string (l : sequenced_op) = 
   let s = Marshal.to_string l [] in
@@ -98,20 +100,20 @@
 
 let reset fd offset =
   write_initial_pos fd offset (Int64.add offset 12L)
-  
+
+(** Converts the redo operation to a human-readable string. *)
 let redo_to_human_readable op =
-  let lvcreate_t_to_string l =
-    Printf.sprintf "{id:'%s', segments:[%s]}" l.lvc_id (Allocator.to_string l.lvc_segments)
-  in
-  let lvexpand_t_to_string l =
-    Printf.sprintf "[%s]" (Allocator.to_string l.lvex_segments)
-  in
-  let opstr = 
-    match op.so_op with
-      | LvCreate (name,lvc) -> Printf.sprintf "LvCreate(%s,%s)" name (lvcreate_t_to_string lvc)
-      | LvRemove name -> Printf.sprintf "LvRemove(%s)" name 
-      | LvReduce (name,lvrd) -> Printf.sprintf "LvReduce(%s,%Ld)" name lvrd.lvrd_new_extent_count
-      | LvExpand (name,lvex) -> Printf.sprintf "LvExpand(%s,%s)" name (lvexpand_t_to_string lvex)
-      | LvRename (name,lvmv) -> Printf.sprintf "LvRename(%s,%s)" name lvmv.lvmv_new_name
-  in
-  Printf.sprintf "{seqno=%d; op=%s}" op.so_seqno opstr
+	let lvcreate_t_to_string l =
+		Printf.sprintf "{id:'%s', segments:[%s]}" l.lvc_id (Allocator.to_string l.lvc_segments) in
+	let lvexpand_t_to_string l =
+		Printf.sprintf "[%s]" (Allocator.to_string l.lvex_segments) in
+	let opstr =
+		match op.so_op with
+			| LvCreate (name,lvc) -> Printf.sprintf "LvCreate(%s,%s)" name (lvcreate_t_to_string lvc)
+			| LvRemove name -> Printf.sprintf "LvRemove(%s)" name
+			| LvReduce (name,lvrd) -> Printf.sprintf "LvReduce(%s,%Ld)" name lvrd.lvrd_new_extent_count
+			| LvExpand (name,lvex) -> Printf.sprintf "LvExpand(%s,%s)" name (lvexpand_t_to_string lvex)
+			| LvRename (name,lvmv) -> Printf.sprintf "LvRename(%s,%s)" name lvmv.lvmv_new_name
+			| LvAddTag (name,tag)	 -> Printf.sprintf "LvAddTag(%s,%s)" name (Tag.string_of tag)
+			| LvRemoveTag (name,tag) -> Printf.sprintf "LvRemoveTag(%s,%s)" name (Tag.string_of tag) in
+	Printf.sprintf "{seqno=%d; op=%s}" op.so_seqno opstr
--- /dev/null
+++ b/mlvm/tag.ml
@@ -0,0 +1,28 @@
+open Stringext
+
+type t = string with rpc
+
+module CharSet = Set.Make(struct type t = char let compare = compare end)
+
+let first_char_list = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_+."
+
+let first_char_set = String.fold_left (fun set x -> CharSet.add x set) CharSet.empty first_char_list
+
+let other_char_set = CharSet.add '-' first_char_set
+
+(** This function assumes "String.length s = len" and "len > 0". *)
+let has_valid_chars s len =
+	if not (CharSet.mem s.[0] first_char_set) then false else
+	let rec check_char_at i = (* Tail-recursion. *)
+		(i >= len) || (CharSet.mem s.[i] other_char_set && check_char_at (i + 1)) in
+	check_char_at 1
+
+let is_valid s =
+	let len = String.length s in
+	(0 < len) && (len <= 128) && (has_valid_chars s len)
+
+let of_string s =
+	if is_valid s then s else failwith "Tag string does not conform to the rules."
+
+let string_of t =
+  t
--- /dev/null
+++ b/mlvm/tag.mli
@@ -0,0 +1,13 @@
+type t
+
+val rpc_of_t : t -> Rpc.t
+val t_of_rpc : Rpc.t -> t
+(** Checks whether a string is a valid tag string.
+    Tag character set: A-Za-z0-9_+.-
+    Can't start with hyphen. Max length is 128.
+    Empty tags are currently not allowed. *)
+val is_valid : string -> bool
+(** Creates a tag from a string. Fails on non-conforming strings. *)
+val of_string : string -> t
+(** Converts a tag to a string. *)
+val string_of : t -> string
--- /dev/null
+++ b/mlvm/tag_is_valid_test.ml
@@ -0,0 +1,13 @@
+open Tag
+
+let test_tag_string (should_be_valid, s) =
+  let is_valid = is_valid s in
+  let is_valid_string = if is_valid then "  VALID" else "INVALID" in
+  let result = if is_valid = should_be_valid then "  CORRECT" else "INCORRECT" in
+	print_endline (result ^ " --- " ^ is_valid_string ^ " --- '" ^ s ^ "'")
+
+let test_strings =
+	[false, ""; true, "abc"; false, "----abc"; true, "abc-----"; false, "abc###";
+	 true, String.make 128 'y'; false, String.make 129 'n'; true, "_0m_3+3-3.X"]
+
+let _ = List.map test_tag_string test_strings
--- /dev/null
+++ b/mlvm/test.ml
@@ -0,0 +1,4 @@
+
+let _ =
+	let t = Lvm.Vg.load ["/dev/sda1"] in
+	()
--- /dev/null
+++ b/mlvm/test_fragment.ml
@@ -0,0 +1,222 @@
+(* Put them into a library? *)
+
+let pvs      = "/usr/sbin/pvs"
+let pvcreate = "/usr/sbin/pvcreate"
+let pvremove = "/usr/sbin/pvremove"
+
+let vgs      = "/usr/sbin/vgs"
+let vgcreate = "/usr/sbin/vgcreate"
+let vgextend = "/usr/sbin/vgextend"
+let vgchange = "/usr/sbin/vgchange"
+let vgremove = "/usr/sbin/vgremove"
+
+let lvs       = "/usr/sbin/lvs"
+let lvchange  = "/usr/sbin/lvchange"
+let lvremove  = "/usr/sbin/lvremove"
+let lvdisplay = "/usr/sbin/lvdisplay"
+let lvcreate  = "/usr/sbin/lvcreate"
+let lvremove  = "/usr/sbin/lvremove"
+let lvresize  = "/usr/sbin/lvresize"
+
+
+
+open Fun
+open Stringext
+open Listext
+open Camldm
+
+let with_debug s f =
+	(print_endline ("Start. (" ^ s ^ ")")
+	; f ()
+	; print_endline ("Done. (" ^ s ^")"))
+
+(* Wait for user (or not) *)
+let wait s =
+	Printf.fprintf stdout "Press Return: (%s)" s;
+	flush stdout;
+	Printf.fprintf stdout "\n";
+	(*   read_line(); *)
+	()
+
+let p (stdout,stderr, x) = print_string stdout; print_string stderr; (stdout,stderr, x)
+
+let fst3 (a,_,_) = a
+
+(* free space on SR (=VG) in byte *)
+let get_free_space vg =
+	Int64.of_string ++ String.strip String.isspace ++ fst3 ++ Os.syscall $ (vgs^" "^vg^" --noheadings -o free --unit b --nosuffix")
+		(* total space on SR (=VG) in byte *)
+let get_size vg =
+	Int64.of_string ++ String.strip String.isspace ++ fst3 ++ Os.syscall $ (vgs^" "^vg^" --noheadings -o size --unit b --nosuffix")
+
+let vg_name = "vg_name"
+let lv1_name = "lv1"
+
+(* just hardcoded everything for a start.*)
+(* Not used at the moment. *)
+let test rpc intrpc gp sr =
+	wait "pvcreate:";
+	p(Os.syscall $ pvcreate ^" /dev/sda3 /dev/sda4");
+	wait "vgcreate:";
+	p(Os.syscall (vgcreate ^" "^vg_name^" /dev/sda3 /dev/sda4"));
+	wait "size:";
+	let size = fst3 $ p(Os.syscall (vgs^" -o size --units 4m --noheadings "^vg_name)) in
+	wait "lvcreate:";
+	p(Os.syscall (lvcreate^" --size 50g -n "^lv1_name^" "^vg_name));
+	wait "lvchange:";
+	p(Os.syscall (lvchange^" -a n "^vg_name^"/"^lv1_name));
+
+	wait "lvremove:";
+	Os.syscall (lvremove^" "^vg_name^"/"^lv1_name);
+	wait "vgremove:";
+	p $ Os.syscall (vgremove^" "^vg_name);
+	wait "pvremove:";
+	p $ Os.syscall (pvremove^" /dev/sda3 /dev/sda4");
+in ()
+
+
+(* Will give a reason for what went wong in the Left-constructor, soon.
+   E.g. to distinguish between "Not enough space." and "Disk on fire."
+ *)
+
+let trace s = (print_endline ("Debug-Trace:\t"^s); s)
+	(* Rounding up size to full physical extent 16.00 MB
+	   Logical volume "lvol16" created
+	 *)
+let create_lv (* : string -> int64 -> (unit, string) Either.t *) =
+	fun vg size (* in MiBytes (Bytes don't work.) *) ->
+		let (out, err, status) =
+			p (Os.syscall (lvcreate^" --size "^Int64.to_string size^"m "^ vg)) in
+		if Os.was_successful (status)
+		then (* "  Logical volume \"lvol22\" created\n" *)
+			(let start = "  Logical volume \""
+			 and ending = "\" created\n"
+			 and l = String.length in
+			if (String.startswith start out
+			&& String.endswith ending out)
+			then Either.right ++ trace
+				$ String.sub out (l start) (l out - l ending - l start)
+			else (print_endline ("Failed to parse:\t"^out);
+			Either.Left ()))
+		else (print_endline "lvcreate failed"; Either.Left ())
+
+(* This is an unfoldM, or is it? *)
+let until pred action =
+	let rec helper acc =
+		let item = action () in
+		if pred item
+		then helper (item :: acc)
+		else acc in
+	List.rev ++ helper $ []
+let fill_up vg =
+	let free_space = get_free_space vg in
+	let lv_names = until Either.is_left (fun () -> create_lv vg (Random.int64 100L ));
+		(* asks for less than 100 MiB as a workaround because mlvm has
+		   only thin provisioning and no resizing, yet. *)
+	in lv_names (* named just for documentation. *)
+		   (* .vdi_info_location *)
+
+let _ = with_debug "filling up" $ (fun () -> fill_up "vgfnord")
+
+let has_devices output = on (((!=) 0) +++ String.compare) (String.strip String.isspace ++ String.lowercase) "No devices found\n" output
+
+let lines = String.split_f ((=) '\n')
+let words = String.split_f String.isspace
+
+let dmsetup_devices () =
+	let output = fst3 ++ p ++ Os.syscall $ "/sbin/dmsetup ls" in
+	if has_devices output
+	then Opt.cat_some ++ List.map (List.safe_hd ++ words) ++ lines $ output
+	else []
+
+let _ = dmsetup_devices ()
+
+let _ = with_debug "ls" (fun () -> Opt.map (List.iter print_endline) ++ Camldm.ls)
+
+let x () = p $ Os.syscall "/sbin/dmsetup table"
+
+let test_ls_output () =
+	let (Some l) = Camldm.ls () in
+	print_endline "And here's what Ocaml gets:";
+	if (l=[])
+	then print_endline "Empty list"
+	else List.iter print_endline l
+
+let _ = with_debug "test_ls_output" test_ls_output
+
+let test_ls_eq () =
+	let (Some l) = Opt.map (List.sort compare) ++ Camldm.ls $ ()
+	and ol = List.sort compare ++ dmsetup_devices $ () in
+	(* print_endline "mlvm:";
+	   List.iter print_endline l;
+	   print_endline "olvm";
+	   List.iter print_endline ol; *)
+	ol = l
+
+let _ = with_debug "test_ls_eq" test_ls_eq
+
+module StringMap = Mapext.Make (String)
+
+(* Supposed to fail when no char c at the end. *)
+let rm_char c s =
+	let (c::rest) = List.rev ++ String.explode $ s in
+	String.implode ++ List.rev $ rest
+
+let olvm_table () =
+	(* &start, &length, &target_type, &params); *)
+	(* "vg1-lvol0:" "0" "247414784" "linear" "8:4 384" *)
+	let parse1 (device::start::length::target_type::params) =
+		(rm_char ':' device,
+		(Int64.of_string start, Int64.of_string length,
+		target_type, params)::[]) in
+	let output = fst3 ++ p ++ Os.syscall $ "/sbin/dmsetup table" in
+	if has_devices output
+	then (print_string "Here's the output:\n";print_endline ++ String.escaped $ output;
+	StringMap.map (List.sort compare) ++ StringMap.fromListWith (@)
+	++ List.map (parse1 ++ words) ++ lines $ output)
+	else StringMap.empty
+
+let camldm_table_targets () =
+	let nf status = (* normal form *)
+		List.map (fun (start, length, target_type, params) -> (start, length, target_type, words params)) status.targets
+	in StringMap.map (List.sort compare) ++ StringMap.fromListWith (@) ++ List.make_assoc (nf ++ Camldm.table) ++ Opt.default [] ++ Camldm.ls $ ()
+
+let _ = with_debug "camldm_table_targets"
+	(fun () ->
+		let c = camldm_table_targets ()
+		and o = olvm_table ()
+		in print_string "compare tables:\t";print_endline ++ string_of_int $ (StringMap.compare compare c o))
+
+(* let _ = print_endline "Here comes create_new:\n"; safe_create "/dev/sda4" "name?" *)
+
+let _ = print_endline "Here come the devices:\n"
+let print_camldm_devices =
+	List.map (print_endline ++ Jsonrpc.to_string ++ Camldm.rpc_of_status ++ Camldm.table) ++ Opt.default [] $ Camldm.ls () (* devices () *)
+
+let get_free_space vg = 10L
+let get_size vg = 10
+
+let fragment vg = ()
+
+
+
+(* StringMap.fromListWith (@) ++ List.map (parse1 ++ words) ++ lines $ output *)
+
+let test_table_eq () =
+	let (Some devs) = Camldm.ls ()
+	in (List.make_assoc Camldm.table $ devs;
+	olvm_table ())
+
+let _ = print_endline ++ string_of_bool ++ test_ls_eq $ ()
+
+let leakage () =
+	let rec helper () =
+		ignore(Camldm.ls ());
+		helper ()
+	in helper ()
+
+
+(* compare (Camldm.table device) to Os.syscall "dmsetup table"
+   Problem is: Whiche device?
+   "dmsetup ls" doesn't give anything interesting (on "test -t olvm-mlvm").  But it does for "test -t coalesce" (test.ml in ocaml/sm)
+ *)
--- a/mlvm/vg.ml
+++ b/mlvm/vg.ml
@@ -74,65 +74,67 @@
 (*************************************************************)
 
 let do_op vg op =
-  (if vg.seqno <> op.so_seqno then failwith "Failing to do VG operation out-of-order");
-  Unixext.write_string_to_file (Printf.sprintf "/tmp/redo_op.%d" op.so_seqno) (Redo.redo_to_human_readable op);
-  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 = Lv.sort_segments (createsegs l.lvc_segments 0L) in	
-	let lv = { Lv.name=name;
-		   id=l.lvc_id;
-		   tags=[];
-		   status=[Lv.Read; Lv.Visible];
-		   segments=segments } 
+	(if vg.seqno <> op.so_seqno then failwith "Failing to do VG operation out-of-order");
+	Unixext.write_string_to_file (Printf.sprintf "/tmp/redo_op.%d" op.so_seqno) (Redo.redo_to_human_readable op);
+	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
-	{ 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 = Lv.sort_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 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 = Lv.sort_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 = Lv.sort_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 })
+		| LvAddTag (name, tag) ->
+			change_lv name (fun lv others ->
+				let tags = lv.Lv.tags in
+				let lv' = {lv with Lv.tags = if List.mem tag tags then tags else tag::tags} in
+				{vg with lvs = lv'::others})
+		| LvRemoveTag (name, tag) ->
+			change_lv name (fun lv others ->
+				let tags = lv.Lv.tags in
+				let lv' = {lv with Lv.tags = List.filter (fun t -> t <> tag) tags} in
+				{vg with lvs = lv'::others})
+
 
 let create_lv vg name size =
   let id = Lvm_uuid.create () in
@@ -159,11 +161,13 @@
 let remove_lv vg name =
   do_op vg {so_seqno=vg.seqno; so_op=LvRemove name}
 
-(******************************************************************************)
-
-
+let add_tag_lv vg name tag =
+	do_op vg {so_seqno = vg.seqno; so_op = LvAddTag (name, tag)}
 
+let remove_tag_lv vg name tag =
+	do_op vg {so_seqno = vg.seqno; so_op = LvRemoveTag (name, tag)}
 
+(******************************************************************************)
 
 let human_readable vg =
   let pv_strings = List.map Pv.human_readable vg.pvs in
