WARNING - OLD ARCHIVES

This is an archived copy of the Xen.org mailing list, which we have preserved to ensure that existing links to archives are not broken. The live archive, which contains the latest emails, can be found at http://lists.xen.org/
   
 
 
Xen 
 
Home Products Support Community News
 
   
 

xen-api

[Xen-API] [PATCH] add ocaml bindings to libvhd

To: xen-api@xxxxxxxxxxxxxxxxxxx
Subject: [Xen-API] [PATCH] add ocaml bindings to libvhd
From: David Scott <dave.scott@xxxxxxxxxxxxx>
Date: Thu, 22 Jul 2010 15:38:04 +0100
Delivery-date: Thu, 22 Jul 2010 07:50:23 -0700
Envelope-to: www-data@xxxxxxxxxxxxxxxxxxx
List-help: <mailto:xen-api-request@lists.xensource.com?subject=help>
List-id: Discussion of API issues surrounding Xen <xen-api.lists.xensource.com>
List-post: <mailto:xen-api@lists.xensource.com>
List-subscribe: <http://lists.xensource.com/mailman/listinfo/xen-api>, <mailto:xen-api-request@lists.xensource.com?subject=subscribe>
List-unsubscribe: <http://lists.xensource.com/mailman/listinfo/xen-api>, <mailto:xen-api-request@lists.xensource.com?subject=unsubscribe>
Sender: xen-api-bounces@xxxxxxxxxxxxxxxxxxx
User-agent: Mercurial-patchbomb/1.4.3
# HG changeset patch
# User Jon Ludlam <jonathan.ludlam@xxxxxxxxxxxxx>
# 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 <jonathan.ludlam@xxxxxxxxxxxxx>
Acked-by: Dave Scott <dave.scott@xxxxxxxxxxxxx>

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 <errno.h>
+#include <fcntl.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#include <vhd/libvhd.h>
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <caml/signals.h>
+
+#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; i<context->bat.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; i<max; i++) {
+    if(state==0) {
+      if(context->bat.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; i<max; i++) {
+    if(context->bat.bat[i]<firstblock) {
+      firstblock=context->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
 Makefile.in     |    5 +
 vhd/META.in     |    4 +
 vhd/Makefile    |   71 +++++++
 vhd/vhd.ml      |  111 +++++++++++
 vhd/vhd.mli     |   46 ++++
 vhd/vhd_stubs.c |  543 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 xapi-libs.spec  |    8 +
 7 files changed, 788 insertions(+), 0 deletions(-)


Attachment: xen-api-libs.hg.patch
Description: Text Data

_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
<Prev in Thread] Current Thread [Next in Thread>
  • [Xen-API] [PATCH] add ocaml bindings to libvhd, David Scott <=