# HG changeset patch # User Jon Ludlam # Date 1279809465 -3600 # Node ID 5f9ab87260fcdad5df85ce576d019690adbd67b5 # Parent d052a41ffabe74f791a1d62bd178a1cac13dc332 Bindings to libvhd. This allows ocaml programs to manipulate VHD files suitable for use with XCP/XenServer. Sample usage: Vhd.create filename virtual_size (Vhd.Ty_dynamic) (Vhdutil.max_size) []; let uid = Vhd.with_vhd filename false Vhd.get_uid Signed-off-by: Jon Ludlam Acked-by: Dave Scott diff -r d052a41ffabe -r 5f9ab87260fc Makefile.in --- a/Makefile.in Wed Jul 21 23:29:38 2010 +0100 +++ b/Makefile.in Thu Jul 22 15:37:45 2010 +0100 @@ -44,6 +44,7 @@ $(MAKE) -C xsrpc $(MAKE) -C eventchn $(MAKE) -C cpuid + $(MAKE) -C vhd endif install: @@ -82,6 +83,7 @@ $(MAKE) -C xsrpc install $(MAKE) -C eventchn install $(MAKE) -C cpuid install + $(MAKE) -C vhd install endif uninstall: @@ -120,6 +122,7 @@ $(MAKE) -C xc uninstall $(MAKE) -C mmap uninstall $(MAKE) -C cpuid uninstall + $(MAKE) -C vhd uninstall endif bins: @@ -169,6 +172,7 @@ $(MAKE) -C forking_executioner doc $(MAKE) -C mlvm doc $(MAKE) -C cpuid doc + $(MAKE) -C vhd doc $(MAKE) -C xen-utils doc .PHONY: clean @@ -190,6 +194,7 @@ $(MAKE) -C forking_executioner clean $(MAKE) -C mlvm clean $(MAKE) -C cpuid clean + $(MAKE) -C vhd clean $(MAKE) -C xen-utils clean cleanxen: diff -r d052a41ffabe -r 5f9ab87260fc vhd/META.in --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/vhd/META.in Thu Jul 22 15:37:45 2010 +0100 @@ -0,0 +1,4 @@ +version = "@VERSION@" +description = "libvhd bindings" +archive(byte) = "vhd.cma" +archive(native) = "vhd.cmxa" diff -r d052a41ffabe -r 5f9ab87260fc vhd/Makefile --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/vhd/Makefile Thu Jul 22 15:37:45 2010 +0100 @@ -0,0 +1,71 @@ + +CC = gcc +CFLAGS = -Wall -fPIC -O2 -I/usr/lib/ocaml -D_LARGEFILE_SOURCE -D_LARGEFILE64_SOURCE -D_GNU_SOURCE -fno-strict-aliasing -D_FILE_OFFSET_BITS=64 +OCAMLC = ocamlc -g +OCAMLOPT = ocamlopt +OCAMLFIND = ocamlfind + +LDFLAGS = -cclib -L./ + +DESTDIR ?= / +VERSION := 1 +OCAMLFLAGS = -g -dtypes + +OCAMLABI := $(shell ocamlc -version) +OCAMLLIBDIR := $(shell ocamlc -where) +OCAMLDESTDIR ?= $(OCAMLLIBDIR) + +OBJS = vhd +INTF = $(foreach obj, $(OBJS),$(obj).cmi) +LIBS = vhd.cma vhd.cmxa + +DOCDIR = /myrepos/xen-api-libs.hg/doc + +all: $(INTF) $(LIBS) $(PROGRAMS) + +bins: $(PROGRAMS) + +libs: $(LIBS) + +vhd.cmxa: libvhd_stubs.a $(foreach obj,$(OBJS),$(obj).cmx) + $(OCAMLFIND) $(OCAMLOPT) $(OCAMLFLAGS) -a -o $@ -cclib -lvhd_stubs -cclib -lvhd $(foreach obj,$(OBJS),$(obj).cmx) + +vhd.cma: $(foreach obj,$(OBJS),$(obj).cmo) + $(OCAMLFIND) $(OCAMLC) $(OCAMLFLAGS) -a -dllib dllvhd_stubs.so -cclib -lvhd_stubs -cclib -lvhd -o $@ $(foreach obj,$(OBJS),$(obj).cmo) + +vhd_stubs.a: vhd_stubs.o + ocamlmklib -o vhd_stubs -lvhd $+ + +libvhd_stubs.a: vhd_stubs.o + ar rcs $@ $+ + ocamlmklib -o vhd_stubs -lvhd $+ + +%.cmo: %.ml + $(OCAMLFIND) $(OCAMLC) $(OCAMLFLAGS) -c -o $@ $< + +%.cmi: %.mli + $(OCAMLFIND) $(OCAMLC) $(OCAMLFLAGS) -c -o $@ $< + +%.cmx: %.ml + $(OCAMLFIND) $(OCAMLOPT) $(OCAMLFLAGS) -c -o $@ $< + +%.o: %.c + $(CC) $(CFLAGS) -c -o $@ $< + +META: META.in + sed 's/@VERSION@/$(VERSION)/g' < $< > $@ + +.PHONY: install +install: $(LIBS) META + ocamlfind install -destdir $(DESTDIR)$(shell ocamlfind printconf destdir) -ldconf ignore vhd META $(INTF) $(LIBS) *.a *.so *.cmx + +.PHONY: uninstall +uninstall: + ocamlfind remove vhd + +.PHONY: doc +doc: $(INTF) + python ../doc/doc.py $(DOCDIR) "vhd" "package" "$(OBJS)" "." "" "" + +clean: + rm -f *.o *.so *.a *.cmo *.cmi *.cma *.cmx *.cmxa *.annot $(LIBS) $(PROGRAMS) diff -r d052a41ffabe -r 5f9ab87260fc vhd/vhd.ml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/vhd/vhd.ml Thu Jul 22 15:37:45 2010 +0100 @@ -0,0 +1,111 @@ +type vhd + +let dd_blk_unused = 0xFFFFFFFFL + +type open_flags = + | Open_rdonly + | Open_rdwr + | Open_fast + | Open_strict + | Open_ignore_disabled + | Open_cached + | Open_io_write_sparse + +type create_flags = + | Flag_creat_file_size_fixed + | Flag_creat_parent_raw + +type vhd_type = + | Ty_none + | Ty_fixed + | Ty_dynamic + | Ty_diff + +external __open : string -> int -> vhd = "stub_vhd_open" + +let _open file flags = + let flag_value = function + | Open_rdonly -> 1 + | Open_rdwr -> 2 + | Open_fast -> 4 + | Open_strict -> 8 + | Open_ignore_disabled -> 16 + | Open_cached -> 32 + | Open_io_write_sparse -> 64 + in + let flags_value = List.fold_left (+) 0 (List.map flag_value flags) in + __open file flags_value + +let create_flags_value flags = + let flag_value = function + | Flag_creat_file_size_fixed -> 1 + | Flag_creat_parent_raw -> 2 + in + List.fold_left (+) 0 (List.map flag_value flags) + +let create_ty_value ty = + match ty with + | Ty_none -> 0 + | Ty_fixed -> 2 + | Ty_dynamic -> 3 + | Ty_diff -> 4 + +external close : vhd -> unit = "stub_vhd_close" + +external _create : string -> int64 -> int -> int64 -> int -> unit = "stub_vhd_create" + +let create name bytes ty mbytes flags = + let flags_value = create_flags_value flags in + let ty_value = create_ty_value ty in + _create name bytes ty_value mbytes flags_value + +external _snapshot : string -> int64 -> string -> int64 -> int -> unit = "stub_vhd_snapshot" + +let snapshot name bytes parent mbytes flags = + let flags_value = create_flags_value flags in + _snapshot name bytes parent mbytes flags_value + +external get_phys_size : vhd -> int64 = "stub_vhd_get_phys_size" +external get_uid : vhd -> string = "stub_vhd_get_uid" +external get_max_bat_size : vhd -> int64 = "stub_vhd_get_max_bat_size" +external get_parent_uid : vhd -> string = "stub_vhd_get_parent_uid" +external get_parent : vhd -> string = "stub_vhd_get_parent" +external get_virtual_size : vhd -> int64 = "stub_vhd_get_virtual_size" +external _get_type : vhd -> int = "stub_vhd_get_type" + +let get_type vhd = + let ty = _get_type vhd in + match ty with + | 0 -> Ty_none + | 2 -> Ty_fixed + | 3 -> Ty_dynamic + | 4 -> Ty_diff + | _ -> failwith "Unknown VHD type" + +external get_creator : vhd -> string = "stub_vhd_get_creator" +external get_hidden : vhd -> int = "stub_vhd_get_hidden" +external set_hidden : vhd -> int -> unit = "stub_vhd_set_hidden" +external set_phys_size : vhd -> int64 -> unit = "stub_vhd_set_phys_size" +external set_virt_size : vhd -> int64 -> unit = "stub_vhd_set_virt_size" +external coalesce : vhd -> unit = "stub_vhd_coalesce" +external write_sector : vhd -> int64 -> string -> int = "stub_vhd_write_sector" +external read_sector : vhd -> int64 -> string = "stub_vhd_read_sector" +external set_log_level : int -> unit = "stub_vhd_set_log_level" +external set_parent : vhd -> string -> bool -> unit = "stub_vhd_set_parent" +external get_bat : vhd -> (int*int) list = "stub_vhd_get_bat" +external _get_first_allocated_block : vhd -> int64 = "stub_vhd_get_first_allocated_block" + +let get_first_allocated_block vhd = + let blk = _get_first_allocated_block vhd in + if blk = dd_blk_unused then None else Some blk + +let with_vhd filename rw f = + let vhd = _open filename (if rw then [Open_rdwr] else [Open_rdonly]) in + try + let result = f vhd in + close vhd; + result + with e -> + close vhd; + raise e + diff -r d052a41ffabe -r 5f9ab87260fc vhd/vhd.mli --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/vhd/vhd.mli Thu Jul 22 15:37:45 2010 +0100 @@ -0,0 +1,46 @@ +type vhd + +val dd_blk_unused : int64 + +type open_flags = + | Open_rdonly + | Open_rdwr + | Open_fast + | Open_strict + | Open_ignore_disabled + | Open_cached + | Open_io_write_sparse + +type create_flags = + | Flag_creat_file_size_fixed + | Flag_creat_parent_raw + +type vhd_type = + | Ty_none + | Ty_fixed + | Ty_dynamic + | Ty_diff + +val _open : string -> open_flags list -> vhd +val close : vhd -> unit +val create : string -> int64 -> vhd_type -> int64 -> create_flags list -> unit +val snapshot : string -> int64 -> string -> int64 -> create_flags list -> unit +val get_phys_size : vhd -> int64 +val get_uid : vhd -> string +val get_max_bat_size : vhd -> int64 +val get_parent_uid : vhd -> string +val get_parent : vhd -> string +val get_virtual_size : vhd -> int64 +val get_type : vhd -> vhd_type +val get_creator : vhd -> string +val get_hidden : vhd -> int +val set_hidden : vhd -> int -> unit +val set_phys_size : vhd -> int64 -> unit +val set_virt_size : vhd -> int64 -> unit +val coalesce : vhd -> unit +val write_sector : vhd -> int64 -> string -> int +val read_sector : vhd -> int64 -> string +val set_log_level : int -> unit +val set_parent : vhd -> string -> bool -> unit +val get_bat : vhd -> (int*int) list +val get_first_allocated_block : vhd -> int64 option diff -r d052a41ffabe -r 5f9ab87260fc vhd/vhd_stubs.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/vhd/vhd_stubs.c Thu Jul 22 15:37:45 2010 +0100 @@ -0,0 +1,543 @@ +#include +#include +#include +#include +#include + +#include + +#include +#include +#include +#include +#include +#include + +#include "syslog.h" + + +static struct custom_operations vhd_ops = { + "com.citrix.dci.vhd", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +#define Vhd_val(v) (*((vhd_context_t **) Data_custom_val(v))) + +static value alloc_vhd(vhd_context_t *t) +{ + value v = alloc_custom(&vhd_ops, sizeof(vhd_context_t *), 0, 1); + Vhd_val(v)=t; + return v; +} + +value stub_vhd_open(value name, value flags) +{ + CAMLparam2(name,flags); + CAMLlocal1(vhd); + vhd_context_t *context = (vhd_context_t *)malloc(sizeof(vhd_context_t)); + int ret = vhd_open(context,String_val(name),Int_val(flags)); + if(ret!=0) { + caml_failwith("Failed to open VHD"); + } + vhd=alloc_vhd(context); + CAMLreturn (vhd); +} + +value stub_vhd_close(value vhd) +{ + CAMLparam1(vhd); + vhd_context_t *context=Vhd_val(vhd); + vhd_close(context); + free(context); + CAMLreturn (Val_unit); +} + +value stub_vhd_get_phys_size(value vhd) +{ + CAMLparam1(vhd); + vhd_context_t *context=Vhd_val(vhd); + off64_t phys_size; + vhd_get_phys_size(context, &phys_size); + CAMLreturn(caml_copy_int64(phys_size)); +} + +value stub_vhd_create(value name, value size, value type, value mbytes, value flags) +{ + CAMLparam5(name,size,type,mbytes,flags); + int ret = vhd_create(String_val(name),Int64_val(size),Int_val(type),Int64_val(mbytes),Int_val(flags)); + if(ret != 0) { + caml_failwith("Failed to create VHD"); + } + CAMLreturn (Val_unit); +} + +value stub_vhd_snapshot(value snapshot, value size, value parent, value mbytes, value flags) +{ + CAMLparam5(snapshot,size,parent,mbytes,flags); + int ret = vhd_snapshot(String_val(snapshot),Int64_val(size),String_val(parent),Int64_val(mbytes),Int_val(flags)); + if(ret != 0) { + caml_failwith("Failed to snapshot VHD"); + } + CAMLreturn (Val_unit); +} + +value stub_vhd_get_parent(value vhd) +{ + CAMLparam1(vhd); + char *parent=NULL; + int n,i,err; + vhd_parent_locator_t *loc; + + vhd_context_t *context = Vhd_val(vhd); + + if(context->footer.type != HD_TYPE_DIFF) { + caml_failwith("Disk is not a differencing disk"); + } + + n = vhd_parent_locator_count(context); + for (i = 0; i < n; i++) { + loc = context->header.loc + i; + if(loc->code == PLAT_CODE_MACX) { + err = vhd_parent_locator_read(context, loc, &parent); + if (err) + caml_failwith("vhd_parent_locator_read failed"); + } + } + + if(parent==NULL) { + caml_failwith("Failed to find a parent!"); + } + + CAMLreturn(caml_copy_string(parent)); +} + +value stub_vhd_get_uid(value vhd) +{ + CAMLparam1(vhd); + vhd_context_t *context = Vhd_val(vhd); + char uuid[256]; + uuid_unparse_lower(context->footer.uuid,uuid); + CAMLreturn(caml_copy_string(uuid)); +} + +value stub_vhd_get_max_bat_size(value vhd) +{ + CAMLparam1(vhd); + vhd_context_t *context = Vhd_val(vhd); + CAMLreturn(caml_copy_int64(context->header.max_bat_size)); +} + +value stub_vhd_get_parent_uid(value vhd) +{ + CAMLparam1(vhd); + vhd_context_t *context = Vhd_val(vhd); + char uuid[256]; + if(context->footer.type != HD_TYPE_DIFF) { + caml_failwith("Not a differencing disk"); + } + uuid_unparse_lower(context->header.prt_uuid,uuid); + CAMLreturn(caml_copy_string(uuid)); +} + +value stub_vhd_get_type(value vhd) +{ + CAMLparam1(vhd); + vhd_context_t *context = Vhd_val(vhd); + CAMLreturn(Val_int(context->footer.type)); +} + +value stub_vhd_get_creator(value vhd) +{ + CAMLparam1(vhd); + vhd_context_t *context = Vhd_val(vhd); + char creator[5]; + strncpy(creator,context->footer.crtr_app,4); + creator[4]='\0'; + CAMLreturn(caml_copy_string(creator)); +} + +value stub_vhd_get_virtual_size(value vhd) +{ + CAMLparam1(vhd); + vhd_context_t *context = Vhd_val(vhd); + CAMLreturn(caml_copy_int64(context->footer.curr_size)); +} + +value stub_vhd_get_hidden(value vhd) +{ + CAMLparam1(vhd); + int hidden; + vhd_context_t *context = Vhd_val(vhd); + vhd_hidden(context,&hidden); + CAMLreturn(Val_int(hidden)); +} + +value stub_vhd_set_hidden(value vhd, value hidden) +{ + CAMLparam2(vhd,hidden); + vhd_context_t *context = Vhd_val(vhd); + context->footer.hidden = (char)Int_val(hidden); + int err = vhd_write_footer(context, &context->footer); + if(err) { + syslog(LOG_DAEMON | LOG_ERR, "set hidden failed: %d", err); + caml_failwith("Set hidden failed!"); + } + CAMLreturn(Val_unit); +} + +value stub_vhd_set_phys_size(value vhd, value ml_newsize) +{ + CAMLparam2(vhd,ml_newsize); + int err; + vhd_context_t *context = Vhd_val(vhd); + uint64_t newsize=Int64_val(ml_newsize); + err=vhd_set_phys_size(context, newsize); + if(err) { + syslog(LOG_DAEMON | LOG_ERR, "vhd_set_phys_size failed: %d", err); + caml_failwith("Set phys_size failed"); + } + CAMLreturn(Val_unit); +} + +value stub_vhd_set_virt_size(value vhd, value ml_newsize) +{ + CAMLparam2(vhd,ml_newsize); + int err; + vhd_context_t *context = Vhd_val(vhd); + uint64_t newsize=Int64_val(ml_newsize); + err=vhd_set_virt_size(context, newsize); + if(err) { + syslog(LOG_DAEMON | LOG_ERR, "vhd_set_virt_size failed: %d", err); + caml_failwith("Set virt_size failed"); + } + CAMLreturn(Val_unit); +} + +static int +__raw_io_write(int fd, char* buf, uint64_t sec, uint32_t secs) +{ + off64_t off; + size_t ret; + + errno = 0; + off = lseek64(fd, vhd_sectors_to_bytes(sec), SEEK_SET); + if (off == (off64_t)-1) { + printf("raw parent: seek(0x%08"PRIx64") failed: %d\n", + vhd_sectors_to_bytes(sec), -errno); + return -errno; + } + + ret = write(fd, buf, vhd_sectors_to_bytes(secs)); + if (ret == vhd_sectors_to_bytes(secs)) + return 0; + + printf("raw parent: write of 0x%"PRIx64" returned %zd, errno: %d\n", + vhd_sectors_to_bytes(secs), ret, -errno); + return (errno ? -errno : -EIO); +} + +/* + * Use 'parent' if the parent is VHD, and 'parent_fd' if the parent is raw + */ +static int +vhd_util_coalesce_block(vhd_context_t *vhd, vhd_context_t *parent, + int parent_fd, uint64_t block) +{ + int i, err; + char *buf, *map; + uint64_t sec, secs; + + buf = NULL; + map = NULL; + sec = block * vhd->spb; + + if (vhd->bat.bat[block] == DD_BLK_UNUSED) + return 0; + + err = posix_memalign((void **)&buf, 4096, vhd->header.block_size); + if (err) + return -err; + + err = vhd_io_read(vhd, buf, sec, vhd->spb); + if (err) + goto done; + + if (vhd_has_batmap(vhd) && vhd_batmap_test(vhd, &vhd->batmap, block)) { + if (parent->file) + err = vhd_io_write(parent, buf, sec, vhd->spb); + else + err = __raw_io_write(parent_fd, buf, sec, vhd->spb); + goto done; + } + + err = vhd_read_bitmap(vhd, block, &map); + if (err) + goto done; + + for (i = 0; i < vhd->spb; i++) { + if (!vhd_bitmap_test(vhd, map, i)) + continue; + + for (secs = 0; i + secs < vhd->spb; secs++) + if (!vhd_bitmap_test(vhd, map, i + secs)) + break; + + if (parent->file) + err = vhd_io_write(parent, + buf + vhd_sectors_to_bytes(i), + sec + i, secs); + else + err = __raw_io_write(parent_fd, + buf + vhd_sectors_to_bytes(i), + sec + i, secs); + if (err) + goto done; + + i += secs; + } + + err = 0; + +done: + free(buf); + free(map); + return err; +} + +value stub_vhd_coalesce(value vhd) +{ + CAMLparam1(vhd); + vhd_context_t *context = Vhd_val(vhd); + vhd_context_t parent; + char uuid[37]; + char *pname; + int err,i; + int parent_fd=-1; + + parent.file = NULL; + + uuid_unparse(context->footer.uuid,uuid); + + caml_enter_blocking_section(); + + err=vhd_parent_locator_get(context, &pname); + if(err) { + syslog(LOG_DAEMON | LOG_ERR, "Error finding %s parent: %d", uuid, err); + caml_failwith("Couldn't find parent"); + } + + if( vhd_parent_raw(context)) { + parent_fd = open(pname, O_RDWR | O_DIRECT | O_LARGEFILE, 0644); + if(parent_fd == -1) { + err = - errno; + syslog(LOG_DAEMON | LOG_ERR, "Failed to open raw parent %s: %d",pname,err); + free(pname); + caml_failwith("Couldn't open parent"); + } + } else { + err = vhd_open(&parent,pname,VHD_OPEN_RDWR); + if(err) { + syslog(LOG_DAEMON | LOG_ERR, "Failed to open vhd parent %s: %d",pname,err); + free(pname); + caml_failwith("Couldn't open parent"); + } + } + + err=vhd_get_bat(context); + if(err) + goto done; + + if(vhd_has_batmap(context)) { + err = vhd_get_batmap(context); + if (err) + goto done; + } + + for(i=0; ibat.entries; i++) { + err=vhd_util_coalesce_block(context,&parent,parent_fd,i); + if(err) + goto done; + } + + err=0; + + done: + free(pname); + if(parent.file) + vhd_close(&parent); + else + close(parent_fd); + + caml_leave_blocking_section(); + + CAMLreturn (Val_unit); +} + +value stub_vhd_write_sector(value vhd, value ml_sectorno, value ml_string) +{ + CAMLparam3(vhd, ml_sectorno, ml_string); + uint64_t sectorno=Int64_val(ml_sectorno); + if(caml_string_length(ml_string)!=512) + caml_failwith("Require string to be of length 512"); + vhd_context_t *context = Vhd_val(vhd); + char *buf; + int err; + + err = posix_memalign((void **)&buf, 4096, context->header.block_size); + + if(err) { + syslog(LOG_INFO, "error with the posix_memalign: %d", err); + caml_failwith("Error with the posix memalign"); + } + + memcpy(buf,String_val(ml_string),512); + + caml_enter_blocking_section(); + + err = vhd_get_bat(context); + + if(err) { + syslog(LOG_INFO, "error getting bat: %d", err); + caml_leave_blocking_section(); + caml_failwith("Error getting BAT"); + } + + err = vhd_io_write(context, buf, sectorno, 1); + + if(err) { + syslog(LOG_INFO, "error performing write: %d", err); + caml_leave_blocking_section(); + caml_failwith("Error performing write"); + } + + syslog(LOG_INFO, "string='%s', sectorno=%Ld, err=%d", buf, sectorno, err); + + caml_leave_blocking_section(); + + CAMLreturn(Val_int(err)); +} + +value stub_vhd_read_sector(value vhd, value ml_sectorno) +{ + CAMLparam2(vhd,ml_sectorno); + CAMLlocal1(returnstr); + char buf[512]; + uint64_t sectorno=Int64_val(ml_sectorno); + vhd_context_t *context = Vhd_val(vhd); + int err; + + caml_enter_blocking_section(); + err = vhd_io_read(context, buf, sectorno, 1); + caml_leave_blocking_section(); + + returnstr=caml_alloc_string(512); + memcpy(String_val(returnstr),buf,512); + CAMLreturn(returnstr); +} + +value stub_vhd_set_log_level(value level) +{ + CAMLparam1(level); + libvhd_set_log_level(Int_val(level)); + CAMLreturn(Val_unit); +} + +value stub_vhd_set_parent(value vhd, value ml_new_parent, value ml_new_parent_is_raw) +{ + CAMLparam3(vhd, ml_new_parent, ml_new_parent_is_raw); + char *new_parent = strdup(String_val(ml_new_parent)); + int new_parent_is_raw = 0; + vhd_context_t *context = Vhd_val(vhd); + int err; + + if(Bool_val(ml_new_parent_is_raw)) + new_parent_is_raw=1; + + caml_enter_blocking_section(); + err=vhd_change_parent(context, new_parent, new_parent_is_raw); + if(err) { + syslog(LOG_INFO, "error performing setting parent: %d", err); + } + caml_leave_blocking_section(); + + CAMLreturn(Val_unit); +} + +/* Return a run-length encoded list of allocated blocks */ +value stub_vhd_get_bat(value vhd) +{ + CAMLparam1(vhd); + CAMLlocal3(list,tmp,pair); + vhd_context_t *context = Vhd_val(vhd); + int state=0; + int len=0; + int i; + int max = context->footer.curr_size >> 21; + + int err = vhd_get_bat(context); + + syslog(LOG_DAEMON | LOG_ERR, "stub_vhd_get_bat: max=%d",max); + + if(err != 0) { + caml_failwith("Failed to get BAT"); + } + + list = Val_int(0); + + for(i=0; ibat.bat[i] != DD_BLK_UNUSED) { + state=1; + pair = caml_alloc(2,0); + Store_field(pair,0,Val_int(i)); + len=1; + } + } else if(state==1) { + if(context->bat.bat[i] == DD_BLK_UNUSED) { + Store_field(pair,1,Val_int(len)); + tmp = caml_alloc(2,0); + Store_field(tmp,0,pair); + Store_field(tmp,1,list); + list=tmp; + state=0; + len=0; + } else { + len++; + } + } + } + + if(state==1) { + Store_field(pair,1,Val_int(len)); + tmp = caml_alloc(2,0); + Store_field(tmp,0,pair); + Store_field(tmp,1,list); + list=tmp; + } + + + CAMLreturn(list); +} + +value stub_vhd_get_first_allocated_block(value vhd) +{ + CAMLparam1(vhd); + vhd_context_t *context = Vhd_val(vhd); + uint64_t firstblock=DD_BLK_UNUSED; + int i,max,err; + + max = context->footer.curr_size >> 21; + err = vhd_get_bat(context); + + for(i=0; ibat.bat[i]bat.bat[i]; + } + } + + CAMLreturn(caml_copy_int64(firstblock)); +} diff -r d052a41ffabe -r 5f9ab87260fc xapi-libs.spec --- a/xapi-libs.spec Wed Jul 21 23:29:38 2010 +0100 +++ b/xapi-libs.spec Thu Jul 22 15:37:45 2010 +0100 @@ -267,6 +267,14 @@ /usr/lib/ocaml/xml-light2/xml-light2.cmxa /usr/lib/ocaml/xml-light2/xml.cmi /usr/lib/ocaml/xml-light2/xml.cmx + /usr/lib/ocaml/vhd/META + /usr/lib/ocaml/vhd/dllvhd_stubs.so + /usr/lib/ocaml/vhd/libvhd_stubs.a + /usr/lib/ocaml/vhd/vhd.a + /usr/lib/ocaml/vhd/vhd.cma + /usr/lib/ocaml/vhd/vhd.cmi + /usr/lib/ocaml/vhd/vhd.cmx + /usr/lib/ocaml/vhd/vhd.cmxa %exclude /usr/lib/ocaml/close-and-exec/closeandexec_main.cmx %exclude /usr/lib/ocaml/pciutil/pciutil_main.cmx