From: Jon Ludlam Date: Mon, 21 Dec 2009 18:10:59 +0000 (+0000) Subject: Use rpc-light to marshal/unmarshal camldm device-mapper tables rather than the Marsha... X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=652f67c39baaa264831b10ef42391ccca6918390;p=xcp%2Fxen-api-libs.git Use rpc-light to marshal/unmarshal camldm device-mapper tables rather than the Marshal module Signed-off-by: Jon Ludlam --- diff --git a/camldm/META.in b/camldm/META.in index 65c8d30..44a4060 100644 --- a/camldm/META.in +++ b/camldm/META.in @@ -1,5 +1,5 @@ version = "@VERSION@" description = "device-mapper ocaml interface" -requires = "unix" +requires = "unix,jsonrpc" archive(byte) = "camldm.cma" archive(native) = "camldm.cmxa" diff --git a/camldm/Makefile b/camldm/Makefile index ce2c79f..2d62172 100644 --- a/camldm/Makefile +++ b/camldm/Makefile @@ -3,6 +3,8 @@ CFLAGS = -Wall -fPIC -O2 -I/opt/xensource/lib/ocaml OCAMLC = ocamlc -g OCAMLOPT = ocamlopt +FEPP = camlp4o -I ../rpc-light -I $(shell ocamlfind query type-conv) pa_type_conv.cmo pa_rpc.cma + LDFLAGS = -cclib -L./ VERSION := $(shell hg parents --template "{rev}" 2>/dev/null || echo 0.0) @@ -18,6 +20,9 @@ LIBS = camldm.cma camldm.cmxa DOCDIR = /myrepos/xen-api-libs.hg/doc +OCAMLFLAGS = -pp '${FEPP}' -I ../rpc-light + + all: $(INTF) $(LIBS) $(PROGRAMS) bins: $(PROGRAMS) @@ -25,10 +30,10 @@ bins: $(PROGRAMS) libs: $(LIBS) camldm.cmxa: libcamldm_stubs.a $(foreach obj,$(OBJS),$(obj).cmx) - $(OCAMLOPT) $(OCAMLOPTFLAGS) -a -o $@ -cclib -lcamldm_stubs -cclib -ldevmapper $(foreach obj,$(OBJS),$(obj).cmx) + $(OCAMLOPT) $(OCAMLFLAGS) -a -o $@ -cclib -lcamldm_stubs -cclib -ldevmapper $(foreach obj,$(OBJS),$(obj).cmx) camldm.cma: $(foreach obj,$(OBJS),$(obj).cmo) - $(OCAMLC) -a -dllib dllcamldm_stubs.so -cclib -lcamldm_stubs -cclib -ldevmapper -o $@ $(foreach obj,$(OBJS),$(obj).cmo) + $(OCAMLC) $(OCAMLFLAGS) -a -dllib dllcamldm_stubs.so -cclib -lcamldm_stubs -cclib -ldevmapper -o $@ $(foreach obj,$(OBJS),$(obj).cmo) camldm_stubs.a: camldm_stubs.o ocamlmklib -o camldm_stubs -ldevmapper $+ @@ -38,13 +43,13 @@ libcamldm_stubs.a: camldm_stubs.o ocamlmklib -o camldm_stubs -ldevmapper $+ %.cmo: %.ml - $(OCAMLC) -c -o $@ $< + $(OCAMLC) $(OCAMLFLAGS) -c -o $@ $< %.cmi: %.mli - $(OCAMLC) -c -o $@ $< + $(OCAMLC) $(OCAMLFLAGS) -c -o $@ $< %.cmx: %.ml - $(OCAMLOPT) $(OCAMLOPTFLAGS) -c -o $@ $< + $(OCAMLOPT) $(OCAMLFLAGS) -c -o $@ $< %.o: %.c $(CC) $(CFLAGS) -c -o $@ $< @@ -65,6 +70,6 @@ uninstall: .PHONY: doc doc: $(INTF) python ../doc/doc.py $(DOCDIR) "camldm" "package" "$(OBJS)" "." "" "" - + clean: rm -f *.o *.so *.a *.cmo *.cmi *.cma *.cmx *.cmxa *.annot $(LIBS) $(PROGRAMS) diff --git a/camldm/camldm.ml b/camldm/camldm.ml index 9ebe449..dffcc9e 100644 --- a/camldm/camldm.ml +++ b/camldm/camldm.ml @@ -16,27 +16,27 @@ type devty = | Dereferenced of string (* e.g. PV id *) | Real of string (* device *) -type dev = { +and dev = { device : devty; offset : int64; } -type stripety = { +and stripety = { chunk_size : int64; (* In sectors - must be a power of 2 and at least as large as the system's PAGE_SIZE *) dests : dev array; } -type mapty = +and mapty = | Linear of dev (* Device, offset *) | Striped of stripety -type mapping = { +and mapping = { start : int64; len : int64; map : mapty; } -type status = { +and status = { exists : bool; suspended : bool; live_table : bool; @@ -47,7 +47,18 @@ type status = { minor : int32; read_only : bool; targets : (int64 * int64 * string * string) list +} + +and mapping_array = { + m : mapping array +} + +and create_error_t = { + c : (int64 * int64 * string * string) array } +with rpc + + external _create : string -> (int64 * int64 * string * string) array -> unit = "camldm_create" external _reload : string -> (int64 * int64 * string * string) array -> unit = "camldm_reload" @@ -77,8 +88,11 @@ let convert_mapty m deref_table = (Array.map (fun dev -> Printf.sprintf "%s %Ld" (resolve_device dev.device deref_table) dev.offset) st.dests)) -exception CreateError of (int64 * int64 * string * string) array -exception ReloadError of (int64 * int64 * string * string) array +exception CreateError of string +exception ReloadError of string + +let to_string m = Jsonrpc.to_string (rpc_of_mapping_array {m=m}) +let of_string s = (mapping_array_of_rpc (Jsonrpc.of_string s)).m let _writemap dev map = let oc = open_out (Printf.sprintf "/tmp/%s.map" dev) in @@ -90,23 +104,23 @@ let _getmap map dereference_table = let (ty,params) = convert_mapty m.map dereference_table in (m.start, m.len, ty, params)) map -let create dev map ?(dereference_table=[]) = +let create dev map dereference_table = let newmap = _getmap map dereference_table in try _writemap dev newmap; _create dev newmap - with e -> - raise (CreateError newmap) + with Failure x -> + raise (CreateError x) -let reload dev map ?(dereference_table=[]) = +let reload dev map dereference_table = let newmap = _getmap map dereference_table in try _writemap dev newmap; _reload dev newmap - with e -> - raise (ReloadError newmap) + with Failure x -> + raise (ReloadError x) -let get_sector_pos_of map sector ~dereference_table = +let get_sector_pos_of map sector dereference_table = match map.map with | Linear l -> (resolve_device l.device dereference_table, Int64.add l.offset sector) | Striped s -> @@ -127,5 +141,3 @@ let mknods = _mknods let mknod = _mknod let suspend = _suspend let resume = _resume -let to_string (m : mapping array) = Marshal.to_string m [] -let of_string s = (Marshal.from_string s 0 : mapping array) diff --git a/camldm/camldm.mli b/camldm/camldm.mli index f088960..fc57112 100644 --- a/camldm/camldm.mli +++ b/camldm/camldm.mli @@ -30,18 +30,18 @@ type status = { targets : (int64 * int64 * string * string) list; } -exception CreateError of (int64 * int64 * string * string) array -exception ReloadError of (int64 * int64 * string * string) array +exception CreateError of string +exception ReloadError of string val convert_mapty : mapty -> (string * string) list -> string * string -val create : string -> mapping array -> ?dereference_table : (string * string) list -> unit -val reload : string -> mapping array -> ?dereference_table : (string * string) list -> unit +val create : string -> mapping array -> (string * string) list -> unit +val reload : string -> mapping array -> (string * string) list -> unit val suspend : string -> unit val resume : string -> unit val remove : string -> unit val table : string -> status val mknods : string -> unit val mknod : string -> int -> int -> int -> unit -val get_sector_pos_of : mapping -> int64 -> dereference_table:(string * string) list -> string * int64 +val get_sector_pos_of : mapping -> int64 -> (string * string) list -> string * int64 val to_string : mapping array -> string val of_string : string -> mapping array diff --git a/camldm/camldm_stubs.c b/camldm/camldm_stubs.c index e49120a..015ea2f 100644 --- a/camldm/camldm_stubs.c +++ b/camldm/camldm_stubs.c @@ -39,8 +39,10 @@ void camldm_create(value name, value map) if(!(dmt = dm_task_create(DM_DEVICE_CREATE))) caml_failwith("Failed to create task!"); - if(!dm_task_set_name(dmt, String_val(name))) - goto out; + if(!dm_task_set_name(dmt, String_val(name))) { + dm_task_destroy(dmt); + caml_failwith("Failed to set name"); + } for(i=0; i