# HG changeset patch
# User Keir Fraser <keir.fraser@xxxxxxxxxx>
# Date 1273140174 -3600
# Node ID 755c87a78ecbf20b02b417e5e0f10d3f15a4c719
# Parent 08aa6b3afaf24662e654aaeb77562c39a691a6cd
ocaml: Add XS bindings.
Signed-off-by: Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
---
tools/ocaml/libs/eventchn/META.in | 4
tools/ocaml/libs/eventchn/Makefile | 28 +++
tools/ocaml/libs/eventchn/eventchn.ml | 27 ++
tools/ocaml/libs/eventchn/eventchn.mli | 26 ++
tools/ocaml/libs/eventchn/eventchn_stubs.c | 173 ++++++++++++++++++
tools/ocaml/libs/xb/META.in | 4
tools/ocaml/libs/xb/Makefile | 41 ++++
tools/ocaml/libs/xb/op.ml | 84 +++++++++
tools/ocaml/libs/xb/packet.ml | 50 +++++
tools/ocaml/libs/xb/partial.ml | 44 ++++
tools/ocaml/libs/xb/xb.ml | 189 ++++++++++++++++++++
tools/ocaml/libs/xb/xb.mli | 83 +++++++++
tools/ocaml/libs/xb/xb_stubs.c | 74 ++++++++
tools/ocaml/libs/xb/xs_ring.ml | 18 +
tools/ocaml/libs/xb/xs_ring_stubs.c | 117 ++++++++++++
tools/ocaml/libs/xs/META.in | 4
tools/ocaml/libs/xs/Makefile | 42 ++++
tools/ocaml/libs/xs/queueop.ml | 73 +++++++
tools/ocaml/libs/xs/xs.ml | 170 ++++++++++++++++++
tools/ocaml/libs/xs/xs.mli | 90 +++++++++
tools/ocaml/libs/xs/xsraw.ml | 265 +++++++++++++++++++++++++++++
tools/ocaml/libs/xs/xsraw.mli | 60 ++++++
tools/ocaml/libs/xs/xst.ml | 61 ++++++
tools/ocaml/libs/xs/xst.mli | 30 +++
24 files changed, 1757 insertions(+)
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/eventchn/META.in
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/eventchn/META.in Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,4 @@
+version = "@VERSION@"
+description = "Eventchn interface extension"
+archive(byte) = "eventchn.cma"
+archive(native) = "eventchn.cmxa"
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/eventchn/Makefile
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/eventchn/Makefile Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,28 @@
+TOPLEVEL=../..
+include $(TOPLEVEL)/common.make
+
+OBJS = eventchn
+INTF = $(foreach obj, $(OBJS),$(obj).cmi)
+LIBS = eventchn.cma eventchn.cmxa
+
+all: $(INTF) $(LIBS) $(PROGRAMS)
+
+bins: $(PROGRAMS)
+
+libs: $(LIBS)
+
+eventchn_OBJS = $(OBJS)
+eventchn_C_OBJS = eventchn_stubs
+
+OCAML_LIBRARY = eventchn
+
+.PHONY: install
+install: $(LIBS) META
+ ocamlfind install -destdir $(DESTDIR)$(shell ocamlfind printconf
destdir) -ldconf ignore eventchn META $(INTF) $(LIBS) *.a *.so *.cmx
+
+.PHONY: uninstall
+uninstall:
+ ocamlfind remove eventchn
+
+include $(TOPLEVEL)/Makefile.rules
+
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/eventchn/eventchn.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/eventchn/eventchn.ml Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,27 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+exception Error of string
+
+external init: unit -> Unix.file_descr = "stub_eventchn_init"
+external notify: Unix.file_descr -> int -> unit = "stub_eventchn_notify"
+external bind_interdomain: Unix.file_descr -> int -> int -> int =
"stub_eventchn_bind_interdomain"
+external bind_virq: Unix.file_descr -> int = "stub_eventchn_bind_virq"
+external unbind: Unix.file_descr -> int -> unit = "stub_eventchn_unbind"
+external read_port: Unix.file_descr -> int = "stub_eventchn_read_port"
+external write_port: Unix.file_descr -> int -> unit =
"stub_eventchn_write_port"
+
+let _ = Callback.register_exception "eventchn.error" (Error
"register_callback")
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/eventchn/eventchn.mli
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/eventchn/eventchn.mli Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,26 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+exception Error of string
+external init : unit -> Unix.file_descr = "stub_eventchn_init"
+external notify : Unix.file_descr -> int -> unit = "stub_eventchn_notify"
+external bind_interdomain : Unix.file_descr -> int -> int -> int
+ = "stub_eventchn_bind_interdomain"
+external bind_virq : Unix.file_descr -> int = "stub_eventchn_bind_virq"
+external unbind : Unix.file_descr -> int -> unit = "stub_eventchn_unbind"
+external read_port : Unix.file_descr -> int = "stub_eventchn_read_port"
+external write_port : Unix.file_descr -> int -> unit
+ = "stub_eventchn_write_port"
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/eventchn/eventchn_stubs.c
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/eventchn/eventchn_stubs.c Thu May 06 11:02:54
2010 +0100
@@ -0,0 +1,173 @@
+/*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <errno.h>
+#include <stdint.h>
+
+#include <sys/ioctl.h>
+
+#define __XEN_TOOLS__
+
+#include <xen/sysctl.h>
+
+#if XEN_SYSCTL_INTERFACE_VERSION < 4
+#include <xen/linux/evtchn.h>
+#else
+#include <xen/xen.h>
+#include <xen/sys/evtchn.h>
+#endif
+
+#include <xenctrl.h>
+
+#define CAML_NAME_SPACE
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/callback.h>
+#include <caml/fail.h>
+
+#define EVENTCHN_PATH "/dev/xen/eventchn"
+
+static int eventchn_major = 10;
+static int eventchn_minor = 61;
+
+static int do_ioctl(int handle, int cmd, void *arg)
+{
+ return ioctl(handle, cmd, arg);
+}
+
+static int do_read_port(int handle, evtchn_port_t *port)
+{
+ return (read(handle, port, sizeof(evtchn_port_t)) !=
sizeof(evtchn_port_t));
+}
+
+static int do_write_port(int handle, evtchn_port_t port)
+{
+ return (write(handle, &port, sizeof(evtchn_port_t)) !=
sizeof(evtchn_port_t));
+}
+
+int eventchn_do_open(void)
+{
+ int fd;
+
+ fd = open(EVENTCHN_PATH, O_RDWR);
+ if (fd == -1 && errno == ENOENT) {
+ mkdir("/dev/xen", 0640);
+ mknod(EVENTCHN_PATH, S_IFCHR | 0640, makedev(eventchn_major,
eventchn_minor));
+ fd = open(EVENTCHN_PATH, O_RDWR);
+ }
+ return fd;
+}
+
+CAMLprim value stub_eventchn_init(value unit)
+{
+ CAMLparam1(unit);
+ int fd = eventchn_do_open();
+ if (fd == -1)
+ caml_failwith("open failed");
+ CAMLreturn(Val_int(fd));
+}
+
+CAMLprim value stub_eventchn_notify(value fd, value port)
+{
+ CAMLparam2(fd, port);
+ struct ioctl_evtchn_notify notify;
+ int rc;
+
+ notify.port = Int_val(port);
+ rc = do_ioctl(Int_val(fd), IOCTL_EVTCHN_NOTIFY, ¬ify);
+ if (rc == -1)
+ caml_failwith("ioctl notify failed");
+
+ CAMLreturn(Val_unit);
+}
+
+CAMLprim value stub_eventchn_bind_interdomain(value fd, value domid,
+ value remote_port)
+{
+ CAMLparam3(fd, domid, remote_port);
+ CAMLlocal1(port);
+ struct ioctl_evtchn_bind_interdomain bind;
+ int rc;
+
+ bind.remote_domain = Int_val(domid);
+ bind.remote_port = Int_val(remote_port);
+ rc = do_ioctl(Int_val(fd), IOCTL_EVTCHN_BIND_INTERDOMAIN, &bind);
+ if (rc == -1)
+ caml_failwith("ioctl bind_interdomain failed");
+ port = Val_int(rc);
+
+ CAMLreturn(port);
+}
+
+CAMLprim value stub_eventchn_bind_virq(value fd)
+{
+ CAMLparam1(fd);
+ CAMLlocal1(port);
+ struct ioctl_evtchn_bind_virq bind;
+ int rc;
+
+ bind.virq = VIRQ_DOM_EXC;
+ rc = do_ioctl(Int_val(fd), IOCTL_EVTCHN_BIND_VIRQ, &bind);
+ if (rc == -1)
+ caml_failwith("ioctl bind_virq failed");
+ port = Val_int(rc);
+
+ CAMLreturn(port);
+}
+
+CAMLprim value stub_eventchn_unbind(value fd, value port)
+{
+ CAMLparam2(fd, port);
+ struct ioctl_evtchn_unbind unbind;
+ int rc;
+
+ unbind.port = Int_val(port);
+ rc = do_ioctl(Int_val(fd), IOCTL_EVTCHN_UNBIND, &unbind);
+ if (rc == -1)
+ caml_failwith("ioctl unbind failed");
+
+ CAMLreturn(Val_unit);
+}
+
+CAMLprim value stub_eventchn_read_port(value fd)
+{
+ CAMLparam1(fd);
+ CAMLlocal1(result);
+ evtchn_port_t port;
+
+ if (do_read_port(Int_val(fd), &port))
+ caml_failwith("read port failed");
+ result = Val_int(port);
+
+ CAMLreturn(result);
+}
+
+CAMLprim value stub_eventchn_write_port(value fd, value _port)
+{
+ CAMLparam2(fd, _port);
+ evtchn_port_t port;
+
+ port = Int_val(_port);
+ if (do_write_port(Int_val(fd), port))
+ caml_failwith("write port failed");
+ CAMLreturn(Val_unit);
+}
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xb/META.in
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xb/META.in Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,4 @@
+version = "@VERSION@"
+description = "XenBus Interface"
+archive(byte) = "xb.cma"
+archive(native) = "xb.cmxa"
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xb/Makefile
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xb/Makefile Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,41 @@
+TOPLEVEL=../..
+include $(TOPLEVEL)/common.make
+
+CFLAGS += -I../mmap
+OCAMLINCLUDE += -I ../mmap
+
+.NOTPARALLEL:
+# Ocaml is such a PITA!
+
+PREINTF = op.cmi partial.cmi packet.cmi
+PREOBJS = op partial packet xs_ring
+PRELIBS = $(foreach obj, $(PREOBJS),$(obj).cmo) $(foreach
obj,$(PREOJBS),$(obj).cmx)
+OBJS = op partial packet xs_ring xb
+INTF = op.cmi packet.cmi xb.cmi
+LIBS = xb.cma xb.cmxa
+
+ALL_OCAML_OBJS = $(OBJS) $(PREOJBS)
+
+all: $(PREINTF) $(PRELIBS) $(INTF) $(LIBS) $(PROGRAMS)
+
+bins: $(PROGRAMS)
+
+libs: $(LIBS)
+
+xb_OBJS = $(OBJS)
+xb_C_OBJS = xs_ring_stubs xb_stubs
+OCAML_LIBRARY = xb
+
+%.mli: %.ml
+ $(E) " MLI $@"
+ $(Q)$(OCAMLC) -i $< $o
+
+.PHONY: install
+install: $(LIBS) META
+ ocamlfind install -destdir $(DESTDIR)$(shell ocamlfind printconf
destdir) -ldconf ignore xb META $(INTF) $(LIBS) *.a *.so *.cmx
+
+.PHONY: uninstall
+uninstall:
+ ocamlfind remove xb
+
+include $(TOPLEVEL)/Makefile.rules
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xb/op.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xb/op.ml Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,84 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type operation = Debug | Directory | Read | Getperms |
+ Watch | Unwatch | Transaction_start |
+ Transaction_end | Introduce | Release |
+ Getdomainpath | Write | Mkdir | Rm |
+ Setperms | Watchevent | Error | Isintroduced |
+ Resume | Set_target
+ | Restrict
+
+(* There are two sets of XB operations: the one coming from open-source and *)
+(* the one coming from our private patch queue. These operations *)
+(* in two differents arrays for make easier the forward compatibility *)
+let operation_c_mapping =
+ [| Debug; Directory; Read; Getperms;
+ Watch; Unwatch; Transaction_start;
+ Transaction_end; Introduce; Release;
+ Getdomainpath; Write; Mkdir; Rm;
+ Setperms; Watchevent; Error; Isintroduced;
+ Resume; Set_target |]
+let size = Array.length operation_c_mapping
+
+(* [offset_pq] has to be the same as in <xen/io/xs_wire.h> *)
+let offset_pq = size
+let operation_c_mapping_pq =
+ [| Restrict |]
+let size_pq = Array.length operation_c_mapping_pq
+
+let array_search el a =
+ let len = Array.length a in
+ let rec search i =
+ if i > len then raise Not_found;
+ if a.(i) = el then i else search (i + 1) in
+ search 0
+
+let of_cval i =
+ if i >= 0 && i < size
+ then operation_c_mapping.(i)
+ else if i >= offset_pq && i < offset_pq + size_pq
+ then operation_c_mapping_pq.(i-offset_pq)
+ else raise Not_found
+
+let to_cval op =
+ try
+ array_search op operation_c_mapping
+ with _ -> offset_pq + array_search op operation_c_mapping_pq
+
+let to_string ty =
+ match ty with
+ | Debug -> "DEBUG"
+ | Directory -> "DIRECTORY"
+ | Read -> "READ"
+ | Getperms -> "GET_PERMS"
+ | Watch -> "WATCH"
+ | Unwatch -> "UNWATCH"
+ | Transaction_start -> "TRANSACTION_START"
+ | Transaction_end -> "TRANSACTION_END"
+ | Introduce -> "INTRODUCE"
+ | Release -> "RELEASE"
+ | Getdomainpath -> "GET_DOMAIN_PATH"
+ | Write -> "WRITE"
+ | Mkdir -> "MKDIR"
+ | Rm -> "RM"
+ | Setperms -> "SET_PERMS"
+ | Watchevent -> "WATCH_EVENT"
+ | Error -> "ERROR"
+ | Isintroduced -> "IS_INTRODUCED"
+ | Resume -> "RESUME"
+ | Set_target -> "SET_TARGET"
+ | Restrict -> "RESTRICT"
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xb/packet.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xb/packet.ml Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,50 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type t =
+{
+ tid: int;
+ rid: int;
+ ty: Op.operation;
+ data: string;
+}
+
+exception Error of string
+exception DataError of string
+
+external string_of_header: int -> int -> int -> int -> string =
"stub_string_of_header"
+
+let create tid rid ty data = { tid = tid; rid = rid; ty = ty; data = data; }
+
+let of_partialpkt ppkt =
+ create ppkt.Partial.tid ppkt.Partial.rid ppkt.Partial.ty
(Buffer.contents ppkt.Partial.buf)
+
+let to_string pkt =
+ let header = string_of_header pkt.tid pkt.rid (Op.to_cval pkt.ty)
(String.length pkt.data) in
+ header ^ pkt.data
+
+let unpack pkt =
+ pkt.tid, pkt.rid, pkt.ty, pkt.data
+
+let get_tid pkt = pkt.tid
+let get_ty pkt = pkt.ty
+let get_data pkt =
+ let l = String.length pkt.data in
+ if l > 0 && pkt.data.[l - 1] = '\000' then
+ String.sub pkt.data 0 (l - 1)
+ else
+ pkt.data
+let get_rid pkt = pkt.rid
\ No newline at end of file
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xb/partial.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xb/partial.ml Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,44 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type pkt =
+{
+ tid: int;
+ rid: int;
+ ty: Op.operation;
+ len: int;
+ buf: Buffer.t;
+}
+
+external header_size: unit -> int = "stub_header_size"
+external header_of_string_internal: string -> int * int * int * int
+ = "stub_header_of_string"
+
+let of_string s =
+ let tid, rid, opint, dlen = header_of_string_internal s in
+ {
+ tid = tid;
+ rid = rid;
+ ty = (Op.of_cval opint);
+ len = dlen;
+ buf = Buffer.create dlen;
+ }
+
+let append pkt s sz =
+ Buffer.add_string pkt.buf (String.sub s 0 sz)
+
+let to_complete pkt =
+ pkt.len - (Buffer.length pkt.buf)
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xb/xb.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xb/xb.ml Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,189 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+module Op = struct include Op end
+module Packet = struct include Packet end
+
+exception End_of_file
+exception Eagain
+exception Noent
+exception Invalid
+
+type backend_mmap =
+{
+ mmap: Mmap.mmap_interface; (* mmaped interface = xs_ring *)
+ eventchn_notify: unit -> unit; (* function to notify through eventchn *)
+ mutable work_again: bool;
+}
+
+type backend_fd =
+{
+ fd: Unix.file_descr;
+}
+
+type backend = Fd of backend_fd | Mmap of backend_mmap
+
+type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * string
+
+type t =
+{
+ backend: backend;
+ pkt_in: Packet.t Queue.t;
+ pkt_out: Packet.t Queue.t;
+ mutable partial_in: partial_buf;
+ mutable partial_out: string;
+}
+
+let init_partial_in () = NoHdr
+ (Partial.header_size (), String.make (Partial.header_size()) '\000')
+
+let queue con pkt = Queue.push pkt con.pkt_out
+
+let read_fd back con s len =
+ let rd = Unix.read back.fd s 0 len in
+ if rd = 0 then
+ raise End_of_file;
+ rd
+
+let read_mmap back con s len =
+ let rd = Xs_ring.read back.mmap s len in
+ back.work_again <- (rd > 0);
+ if rd > 0 then
+ back.eventchn_notify ();
+ rd
+
+let read con s len =
+ match con.backend with
+ | Fd backfd -> read_fd backfd con s len
+ | Mmap backmmap -> read_mmap backmmap con s len
+
+let write_fd back con s len =
+ Unix.write back.fd s 0 len
+
+let write_mmap back con s len =
+ let ws = Xs_ring.write back.mmap s len in
+ if ws > 0 then
+ back.eventchn_notify ();
+ ws
+
+let write con s len =
+ match con.backend with
+ | Fd backfd -> write_fd backfd con s len
+ | Mmap backmmap -> write_mmap backmmap con s len
+
+let output con =
+ (* get the output string from a string_of(packet) or partial_out *)
+ let s = if String.length con.partial_out > 0 then
+ con.partial_out
+ else if Queue.length con.pkt_out > 0 then
+ Packet.to_string (Queue.pop con.pkt_out)
+ else
+ "" in
+ (* send data from s, and save the unsent data to partial_out *)
+ if s <> "" then (
+ let len = String.length s in
+ let sz = write con s len in
+ let left = String.sub s sz (len - sz) in
+ con.partial_out <- left
+ );
+ (* after sending one packet, partial is empty *)
+ con.partial_out = ""
+
+let input con =
+ let newpacket = ref false in
+ let to_read =
+ match con.partial_in with
+ | HaveHdr partial_pkt -> Partial.to_complete partial_pkt
+ | NoHdr (i, buf) -> i in
+
+ (* try to get more data from input stream *)
+ let s = String.make to_read '\000' in
+ let sz = if to_read > 0 then read con s to_read else 0 in
+
+ (
+ match con.partial_in with
+ | HaveHdr partial_pkt ->
+ (* we complete the data *)
+ if sz > 0 then
+ Partial.append partial_pkt s sz;
+ if Partial.to_complete partial_pkt = 0 then (
+ let pkt = Packet.of_partialpkt partial_pkt in
+ con.partial_in <- init_partial_in ();
+ Queue.push pkt con.pkt_in;
+ newpacket := true
+ )
+ | NoHdr (i, buf) ->
+ (* we complete the partial header *)
+ if sz > 0 then
+ String.blit s 0 buf (Partial.header_size () - i) sz;
+ con.partial_in <- if sz = i then
+ HaveHdr (Partial.of_string buf) else NoHdr (i - sz, buf)
+ );
+ !newpacket
+
+let newcon backend = {
+ backend = backend;
+ pkt_in = Queue.create ();
+ pkt_out = Queue.create ();
+ partial_in = init_partial_in ();
+ partial_out = "";
+ }
+
+let open_fd fd = newcon (Fd { fd = fd; })
+
+let open_mmap mmap notifyfct =
+ newcon (Mmap {
+ mmap = mmap;
+ eventchn_notify = notifyfct;
+ work_again = false; })
+
+let close con =
+ match con.backend with
+ | Fd backend -> Unix.close backend.fd
+ | Mmap backend -> Mmap.unmap backend.mmap
+
+let is_fd con =
+ match con.backend with
+ | Fd _ -> true
+ | Mmap _ -> false
+
+let is_mmap con = not (is_fd con)
+
+let output_len con = Queue.length con.pkt_out
+let has_new_output con = Queue.length con.pkt_out > 0
+let has_old_output con = String.length con.partial_out > 0
+
+let has_output con = has_new_output con || has_old_output con
+
+let peek_output con = Queue.peek con.pkt_out
+
+let input_len con = Queue.length con.pkt_in
+let has_in_packet con = Queue.length con.pkt_in > 0
+let get_in_packet con = Queue.pop con.pkt_in
+let has_more_input con =
+ match con.backend with
+ | Fd _ -> false
+ | Mmap backend -> backend.work_again
+
+let is_selectable con =
+ match con.backend with
+ | Fd _ -> true
+ | Mmap _ -> false
+
+let get_fd con =
+ match con.backend with
+ | Fd backend -> backend.fd
+ | Mmap _ -> raise (Failure "get_fd")
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xb/xb.mli
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xb/xb.mli Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,83 @@
+module Op:
+sig
+ type operation = Op.operation =
+ | Debug
+ | Directory
+ | Read
+ | Getperms
+ | Watch
+ | Unwatch
+ | Transaction_start
+ | Transaction_end
+ | Introduce
+ | Release
+ | Getdomainpath
+ | Write
+ | Mkdir
+ | Rm
+ | Setperms
+ | Watchevent
+ | Error
+ | Isintroduced
+ | Resume
+ | Set_target
+ | Restrict
+ val to_string : operation -> string
+end
+
+module Packet:
+sig
+ type t
+
+ exception Error of string
+ exception DataError of string
+
+ val create : int -> int -> Op.operation -> string -> t
+ val unpack : t -> int * int * Op.operation * string
+
+ val get_tid : t -> int
+ val get_ty : t -> Op.operation
+ val get_data : t -> string
+ val get_rid: t -> int
+end
+
+exception End_of_file
+exception Eagain
+exception Noent
+exception Invalid
+
+type t
+
+(** queue a packet into the output queue for later sending *)
+val queue : t -> Packet.t -> unit
+
+(** process the output queue, return if a packet has been totally sent *)
+val output : t -> bool
+
+(** process the input queue, return if a packet has been totally received *)
+val input : t -> bool
+
+(** create new connection using a fd interface *)
+val open_fd : Unix.file_descr -> t
+(** create new connection using a mmap intf and a function to notify eventchn
*)
+val open_mmap : Mmap.mmap_interface -> (unit -> unit) -> t
+
+(* close a connection *)
+val close : t -> unit
+
+val is_fd : t -> bool
+val is_mmap : t -> bool
+
+val output_len : t -> int
+val has_new_output : t -> bool
+val has_old_output : t -> bool
+val has_output : t -> bool
+val peek_output : t -> Packet.t
+
+val input_len : t -> int
+val has_in_packet : t -> bool
+val get_in_packet : t -> Packet.t
+val has_more_input : t -> bool
+
+val is_selectable : t -> bool
+val get_fd : t -> Unix.file_descr
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xb/xb_stubs.c
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xb/xb_stubs.c Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,74 @@
+/*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ */
+
+#include <unistd.h>
+#include <stdlib.h>
+#include <sys/mman.h>
+#include <string.h>
+#include <errno.h>
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+
+#define __XEN_TOOLS__
+
+#include <xenctrl.h>
+#define u32 uint32_t
+#include <xen/io/xs_wire.h>
+
+CAMLprim value stub_header_size(void)
+{
+ CAMLparam0();
+ CAMLreturn(Val_int(sizeof(struct xsd_sockmsg)));
+}
+
+CAMLprim value stub_header_of_string(value s)
+{
+ CAMLparam1(s);
+ CAMLlocal1(ret);
+ struct xsd_sockmsg *hdr;
+
+ if (caml_string_length(s) != sizeof(struct xsd_sockmsg))
+ caml_failwith("xb header incomplete");
+ ret = caml_alloc_tuple(4);
+ hdr = (struct xsd_sockmsg *) String_val(s);
+ Store_field(ret, 0, Val_int(hdr->tx_id));
+ Store_field(ret, 1, Val_int(hdr->req_id));
+ Store_field(ret, 2, Val_int(hdr->type));
+ Store_field(ret, 3, Val_int(hdr->len));
+ CAMLreturn(ret);
+}
+
+CAMLprim value stub_string_of_header(value tid, value rid, value ty, value len)
+{
+ CAMLparam4(tid, rid, ty, len);
+ CAMLlocal1(ret);
+ struct xsd_sockmsg xsd = {
+ .type = Int_val(ty),
+ .tx_id = Int_val(tid),
+ .req_id = Int_val(rid),
+ .len = Int_val(len),
+ };
+
+ ret = caml_alloc_string(sizeof(struct xsd_sockmsg));
+ memcpy(String_val(ret), &xsd, sizeof(struct xsd_sockmsg));
+
+ CAMLreturn(ret);
+}
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xb/xs_ring.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xb/xs_ring.ml Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,18 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+external read: Mmap.mmap_interface -> string -> int -> int =
"ml_interface_read"
+external write: Mmap.mmap_interface -> string -> int -> int =
"ml_interface_write"
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xb/xs_ring_stubs.c
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xb/xs_ring_stubs.c Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,117 @@
+/*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ */
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <errno.h>
+#include <string.h>
+
+#define __XEN_TOOLS__
+
+#include <xenctrl.h>
+#define u32 uint32_t
+#include <xen/io/xs_wire.h>
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+
+#include "mmap_stubs.h"
+
+#define GET_C_STRUCT(a) ((struct mmap_interface *) a)
+
+#ifndef xen_mb
+#define xen_mb() mb()
+#endif
+
+static int xs_ring_read(struct mmap_interface *interface,
+ char *buffer, int len)
+{
+ struct xenstore_domain_interface *intf = interface->addr;
+ XENSTORE_RING_IDX cons, prod;
+ int to_read;
+
+ cons = intf->req_cons;
+ prod = intf->req_prod;
+ xen_mb();
+ if (prod == cons)
+ return 0;
+ if (MASK_XENSTORE_IDX(prod) > MASK_XENSTORE_IDX(cons))
+ to_read = prod - cons;
+ else
+ to_read = XENSTORE_RING_SIZE - MASK_XENSTORE_IDX(cons);
+ if (to_read < len)
+ len = to_read;
+ memcpy(buffer, intf->req + MASK_XENSTORE_IDX(cons), len);
+ xen_mb();
+ intf->req_cons += len;
+ return len;
+}
+
+static int xs_ring_write(struct mmap_interface *interface,
+ char *buffer, int len)
+{
+ struct xenstore_domain_interface *intf = interface->addr;
+ XENSTORE_RING_IDX cons, prod;
+ int can_write;
+
+ cons = intf->rsp_cons;
+ prod = intf->rsp_prod;
+ xen_mb();
+ if ( (prod - cons) >= XENSTORE_RING_SIZE )
+ return 0;
+ if (MASK_XENSTORE_IDX(prod) >= MASK_XENSTORE_IDX(cons))
+ can_write = XENSTORE_RING_SIZE - MASK_XENSTORE_IDX(prod);
+ else
+ can_write = MASK_XENSTORE_IDX(cons) - MASK_XENSTORE_IDX(prod);
+ if (can_write < len)
+ len = can_write;
+ memcpy(intf->rsp + MASK_XENSTORE_IDX(prod), buffer, len);
+ xen_mb();
+ intf->rsp_prod += len;
+ return len;
+}
+
+CAMLprim value ml_interface_read(value interface, value buffer, value len)
+{
+ CAMLparam3(interface, buffer, len);
+ CAMLlocal1(result);
+ int res;
+
+ res = xs_ring_read(GET_C_STRUCT(interface),
+ String_val(buffer), Int_val(len));
+ if (res == -1)
+ caml_failwith("huh");
+ result = Val_int(res);
+ CAMLreturn(result);
+}
+
+CAMLprim value ml_interface_write(value interface, value buffer, value len)
+{
+ CAMLparam3(interface, buffer, len);
+ CAMLlocal1(result);
+ int res;
+
+ res = xs_ring_write(GET_C_STRUCT(interface),
+ String_val(buffer), Int_val(len));
+ result = Val_int(res);
+ CAMLreturn(result);
+}
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xs/META.in
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xs/META.in Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,4 @@
+version = "@VERSION@"
+description = "XenStore Interface"
+archive(byte) = "xs.cma"
+archive(native) = "xs.cmxa"
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xs/Makefile
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xs/Makefile Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,42 @@
+TOPLEVEL=../..
+include $(TOPLEVEL)/common.make
+
+OCAMLINCLUDE += -I ../xb/
+
+.NOTPARALLEL:
+# Ocaml is such a PITA!
+
+PREINTF = xsraw.cmi xst.cmi
+PREOBJS = queueop xsraw xst
+PRELIBS = $(foreach obj, $(PREOBJS),$(obj).cmo) $(foreach
obj,$(PREOJBS),$(obj).cmx)
+OBJS = queueop xsraw xst xs
+INTF = xsraw.cmi xst.cmi xs.cmi
+LIBS = xs.cma xs.cmxa
+
+all: $(PREINTF) $(PRELIBS) $(INTF) $(LIBS) $(PROGRAMS)
+
+bins: $(PROGRAMS)
+
+libs: $(LIBS)
+
+xs_OBJS = $(OBJS)
+OCAML_NOC_LIBRARY = xs
+
+#xs.cmxa: $(foreach obj,$(OBJS),$(obj).cmx)
+# $(E) " MLLIB $@"
+# $(Q)$(OCAMLOPT) $(OCAMLOPTFLAGS) -a -o $@ $(foreach
obj,$(OBJS),$(obj).cmx)
+#
+#xs.cma: $(foreach obj,$(OBJS),$(obj).cmo)
+# $(E) " MLLIB $@"
+# $(Q)$(OCAMLC) -a -o $@ $(foreach obj,$(OBJS),$(obj).cmo)
+
+.PHONY: install
+install: $(LIBS) META
+ ocamlfind install -destdir $(DESTDIR)$(shell ocamlfind printconf
destdir) -ldconf ignore xs META $(INTF) xs.mli xst.mli xsraw.mli $(LIBS) *.a
*.cmx
+
+.PHONY: uninstall
+uninstall:
+ ocamlfind remove xs
+
+include $(TOPLEVEL)/Makefile.rules
+
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xs/queueop.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xs/queueop.ml Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,73 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+let data_concat ls = (String.concat "\000" ls) ^ "\000"
+let queue_path ty (tid: int) (path: string) con =
+ let data = data_concat [ path; ] in
+ Xb.queue con (Xb.Packet.create tid 0 ty data)
+
+(* operations *)
+let directory tid path con = queue_path Xb.Op.Directory tid path con
+let read tid path con = queue_path Xb.Op.Read tid path con
+
+let getperms tid path con = queue_path Xb.Op.Getperms tid path con
+
+let debug commands con =
+ Xb.queue con (Xb.Packet.create 0 0 Xb.Op.Debug (data_concat commands))
+
+let watch path data con =
+ let data = data_concat [ path; data; ] in
+ Xb.queue con (Xb.Packet.create 0 0 Xb.Op.Watch data)
+
+let unwatch path data con =
+ let data = data_concat [ path; data; ] in
+ Xb.queue con (Xb.Packet.create 0 0 Xb.Op.Unwatch data)
+
+let transaction_start con =
+ Xb.queue con (Xb.Packet.create 0 0 Xb.Op.Transaction_start (data_concat
[]))
+
+let transaction_end tid commit con =
+ let data = data_concat [ (if commit then "T" else "F"); ] in
+ Xb.queue con (Xb.Packet.create tid 0 Xb.Op.Transaction_end data)
+
+let introduce domid mfn port con =
+ let data = data_concat [ Printf.sprintf "%u" domid;
+ Printf.sprintf "%nu" mfn;
+ string_of_int port; ] in
+ Xb.queue con (Xb.Packet.create 0 0 Xb.Op.Introduce data)
+
+let release domid con =
+ let data = data_concat [ Printf.sprintf "%u" domid; ] in
+ Xb.queue con (Xb.Packet.create 0 0 Xb.Op.Release data)
+
+let resume domid con =
+ let data = data_concat [ Printf.sprintf "%u" domid; ] in
+ Xb.queue con (Xb.Packet.create 0 0 Xb.Op.Resume data)
+
+let getdomainpath domid con =
+ let data = data_concat [ Printf.sprintf "%u" domid; ] in
+ Xb.queue con (Xb.Packet.create 0 0 Xb.Op.Getdomainpath data)
+
+let write tid path value con =
+ let data = path ^ "\000" ^ value (* no NULL at the end *) in
+ Xb.queue con (Xb.Packet.create tid 0 Xb.Op.Write data)
+
+let mkdir tid path con = queue_path Xb.Op.Mkdir tid path con
+let rm tid path con = queue_path Xb.Op.Rm tid path con
+
+let setperms tid path perms con =
+ let data = data_concat [ path; perms ] in
+ Xb.queue con (Xb.Packet.create tid 0 Xb.Op.Setperms data)
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xs/xs.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xs/xs.ml Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,170 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type perms = Xsraw.perms
+type con = Xsraw.con
+type domid = int
+
+type xsh =
+{
+ con: con;
+ debug: string list -> string;
+ directory: string -> string list;
+ read: string -> string;
+ readv: string -> string list -> string list;
+ write: string -> string -> unit;
+ writev: string -> (string * string) list -> unit;
+ mkdir: string -> unit;
+ rm: string -> unit;
+ getperms: string -> perms;
+ setperms: string -> perms -> unit;
+ setpermsv: string -> string list -> perms -> unit;
+ introduce: domid -> nativeint -> int -> unit;
+ release: domid -> unit;
+ resume: domid -> unit;
+ getdomainpath: domid -> string;
+ watch: string -> string -> unit;
+ unwatch: string -> string -> unit;
+}
+
+let get_operations con = {
+ con = con;
+ debug = (fun commands -> Xsraw.debug commands con);
+ directory = (fun path -> Xsraw.directory 0 path con);
+ read = (fun path -> Xsraw.read 0 path con);
+ readv = (fun dir vec -> Xsraw.readv 0 dir vec con);
+ write = (fun path value -> Xsraw.write 0 path value con);
+ writev = (fun dir vec -> Xsraw.writev 0 dir vec con);
+ mkdir = (fun path -> Xsraw.mkdir 0 path con);
+ rm = (fun path -> Xsraw.rm 0 path con);
+ getperms = (fun path -> Xsraw.getperms 0 path con);
+ setperms = (fun path perms -> Xsraw.setperms 0 path perms con);
+ setpermsv = (fun dir vec perms -> Xsraw.setpermsv 0 dir vec perms con);
+ introduce = (fun id mfn port -> Xsraw.introduce id mfn port con);
+ release = (fun id -> Xsraw.release id con);
+ resume = (fun id -> Xsraw.resume id con);
+ getdomainpath = (fun id -> Xsraw.getdomainpath id con);
+ watch = (fun path data -> Xsraw.watch path data con);
+ unwatch = (fun path data -> Xsraw.unwatch path data con);
+}
+
+let transaction xsh = Xst.transaction xsh.con
+
+let has_watchevents xsh = Xsraw.has_watchevents xsh.con
+let get_watchevent xsh = Xsraw.get_watchevent xsh.con
+
+let read_watchevent xsh = Xsraw.read_watchevent xsh.con
+
+let make fd = get_operations (Xsraw.open_fd fd)
+let get_fd xsh = Xb.get_fd xsh.con.Xsraw.xb
+
+exception Timeout
+
+(* Should never be thrown, indicates a bug in the read_watchevent_timetout
function *)
+exception Timeout_with_nonempty_queue
+
+(* Just in case we screw up: poll the callback every couple of seconds rather
+ than wait for the whole timeout period *)
+let max_blocking_time = 5. (* seconds *)
+
+let read_watchevent_timeout xsh timeout callback =
+ let start_time = Unix.gettimeofday () in
+ let end_time = start_time +. timeout in
+
+ let left = ref timeout in
+
+ (* Returns true if a watch event in the queue satisfied us *)
+ let process_queued_events () =
+ let success = ref false in
+ while Xsraw.has_watchevents xsh.con && not(!success)
+ do
+ success := callback (Xsraw.get_watchevent xsh.con)
+ done;
+ !success in
+ (* Returns true if a watch event read from the socket satisfied us *)
+ let process_incoming_event () =
+ let fd = get_fd xsh in
+ let r, _, _ = Unix.select [ fd ] [] [] (min max_blocking_time
!left) in
+
+ (* If data is available for reading then read it *)
+ if r = []
+ then false (* timeout, either a max_blocking_time or global *)
+ else callback (Xsraw.read_watchevent xsh.con) in
+
+ let success = ref false in
+ while !left > 0. && not(!success)
+ do
+ (* NB the 'callback' might call back into Xs functions
+ and as a side-effect, watches might be queued. Hence
+ we must process the queue on every loop iteration *)
+
+ (* First process all queued watch events *)
+ if not(!success)
+ then success := process_queued_events ();
+ (* Then block for one more watch event *)
+ if not(!success)
+ then success := process_incoming_event ();
+ (* Just in case our callback caused events to be queued
+ and this is our last time round the loop: this prevents
+ us throwing the Timeout_with_nonempty_queue spuriously *)
+ if not(!success)
+ then success := process_queued_events ();
+
+ (* Update the time left *)
+ let current_time = Unix.gettimeofday () in
+ left := end_time -. current_time
+ done;
+ if not(!success) then begin
+ (* Sanity check: it should be impossible for any
+ events to be queued here *)
+ if Xsraw.has_watchevents xsh.con
+ then raise Timeout_with_nonempty_queue
+ else raise Timeout
+ end
+
+
+let monitor_paths xsh l time callback =
+ let unwatch () =
+ List.iter (fun (w,v) -> try xsh.unwatch w v with _ -> ()) l in
+ List.iter (fun (w,v) -> xsh.watch w v) l;
+ begin try
+ read_watchevent_timeout xsh time callback;
+ with
+ exn -> unwatch (); raise exn;
+ end;
+ unwatch ()
+
+let daemon_socket = "/var/run/xenstored/socket"
+
+(** Throws this rather than a miscellaneous Unix.connect failed *)
+exception Failed_to_connect
+
+let daemon_open () =
+ try
+ let sockaddr = Unix.ADDR_UNIX(daemon_socket) in
+ let sock = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
+ Unix.connect sock sockaddr;
+ Unix.set_close_on_exec sock;
+ make sock
+ with _ -> raise Failed_to_connect
+
+let domain_open () =
+ let path = "/proc/xen/xenbus" in
+ let fd = Unix.openfile path [ Unix.O_RDWR ] 0o550 in
+ Unix.set_close_on_exec fd;
+ make fd
+
+let close xsh = Xsraw.close xsh.con
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xs/xs.mli
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xs/xs.mli Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,90 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+exception Timeout
+
+(** Throws this rather than a miscellaneous Unix.connect failed *)
+exception Failed_to_connect
+
+(** perms contains 3 things:
+ - owner domid.
+ - other perm: applied to domain that is not owner or in ACL.
+ - ACL: list of per-domain permission
+ *)
+type perms = Xsraw.perms
+
+type domid = int
+type con
+
+type xsh = {
+ con : con;
+ debug: string list -> string;
+ directory : string -> string list;
+ read : string -> string;
+ readv : string -> string list -> string list;
+ write : string -> string -> unit;
+ writev : string -> (string * string) list -> unit;
+ mkdir : string -> unit;
+ rm : string -> unit;
+ getperms : string -> perms;
+ setperms : string -> perms -> unit;
+ setpermsv : string -> string list -> perms -> unit;
+ introduce : domid -> nativeint -> int -> unit;
+ release : domid -> unit;
+ resume : domid -> unit;
+ getdomainpath : domid -> string;
+ watch : string -> string -> unit;
+ unwatch : string -> string -> unit;
+}
+
+(** get operations provide a vector of xenstore function that apply to one
+ connection *)
+val get_operations : con -> xsh
+
+(** create a transaction with a vector of function that can be applied
+ into the transaction. *)
+val transaction : xsh -> (Xst.ops -> 'a) -> 'a
+
+(** watch manipulation on a connection *)
+val has_watchevents : xsh -> bool
+val get_watchevent : xsh -> string * string
+val read_watchevent : xsh -> string * string
+
+(** get_fd return the fd of the connection to be able to select on it.
+ NOTE: it works only for socket-based connection *)
+val get_fd : xsh -> Unix.file_descr
+
+(** wait for watchevent with a timeout. Until the callback return true,
+ every watch during the time specified, will be pass to the callback.
+ NOTE: it works only when use with a socket-based connection *)
+val read_watchevent_timeout : xsh -> float -> (string * string -> bool) -> unit
+
+(** register a set of watches, then wait for watchevent.
+ remove all watches previously set before giving back the hand. *)
+val monitor_paths : xsh
+ -> (string * string) list
+ -> float
+ -> (string * string -> bool)
+ -> unit
+
+(** open a socket-based xenstored connection *)
+val daemon_open : unit -> xsh
+
+(** open a mmap-based xenstored connection *)
+val domain_open : unit -> xsh
+
+(** close any xenstored connection *)
+val close : xsh -> unit
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xs/xsraw.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xs/xsraw.ml Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,265 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+exception Partial_not_empty
+exception Unexpected_packet of string
+
+(** Thrown when a path looks invalid e.g. if it contains "//" *)
+exception Invalid_path of string
+
+let unexpected_packet expected received =
+ let s = Printf.sprintf "expecting %s received %s"
+ (Xb.Op.to_string expected)
+ (Xb.Op.to_string received) in
+ raise (Unexpected_packet s)
+
+type con = {
+ xb: Xb.t;
+ watchevents: (string * string) Queue.t;
+}
+
+let close con =
+ Xb.close con.xb
+
+let open_fd fd = {
+ xb = Xb.open_fd fd;
+ watchevents = Queue.create ();
+}
+
+let rec split_string ?limit:(limit=(-1)) c s =
+ let i = try String.index s c with Not_found -> -1 in
+ let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in
+ if i = -1 || nlimit = 0 then
+ [ s ]
+ else
+ let a = String.sub s 0 i
+ and b = String.sub s (i + 1) (String.length s - i - 1) in
+ a :: (split_string ~limit: nlimit c b)
+
+type perm = PERM_NONE | PERM_READ | PERM_WRITE | PERM_RDWR
+
+type perms = int * perm * (int * perm) list
+
+let string_of_perms perms =
+ let owner, other, acl = perms in
+ let char_of_perm perm =
+ match perm with PERM_NONE -> 'n' | PERM_READ -> 'r'
+ | PERM_WRITE -> 'w' | PERM_RDWR -> 'b' in
+ let string_of_perm (id, perm) = Printf.sprintf "%c%u" (char_of_perm
perm) id in
+ String.concat "\000" (List.map string_of_perm ((owner,other) :: acl))
+
+let perms_of_string s =
+ let perm_of_char c =
+ match c with 'n' -> PERM_NONE | 'r' -> PERM_READ
+ | 'w' -> PERM_WRITE | 'b' -> PERM_RDWR
+ | c -> invalid_arg (Printf.sprintf "unknown
permission type: %c" c) in
+ let perm_of_string s =
+ if String.length s < 2
+ then invalid_arg (Printf.sprintf "perm of string: length = %d;
contents=\"%s\"" (String.length s) s)
+ else
+ begin
+ int_of_string (String.sub s 1 (String.length s - 1)),
+ perm_of_char s.[0]
+ end in
+ let rec split s =
+ try let i = String.index s '\000' in
+ String.sub s 0 i :: split (String.sub s (i + 1) (String.length
s - 1 - i))
+ with Not_found -> if s = "" then [] else [ s ] in
+ let l = List.map perm_of_string (split s) in
+ match l with h :: l -> (fst h, snd h, l) | [] -> (0, PERM_NONE, [])
+
+(* send one packet - can sleep *)
+let pkt_send con =
+ if Xb.has_old_output con.xb then
+ raise Partial_not_empty;
+ let workdone = ref false in
+ while not !workdone
+ do
+ workdone := Xb.output con.xb
+ done
+
+(* receive one packet - can sleep *)
+let pkt_recv con =
+ let workdone = ref false in
+ while not !workdone
+ do
+ workdone := Xb.input con.xb
+ done;
+ Xb.get_in_packet con.xb
+
+let pkt_recv_timeout con timeout =
+ let fd = Xb.get_fd con.xb in
+ let r, _, _ = Unix.select [ fd ] [] [] timeout in
+ if r = [] then
+ true, None
+ else (
+ let workdone = Xb.input con.xb in
+ if workdone then
+ false, (Some (Xb.get_in_packet con.xb))
+ else
+ false, None
+ )
+
+let queue_watchevent con data =
+ let ls = split_string ~limit:2 '\000' data in
+ if List.length ls != 2 then
+ raise (Xb.Packet.DataError "arguments number mismatch");
+ let event = List.nth ls 0
+ and event_data = List.nth ls 1 in
+ Queue.push (event, event_data) con.watchevents
+
+let has_watchevents con = Queue.length con.watchevents > 0
+let get_watchevent con = Queue.pop con.watchevents
+
+let read_watchevent con =
+ let pkt = pkt_recv con in
+ match Xb.Packet.get_ty pkt with
+ | Xb.Op.Watchevent ->
+ queue_watchevent con (Xb.Packet.get_data pkt);
+ Queue.pop con.watchevents
+ | ty -> unexpected_packet Xb.Op.Watchevent ty
+
+(* send one packet in the queue, and wait for reply *)
+let rec sync_recv ty con =
+ let pkt = pkt_recv con in
+ match Xb.Packet.get_ty pkt with
+ | Xb.Op.Error -> (
+ match Xb.Packet.get_data pkt with
+ | "ENOENT" -> raise Xb.Noent
+ | "EAGAIN" -> raise Xb.Eagain
+ | "EINVAL" -> raise Xb.Invalid
+ | s -> raise (Xb.Packet.Error s))
+ | Xb.Op.Watchevent ->
+ queue_watchevent con (Xb.Packet.get_data pkt);
+ sync_recv ty con
+ | rty when rty = ty -> Xb.Packet.get_data pkt
+ | rty -> unexpected_packet ty rty
+
+let sync f con =
+ (* queue a query using function f *)
+ f con.xb;
+ if Xb.output_len con.xb = 0 then
+ Printf.printf "output len = 0\n%!";
+ let ty = Xb.Packet.get_ty (Xb.peek_output con.xb) in
+ pkt_send con;
+ sync_recv ty con
+
+let ack s =
+ if s = "OK" then () else raise (Xb.Packet.DataError s)
+
+(** Check paths are suitable for read/write/mkdir/rm/directory etc (NOT
watches) *)
+let validate_path path =
+ (* Paths shouldn't have a "//" in the middle *)
+ let bad = "//" in
+ for offset = 0 to String.length path - (String.length bad) do
+ if String.sub path offset (String.length bad) = bad then
+ raise (Invalid_path path)
+ done;
+ (* Paths shouldn't have a "/" at the end, except for the root *)
+ if path <> "/" && path <> "" && path.[String.length path - 1] = '/' then
+ raise (Invalid_path path)
+
+(** Check to see if a path is suitable for watches *)
+let validate_watch_path path =
+ (* Check for stuff like @releaseDomain etc first *)
+ if path <> "" && path.[0] = '@' then ()
+ else validate_path path
+
+let debug command con =
+ sync (Queueop.debug command) con
+
+let directory tid path con =
+ validate_path path;
+ let data = sync (Queueop.directory tid path) con in
+ split_string '\000' data
+
+let read tid path con =
+ validate_path path;
+ sync (Queueop.read tid path) con
+
+let readv tid dir vec con =
+ List.map (fun path -> validate_path path; read tid path con)
+ (if dir <> "" then
+ (List.map (fun v -> dir ^ "/" ^ v) vec) else vec)
+
+let getperms tid path con =
+ validate_path path;
+ perms_of_string (sync (Queueop.getperms tid path) con)
+
+let watch path data con =
+ validate_watch_path path;
+ ack (sync (Queueop.watch path data) con)
+
+let unwatch path data con =
+ validate_watch_path path;
+ ack (sync (Queueop.unwatch path data) con)
+
+let transaction_start con =
+ let data = sync (Queueop.transaction_start) con in
+ try
+ int_of_string data
+ with
+ _ -> raise (Packet.DataError (Printf.sprintf "int expected; got
'%s'" data))
+
+let transaction_end tid commit con =
+ try
+ ack (sync (Queueop.transaction_end tid commit) con);
+ true
+ with
+ Xb.Eagain -> false
+
+let introduce domid mfn port con =
+ ack (sync (Queueop.introduce domid mfn port) con)
+
+let release domid con =
+ ack (sync (Queueop.release domid) con)
+
+let resume domid con =
+ ack (sync (Queueop.resume domid) con)
+
+let getdomainpath domid con =
+ sync (Queueop.getdomainpath domid) con
+
+let write tid path value con =
+ validate_path path;
+ ack (sync (Queueop.write tid path value) con)
+
+let writev tid dir vec con =
+ List.iter (fun (entry, value) ->
+ let path = (if dir <> "" then dir ^ "/" ^ entry else entry) in
+ validate_path path;
+ write tid path value con) vec
+
+let mkdir tid path con =
+ validate_path path;
+ ack (sync (Queueop.mkdir tid path) con)
+
+let rm tid path con =
+ validate_path path;
+ try
+ ack (sync (Queueop.rm tid path) con)
+ with
+ Xb.Noent -> ()
+
+let setperms tid path perms con =
+ validate_path path;
+ ack (sync (Queueop.setperms tid path (string_of_perms perms)) con)
+
+let setpermsv tid dir vec perms con =
+ List.iter (fun entry ->
+ let path = (if dir <> "" then dir ^ "/" ^ entry else entry) in
+ validate_path path;
+ setperms tid path perms con) vec
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xs/xsraw.mli
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xs/xsraw.mli Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,60 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+exception Partial_not_empty
+exception Unexpected_packet of string
+exception Invalid_path of string
+val unexpected_packet : Xb.Op.operation -> Xb.Op.operation -> 'a
+type con = { xb : Xb.t; watchevents : (string * string) Queue.t; }
+val close : con -> unit
+val open_fd : Unix.file_descr -> con
+val split_string : ?limit:int -> char -> string -> string list
+type perm = PERM_NONE | PERM_READ | PERM_WRITE | PERM_RDWR
+type perms = int * perm * (int * perm) list
+val string_of_perms : int * perm * (int * perm) list -> string
+val perms_of_string : string -> int * perm * (int * perm) list
+val pkt_send : con -> unit
+val pkt_recv : con -> Xb.Packet.t
+val pkt_recv_timeout : con -> float -> bool * Xb.Packet.t option
+val queue_watchevent : con -> string -> unit
+val has_watchevents : con -> bool
+val get_watchevent : con -> string * string
+val read_watchevent : con -> string * string
+val sync_recv : Xb.Op.operation -> con -> string
+val sync : (Xb.t -> 'a) -> con -> string
+val ack : string -> unit
+val validate_path : string -> unit
+val validate_watch_path : string -> unit
+val directory : int -> string -> con -> string list
+val debug : string list -> con -> string
+val read : int -> string -> con -> string
+val readv : int -> string -> string list -> con -> string list
+val getperms : int -> string -> con -> int * perm * (int * perm) list
+val watch : string -> string -> con -> unit
+val unwatch : string -> string -> con -> unit
+val transaction_start : con -> int
+val transaction_end : int -> bool -> con -> bool
+val introduce : int -> nativeint -> int -> con -> unit
+val release : int -> con -> unit
+val resume : int -> con -> unit
+val getdomainpath : int -> con -> string
+val write : int -> string -> string -> con -> unit
+val writev : int -> string -> (string * string) list -> con -> unit
+val mkdir : int -> string -> con -> unit
+val rm : int -> string -> con -> unit
+val setperms : int -> string -> int * perm * (int * perm) list -> con -> unit
+val setpermsv :
+ int ->
+ string -> string list -> int * perm * (int * perm) list -> con -> unit
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xs/xst.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xs/xst.ml Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,61 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type ops =
+{
+ directory: string -> string list;
+ read: string -> string;
+ readv: string -> string list -> string list;
+ write: string -> string -> unit;
+ writev: string -> (string * string) list -> unit;
+ mkdir: string -> unit;
+ rm: string -> unit;
+ getperms: string -> Xsraw.perms;
+ setperms: string -> Xsraw.perms -> unit;
+ setpermsv: string -> string list -> Xsraw.perms -> unit;
+}
+
+let get_operations tid xsh = {
+ directory = (fun path -> Xsraw.directory tid path xsh);
+ read = (fun path -> Xsraw.read tid path xsh);
+ readv = (fun dir vec -> Xsraw.readv tid dir vec xsh);
+ write = (fun path value -> Xsraw.write tid path value xsh);
+ writev = (fun dir vec -> Xsraw.writev tid dir vec xsh);
+ mkdir = (fun path -> Xsraw.mkdir tid path xsh);
+ rm = (fun path -> Xsraw.rm tid path xsh);
+ getperms = (fun path -> Xsraw.getperms tid path xsh);
+ setperms = (fun path perms -> Xsraw.setperms tid path perms xsh);
+ setpermsv = (fun dir vec perms -> Xsraw.setpermsv tid dir vec perms
xsh);
+}
+
+let transaction xsh (f: ops -> 'a) : 'a =
+ let commited = ref false and result = ref None in
+ while not !commited
+ do
+ let tid = Xsraw.transaction_start xsh in
+ let t = get_operations tid xsh in
+
+ begin try
+ result := Some (f t)
+ with exn ->
+ ignore (Xsraw.transaction_end tid false xsh);
+ raise exn
+ end;
+ commited := Xsraw.transaction_end tid true xsh
+ done;
+ match !result with
+ | None -> failwith "internal error in transaction"
+ | Some result -> result
diff -r 08aa6b3afaf2 -r 755c87a78ecb tools/ocaml/libs/xs/xst.mli
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xs/xst.mli Thu May 06 11:02:54 2010 +0100
@@ -0,0 +1,30 @@
+(*
+ * Copyright (C) 2006-2007 XenSource Ltd.
+ * Copyright (C) 2008 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@xxxxxxxxxxxxx>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+type ops = {
+ directory : string -> string list;
+ read : string -> string;
+ readv : string -> string list -> string list;
+ write : string -> string -> unit;
+ writev : string -> (string * string) list -> unit;
+ mkdir : string -> unit;
+ rm : string -> unit;
+ getperms : string -> Xsraw.perms;
+ setperms : string -> Xsraw.perms -> unit;
+ setpermsv : string -> string list -> Xsraw.perms -> unit;
+}
+
+val get_operations : int -> Xsraw.con -> ops
+val transaction : Xsraw.con -> (ops -> 'a) -> 'a
_______________________________________________
Xen-changelog mailing list
Xen-changelog@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/xen-changelog
|
Home