From 9a5526e654a911112d2d83c27f9a305851b5a7c7 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Mon, 21 Dec 2009 18:10:59 +0000 Subject: [PATCH] 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 --- Makefile.in | 5 + mlvm/Makefile | 16 +-- mlvm/allocator.ml | 235 +++++++++++++++++---------------------------- mlvm/constants.ml | 1 - mlvm/lv.ml | 28 +++--- mlvm/lvmmarshal.ml | 54 +++++------ mlvm/pv.ml | 110 ++++++++++----------- mlvm/redo.ml | 30 +++--- mlvm/vg.ml | 90 ++++++++--------- 9 files changed, 242 insertions(+), 327 deletions(-) diff --git a/Makefile.in b/Makefile.in index 0cea666..a56c995 100644 --- a/Makefile.in +++ b/Makefile.in @@ -30,6 +30,7 @@ ifeq ($(HAVE_DEVICE_MAPPER),1) $(MAKE) -C camldm endif $(MAKE) -C forking_executioner + $(MAKE) -C mlvm .PHONY: allxen allxen: @@ -65,6 +66,7 @@ ifeq ($(HAVE_DEVICE_MAPPER),1) $(MAKE) -C camldm install endif $(MAKE) -C forking_executioner install + $(MAKE) -C mlvm install installxen: ifeq ($(HAVE_XEN),1) @@ -99,6 +101,7 @@ ifeq ($(HAVE_DEVICE_MAPPER),1) $(MAKE) -C camldm uninstall endif $(MAKE) -C forking_executioner uninstall + $(MAKE) -C mlvm uninstall uninstallxen: ifeq ($(HAVE_XEN),1) @@ -156,6 +159,7 @@ doc: $(MAKE) -C xsrpc doc $(MAKE) -C mmap doc $(MAKE) -C forking_executioner doc + $(MAKE) -C mlvm doc .PHONY: clean clean: @@ -174,6 +178,7 @@ clean: make -C sexpr clean make -C doc clean make -C forking_executioner clean + make -C mlvm clean cleanxen: $(MAKE) -C mmap clean diff --git a/mlvm/Makefile b/mlvm/Makefile index 0fea29b..b0f20fa 100644 --- a/mlvm/Makefile +++ b/mlvm/Makefile @@ -4,10 +4,9 @@ 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) @@ -18,17 +17,11 @@ 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 -pp '${PP}' -I ../rpc-light - +COMPFLAG = -dtypes -g -I ../stdext -I ../camldm -I ../uuid -for-pack Lvm LIBS = lvm.cma lvm.cmxa -DOCDIR = /myrepos/xen-api-libs.hg/doc - default : $(LIBS) -test_allocator: default - $(OCAMLOPT) -package kaputt -linkpkg -dtypes -g -I ../stdext -I ../camldm -I ../uuid -I +kaputt unix.cmxa ../rpc-light/rpc.cmx ../rpc-light/jsonrpc.cmx ../camldm/camldm.cmxa ../uuid/uuid.cmxa ../stdext/stdext.cmxa ./lvm.cmxa test_allocator.ml -o $@ - lvm.cmx: $(foreach obj,$(LIBOBJS),$(obj).cmx) $(OCAMLOPT) -pack -g -o $@ $(foreach obj,$(LIBOBJS),$(obj).cmx) @@ -55,11 +48,6 @@ uninstall: clean : rm -f *.cmo *.cmi *.cmx *.o *~ *.annot lvmconfiglex.ml \ lvmconfigparser.mli lvmconfigparser.ml - rm -f test_allocator - -.PHONY: doc -doc: $(INTF) - python ../doc/doc.py $(DOCDIR) "mlvm" "package" "$(LIBOBJS)" "." "stdext,camldm,uuid,unix" "" "'${PP}'" lvmconfigparser.ml : lvmconfigparser.mly ocamlyacc lvmconfigparser.mly diff --git a/mlvm/allocator.ml b/mlvm/allocator.ml index 1c3ed28..3192dcc 100644 --- a/mlvm/allocator.ml +++ b/mlvm/allocator.ml @@ -1,153 +1,98 @@ -open Pervasiveext -open Listext +type t = (string * (int64 * int64)) list -(* Sparse allocation should be fast. Expanding memory should be fast, for a bunch of volumes. *) +let create name size = [(name,(0L,size))] -type area = (string * (int64 * int64)) with rpc -type t = area list with rpc +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_string1 (p,(s,l)) = Printf.sprintf "(%s: [%Ld,%Ld])" p s l let to_string t = String.concat ", " - (List.map to_string1 t) - -let create name size = [(name,(0L,size))] -let empty = [] - -let get_name (name,(_,_)) = name -let get_start (_,(start,_)) = start -let get_size (_,(_,size)) = size -let unpack_area (pv_name, (start,size)) = (pv_name, (start,size)) - -let get_end a = Int64.add (get_start a) (get_size a) - -let make_area pv_name start size = (pv_name, (start,size)) -let make_area_by_end name start endAr = make_area name start (Int64.sub endAr start) - -(* Define operations on areas, and then use those to build the - allocation algorithms. That should make it easier to test, and the - algorithms are easier to read without arithmetic in them. -*) - -let intersect : area -> area -> area list = - fun a a2 -> - let (name, (start, size)) = unpack_area a in - let (name2, (start2, size2)) = unpack_area a2 in - let enda = get_end a in - let enda2 = get_end a2 in - let startI = max start start2 in - let endI = min enda enda2 in - let sizeI = max Int64.zero (Int64.sub endI startI) in - if name = name2 - then make_area name (max start start2) (max Int64.zero sizeI) :: [] - else [] - -let combine : t -> t -> t = (* does not guarantee normalization *) - fun t1 t2 -> - t1 @ t2 - -let union : area -> area -> t = (* does not guarantee normalization *) - fun a a2 -> - a::a2::[] -let minus : area -> area -> t = (* does not guarantee normalization *) - fun a a2 -> - let (name, (start, size)) = unpack_area a in - let (name2, (start2, size2)) = unpack_area a2 in - let enda = get_end a in - let enda2 = get_end a2 in - if name = name2 - then List.filter ((<) Int64.zero ++ get_size) ++ List.fold_left combine [] ++ List.map (intersect a ++ Fun.uncurry (make_area_by_end name2)) $ ((start, start2) :: (enda2, enda)::[]) - else a :: [] - -(* Is a contained in a2? *) -let contained : area -> area -> bool = - fun a a2 -> - let (name, (start, size)) = unpack_area a in - let (name2, (start2, size2)) = unpack_area a2 in - name=name2 && start >= start2 && Int64.add start size <= Int64.add start2 size2 - -exception PVS_DONT_MATCH - -(* assumes all areas stem from the same pv *) -let normalize_single_pv areas = - (* Underlying structure for merge1: foldM merge1 (for a1) on WriterMonad (for acc) over segs *) - (* The type of the accumulator here is a bit ugly. Perhaps a real non-empty list would be better? *) - let merge1 (a1, acc) a2 = - let (name, (start1, size1)) = unpack_area a1 - and (name2, (start2, size2)) = unpack_area a2 in - if (name != name2) then raise PVS_DONT_MATCH - else if (Int64.add start1 size1) = start2 then - (make_area name start1 (Int64.add size1 size2), acc) - else - (a2, List.cons a1 acc) in - (function - | start::segs -> - (Fun.uncurry List.cons) $ List.fold_left merge1 (start, []) segs - | [] -> [] (* shouldn't be necessary! *)) - ++ List.sort (Fun.on compare get_start) ++ List.filter ((<) 0L ++ get_size) $ areas -let normalize : t -> t = - fun areas -> - (* The next lines are to be read backwards, since we defined function composition that way. *) - - let module StringMap = Mapext.Make (String) in - (* put free areas of all PVs back together *) - List.flatten ++ StringMap.values - (* normalize each pv's areas *) - ++ StringMap.map normalize_single_pv - (* separate by pv *) - ++ StringMap.fromListWith List.append ++ List.map (fun seg -> (get_name seg, [seg])) - $ areas - -(* Which invariants does t have to satisfy? Which invariants does our - result here satisfy? - - E.g. is it possible for areas to overlap or contain each other? If not, should we warn if they do? - - t is a free list. - - What if there's no containing area? Is this only called under certain circumstances? Verify. *) -exception NonSingular_Containing_Area -let alloc_specified_area (free_list : t) (a : area) = - (* We assume areas don't overlap, or do we? *) - (* Match against [] instead of _: Better die as soon as possible, when something is wrong. - * And that was right! Just caught a bug that would have been masked otherwise. *) - match List.partition (contained a) ++ normalize $ free_list with - | (containing_area::[]), other_areas -> normalize $ combine (minus containing_area a) other_areas - | x,_ -> (print_string "alloc_specified_area:\t"; - print_endline ++ to_string $ x; - raise NonSingular_Containing_Area;) - -let alloc_specified_areas : t -> t -> t = - List.fold_left alloc_specified_area - -let safe_alloc (free_list : t) (newsize : int64) = - (* switched from best-fit (smallest free area that's large enough) - to worst-fit (largest area): This may reduce fragmentation, and - makes the code slightly easier. *) - let rec alloc_h newsize = function - | (seg::rest) -> - let remainder = Int64.sub newsize (get_size seg) in - if (remainder > Int64.zero) 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 areas *) - match alloc_h remainder rest with - | Some (allocd,newt) -> Some (seg::allocd, newt) - | None -> None - else - let (name, (start, _)) = unpack_area seg in - let area = make_area name start newsize in - Some ([area], try (alloc_specified_area (seg::rest) area) with (Match_failure x) -> (print_endline "alloc_specified_area"; raise (Match_failure x))) - | [] -> None in - alloc_h newsize - ++ List.rev ++ List.sort (Fun.on compare get_size) $ free_list - -let alloc (free_list : t) (newsize : int64) = - match safe_alloc free_list newsize - with Some x -> x - | None -> failwith "Failed to find individual area!" - -(* Probably de-allocation won't be used much. *) -let free to_free free_list = normalize (combine to_free free_list) + (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 diff --git a/mlvm/constants.ml b/mlvm/constants.ml index 50007b9..fbcea8c 100644 --- a/mlvm/constants.ml +++ b/mlvm/constants.ml @@ -23,7 +23,6 @@ let redo_log_lv_name = "mlvm_redo_log" let mib = Int64.mul 1024L 1024L let tib = Int64.mul mib mib -(* Ahem, mutable constants? *) let dummy_mode = ref false let dummy_base = ref "/tmp" let mapper_name = ref "mapper" diff --git a/mlvm/lv.ml b/mlvm/lv.ml index bbbc1e5..d1afe8b 100644 --- a/mlvm/lv.ml +++ b/mlvm/lv.ml @@ -6,32 +6,32 @@ type stat = | Write | Visible -and striped_segment = { +type striped_segment = { st_stripe_size : int64; (* In sectors *) st_stripes : (string * int64) list; (* pv name * start extent *) } -and linear_segment = { +type linear_segment = { l_pv_name : string; l_pv_start_extent : int64; } -and segclass = +type segclass = | Linear of linear_segment | Striped of striped_segment -and segment = +type segment = { s_start_extent : int64; s_extent_count : int64; s_cls : segclass; } -and logical_volume = { +type 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 @@ -45,10 +45,7 @@ let status_of_string s = | "WRITE" -> Write | "VISIBLE" -> Visible | _ -> failwith "Bad LV status string" - -let sort_segments s = - List.sort (fun s1 s2 -> compare s1.s_start_extent s2.s_start_extent) s - + let write_to_buffer b lv = let bprintf = Printf.bprintf in bprintf b "\n%s {\nid = \"%s\"\nstatus = [%s]\n" lv.name lv.id @@ -56,7 +53,7 @@ let write_to_buffer b lv = 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 + 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; @@ -119,7 +116,7 @@ let of_metadata name config = id=id; status=status; tags=tags; - segments=sort_segments segments } + segments=segments } let allocation_of_segment s = match s.s_cls with @@ -153,20 +150,17 @@ let size_in_extents lv = let reduce_size_to lv new_seg_count = let cur_size = size_in_extents lv in - Debug.debug "Beginning reduce_size_to:"; 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 -> - Debug.debug (Printf.sprintf "Lv.reduce_size_to: s.s_start_extent=%Ld s.s_extent_count=%Ld left=%Ld" - s.s_start_extent s.s_extent_count left); 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 = sort_segments (doit lv.segments new_seg_count [])} + {lv with segments = (doit lv.segments new_seg_count [])} let increase_allocation lv new_segs = - {lv with segments = sort_segments (lv.segments @ new_segs)} + {lv with segments=lv.segments @ new_segs} diff --git a/mlvm/lvmmarshal.ml b/mlvm/lvmmarshal.ml index 4654649..553afc6 100644 --- 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 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 c6c14c7..3b57175 100644 --- 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*) } - and disk_locn = { + type disk_locn = { dl_offset : int64; dl_size : int64; } - and pv_header = { + type pv_header = { pvh_id : string; (* 32 bytes, 'uuid' *) pvh_device_size : int64; pvh_extents: disk_locn list; pvh_metadata_areas: disk_locn list; } - and t = { + type 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,14 +97,6 @@ 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 @@ -125,9 +117,7 @@ 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 @@ -165,6 +155,14 @@ 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 @@ -207,8 +205,6 @@ module Label = struct end module MDAHeader = struct - let mda_header_size = Constants.sector_size - type mda_raw_locn = { mrl_offset: int64; mrl_size: int64; @@ -216,14 +212,16 @@ module MDAHeader = struct mrl_filler: int32; } - and mda_header = { + 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; - } with rpc + } let unmarshal_mda_header device location = let offset,fd = @@ -300,40 +298,38 @@ module MDAHeader = struct 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 = - (* Include terminating \0 in this string. - * The checksum calculation in original lvm does so, too.*) - if(Int64.add locn.mrl_offset locn.mrl_size > mdah.mdah_size) - then (* wrap around *) - 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 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) 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 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 *) @@ -425,7 +421,7 @@ end type status = | Allocatable -and physical_volume = { +type physical_volume = { name : string; id : string; dev : string; @@ -436,7 +432,7 @@ and 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 @@ -497,8 +493,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 - Debug.debug (Printf.sprintf "Label found: \n%s\n" - (Label.to_ascii label)); + (* 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 diff --git a/mlvm/redo.ml b/mlvm/redo.ml index ed624a7..5a8e087 100644 --- a/mlvm/redo.ml +++ b/mlvm/redo.ml @@ -4,29 +4,29 @@ type lvcreate_t = { lvc_segments : Allocator.t } -and lvrename_t = { +type lvrename_t = { lvmv_new_name : string; } -and lvreduce_t = { +type lvreduce_t = { lvrd_new_extent_count : int64; } -and lvexpand_t = { +type lvexpand_t = { lvex_segments : Allocator.t; } -and operation = +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 -and sequenced_op = { +type sequenced_op = { so_seqno : int; so_op : operation -} with rpc +} open Debug @@ -68,7 +68,7 @@ let write fd offset size ops = raise (OutOfSize op.so_seqno) else begin ignore(Unix.LargeFile.lseek fd ofs Unix.SEEK_SET); - ignore(Unix.write fd str 0 len); + 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 @@ -100,18 +100,12 @@ let reset fd offset = write_initial_pos fd offset (Int64.add offset 12L) 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 + | 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 --git a/mlvm/vg.ml b/mlvm/vg.ml index 6c50e2a..00b6792 100644 --- a/mlvm/vg.ml +++ b/mlvm/vg.ml @@ -8,7 +8,7 @@ type status = | Resizeable | Clustered -and vg = { +type vg = { name : string; id : string; seqno : int; @@ -21,7 +21,7 @@ and 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 @@ -75,7 +75,6 @@ let to_string vg = 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 -> @@ -97,7 +96,7 @@ let do_op vg op = 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 segments = (createsegs l.lvc_segments 0L) in let lv = { Lv.name=name; id=l.lvc_id; tags=[]; @@ -112,7 +111,7 @@ let do_op vg op = 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 + let lv = { lv with Lv.segments = segments @ lv.Lv.segments } in { vg with lvs = lv::others; free_space=free_space}) | LvReduce (name,l) -> @@ -255,9 +254,9 @@ let lv_activate_internal name dm_map dereference_table use_tmp dev = 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);*) - ignore(Unix.write fd "\000" 0 1); + 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! *) @@ -279,9 +278,9 @@ let lv_deactivate_internal nod dm_name = Unix.unlink nod let lv_deactivate vg lv = - let dm_name = dm_name_of vg lv in - (ignore (dev_path_of_dm_name dm_name); - lv_deactivate_internal None dm_name) + 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; @@ -309,21 +308,20 @@ let get_absolute_pos_of_sector vg lv sector_num = find 0 sector_num let with_open_redo vg f = - match vg.redo_lv with - | Some lv_name -> - 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) - | None -> failwith "vg.ml/with_open_redo: vg.redo_lv == None, but should not be." + 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)) + 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) -> @@ -360,7 +358,6 @@ let write_full vg = List.map (fun mdah -> Pv.MDAHeader.write_md pv.Pv.real_device mdah md) pv.Pv.mda_headers}) pvs} in - Unixext.write_string_to_file (Printf.sprintf "/tmp/metadata.%d" vg.seqno) md; (match vg.redo_lv with Some _ -> reset_redo vg | None -> ()); vg @@ -427,26 +424,24 @@ let of_metadata config pvdatas = 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 - 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; - 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 - ignore (write vg true); - debug "VG created" + 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 @@ -458,9 +453,8 @@ let load devices = 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; - close_out oc; - parse md pvdatas + Printf.fprintf oc "%s" md; + parse md pvdatas let set_dummy_mode base_dir mapper_name full_provision = Constants.dummy_mode := true; -- 2.39.5