xen-project/xen
1
0 Fork 1
mirror of https://github.com/xen-project/xen.git synced 2026-10-29 10:40:03 +01:00
Code Issues Activity

tools/ocaml: Rename the ocaml libraries

Browse Source 
ocamlfind does not support namespaces, so to avoid
name clashes the module names have become longer.
Additionally, the xenstore and xenbus subdirs, which
contain several modules each, have been packed into
toplevel Xenstore and Xenbus modules.

xb becomes xenbus, xc becomes xenctrl, xl becomes xenlight,
xs becomes xenstore, eventchn becomes xeneventchn and
mmap becomes xenmmap.

[ Patch modified from that submitted, to update the .hgignore, and to
  cope with intervening changes to mmap_stubs.c -iwj ]

Signed-off-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Ian Jackson <ian.jackson@eu.citrix.com>
Committed-by: Ian Jackson <ian.jackson@eu.citrix.com>
This commit is contained in:
Jon Ludlam committed 2011-10-10 16:37:07 +01:00
1 parent df0c75a05f
commit 7ceaa0c744
44 files changed
+321 -279
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

.hgignore
+2 -2
View File
@@ -301,8 +301,8 @@
^tools/ocaml/libs/xl/_libxl_types\.ml\.in$
^tools/ocaml/libs/xl/_libxl_types\.mli\.in$
^tools/ocaml/libs/xl/_libxl_types\.inc$
^tools/ocaml/libs/xl/xl\.ml$
^tools/ocaml/libs/xl/xl\.mli$
^tools/ocaml/libs/xl/xenlight\.ml$
^tools/ocaml/libs/xl/xenlight\.mli$
^tools/ocaml/xenstored/oxenstored$
^xen/\.banner.*$
^xen/BLOG$
tools/ocaml/libs/eventchn/META.in
+2 -2
View File
@@ -1,5 +1,5 @@
version = "@VERSION@"
description = "Eventchn interface extension"
requires = "unix"
archive(byte) = "eventchn.cma"
archive(native) = "eventchn.cmxa"
archive(byte) = "xeneventchn.cma"
archive(native) = "xeneventchn.cmxa"
tools/ocaml/libs/eventchn/Makefile
+9 -9
View File
@@ -4,11 +4,11 @@ include $(TOPLEVEL)/common.make
CFLAGS += $(CFLAGS_libxenctrl) $(CFLAGS_xeninclude)
OBJS = eventchn
OBJS = xeneventchn
INTF = $(foreach obj, $(OBJS),$(obj).cmi)
LIBS = eventchn.cma eventchn.cmxa
LIBS = xeneventchn.cma xeneventchn.cmxa
LIBS_evtchn = $(LDLIBS_libxenctrl)
LIBS_xeneventchn = $(LDLIBS_libxenctrl)
all: $(INTF) $(LIBS) $(PROGRAMS)
@@ -16,20 +16,20 @@ bins: $(PROGRAMS)
libs: $(LIBS)
eventchn_OBJS = $(OBJS)
eventchn_C_OBJS = eventchn_stubs
xeneventchn_OBJS = $(OBJS)
xeneventchn_C_OBJS = xeneventchn_stubs
OCAML_LIBRARY = eventchn
OCAML_LIBRARY = xeneventchn
.PHONY: install
install: $(LIBS) META
mkdir -p $(OCAMLDESTDIR)
ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore eventchn META $(INTF) $(LIBS) *.a *.so *.cmx
ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xeneventchn META $(INTF) $(LIBS) *.a *.so *.cmx
.PHONY: uninstall
uninstall:
ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn
ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn
include $(TOPLEVEL)/Makefile.rules
tools/ocaml/libs/eventchn/eventchn.ml → tools/ocaml/libs/eventchn/xeneventchn.ml
View File
File renamed without changes.
tools/ocaml/libs/eventchn/eventchn.mli → tools/ocaml/libs/eventchn/xeneventchn.mli
View File
File renamed without changes.
tools/ocaml/libs/eventchn/eventchn_stubs.c → tools/ocaml/libs/eventchn/xeneventchn_stubs.c
View File
File renamed without changes.
tools/ocaml/libs/mmap/META.in
+2 -2
View File
@@ -1,4 +1,4 @@
version = "@VERSION@"
description = "Mmap interface extension"
archive(byte) = "mmap.cma"
archive(native) = "mmap.cmxa"
archive(byte) = "xenmmap.cma"
archive(native) = "xenmmap.cmxa"
tools/ocaml/libs/mmap/Makefile
+8 -8
View File
@@ -2,9 +2,9 @@ TOPLEVEL=$(CURDIR)/../..
XEN_ROOT=$(TOPLEVEL)/../..
include $(TOPLEVEL)/common.make
OBJS = mmap
OBJS = xenmmap
INTF = $(foreach obj, $(OBJS),$(obj).cmi)
LIBS = mmap.cma mmap.cmxa
LIBS = xenmmap.cma xenmmap.cmxa
all: $(INTF) $(LIBS) $(PROGRAMS)
@@ -12,19 +12,19 @@ bins: $(PROGRAMS)
libs: $(LIBS)
mmap_OBJS = $(OBJS)
mmap_C_OBJS = mmap_stubs
OCAML_LIBRARY = mmap
xenmmap_OBJS = $(OBJS)
xenmmap_C_OBJS = xenmmap_stubs
OCAML_LIBRARY = xenmmap
.PHONY: install
install: $(LIBS) META
mkdir -p $(OCAMLDESTDIR)
ocamlfind remove -destdir $(OCAMLDESTDIR) mmap
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore mmap META $(INTF) $(LIBS) *.a *.so *.cmx
ocamlfind remove -destdir $(OCAMLDESTDIR) xenmmap
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenmmap META $(INTF) $(LIBS) *.a *.so *.cmx
.PHONY: uninstall
uninstall:
ocamlfind remove -destdir $(OCAMLDESTDIR) mmap
ocamlfind remove -destdir $(OCAMLDESTDIR) xenmmap
include $(TOPLEVEL)/Makefile.rules
tools/ocaml/libs/mmap/mmap.ml → tools/ocaml/libs/mmap/xenmmap.ml
View File
File renamed without changes.
tools/ocaml/libs/mmap/mmap.mli → tools/ocaml/libs/mmap/xenmmap.mli
View File
File renamed without changes.
tools/ocaml/libs/mmap/mmap_stubs.c → tools/ocaml/libs/mmap/xenmmap_stubs.c
View File
File renamed without changes.
tools/ocaml/libs/xb/META.in
+3 -3
View File
@@ -1,5 +1,5 @@
version = "@VERSION@"
description = "XenBus Interface"
requires = "unix,mmap"
archive(byte) = "xb.cma"
archive(native) = "xb.cmxa"
requires = "unix,xenmmap"
archive(byte) = "xenbus.cma"
archive(native) = "xenbus.cmxa"
tools/ocaml/libs/xb/Makefile
+17 -8
View File
@@ -6,6 +6,7 @@ CFLAGS += -I../mmap
CFLAGS += $(CFLAGS_libxenctrl) # For xen_mb()
CFLAGS += $(CFLAGS_xeninclude)
OCAMLINCLUDE += -I ../mmap
OCAMLOPTFLAGS += -for-pack Xenbus
.NOTPARALLEL:
# Ocaml is such a PITA!
@@ -15,7 +16,7 @@ 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
LIBS = xenbus.cma xenbus.cmxa
ALL_OCAML_OBJS = $(OBJS) $(PREOJBS)
@@ -25,22 +26,30 @@ bins: $(PROGRAMS)
libs: $(LIBS)
xb_OBJS = $(OBJS)
xb_C_OBJS = xs_ring_stubs xb_stubs
OCAML_LIBRARY = xb
xenbus_OBJS = xenbus
xenbus_C_OBJS = xs_ring_stubs xenbus_stubs
OCAML_LIBRARY = xenbus
xenbus.cmx : $(foreach obj, $(OBJS), $(obj).cmx)
$(E) " CMX $@"
$(OCAMLOPT) -pack -o $@ $^
xenbus.cmo : $(foreach obj, $(OBJS), $(obj).cmo)
$(E) " CMO $@"
$(OCAMLC) -pack -o $@ $^
%.mli: %.ml
$(E) " MLI $@"
$(Q)$(OCAMLC) -i $< $o
$(Q)$(OCAMLC) $(OCAMLINCLUDE) -i $< $o
.PHONY: install
install: $(LIBS) META
mkdir -p $(OCAMLDESTDIR)
ocamlfind remove -destdir $(OCAMLDESTDIR) xb
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xb META $(INTF) $(LIBS) *.a *.so *.cmx
ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenbus META $(LIBS) xenbus.cmo xenbus.cmi xenbus.cmx *.a *.so
.PHONY: uninstall
uninstall:
ocamlfind remove -destdir $(OCAMLDESTDIR) xb
ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus
include $(TOPLEVEL)/Makefile.rules
tools/ocaml/libs/xb/xb.ml
+10 -10
View File
@@ -24,7 +24,7 @@ exception Invalid
type backend_mmap =
{
mmap: Mmap.mmap_interface; (* mmaped interface = xs_ring *)
mmap: Xenmmap.mmap_interface; (* mmaped interface = xs_ring *)
eventchn_notify: unit -> unit; (* function to notify through eventchn *)
mutable work_again: bool;
}
@@ -34,7 +34,7 @@ type backend_fd =
fd: Unix.file_descr;
}
type backend = Fd of backend_fd | Mmap of backend_mmap
type backend = Fd of backend_fd | Xenmmap of backend_mmap
type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * string
@@ -68,7 +68,7 @@ let read_mmap back con s len =
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
| Xenmmap backmmap -> read_mmap backmmap con s len
let write_fd back con s len =
Unix.write back.fd s 0 len
@@ -82,7 +82,7 @@ let write_mmap back con s len =
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
| Xenmmap backmmap -> write_mmap backmmap con s len
let output con =
(* get the output string from a string_of(packet) or partial_out *)
@@ -145,7 +145,7 @@ let newcon backend = {
let open_fd fd = newcon (Fd { fd = fd; })
let open_mmap mmap notifyfct =
newcon (Mmap {
newcon (Xenmmap {
mmap = mmap;
eventchn_notify = notifyfct;
work_again = false; })
@@ -153,12 +153,12 @@ let open_mmap mmap notifyfct =
let close con =
match con.backend with
| Fd backend -> Unix.close backend.fd
| Mmap backend -> Mmap.unmap backend.mmap
| Xenmmap backend -> Xenmmap.unmap backend.mmap
let is_fd con =
match con.backend with
| Fd _ -> true
| Mmap _ -> false
| Xenmmap _ -> false
let is_mmap con = not (is_fd con)
@@ -176,14 +176,14 @@ 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
| Xenmmap backend -> backend.work_again
let is_selectable con =
match con.backend with
| Fd _ -> true
| Mmap _ -> false
| Xenmmap _ -> false
let get_fd con =
match con.backend with
| Fd backend -> backend.fd
| Mmap _ -> raise (Failure "get_fd")
| Xenmmap _ -> raise (Failure "get_fd")
tools/ocaml/libs/xb/xb.mli
+81 -61
View File
@@ -1,83 +1,103 @@
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
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 operation_c_mapping : operation array
val size : int
val offset_pq : int
val operation_c_mapping_pq : 'a array
val size_pq : int
val array_search : 'a -> 'a array -> int
val of_cval : int -> operation
val to_cval : operation -> int
val to_string : operation -> string
end
module Packet :
sig
type t =
Packet.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"
val create : int -> int -> Op.operation -> string -> t
val of_partialpkt : Partial.pkt -> t
val to_string : t -> string
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 *)
type backend_mmap = {
mmap : Xenmmap.mmap_interface;
eventchn_notify : unit -> unit;
mutable work_again : bool;
}
type backend_fd = { fd : Unix.file_descr; }
type backend = Fd of backend_fd | Xenmmap 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;
}
val init_partial_in : unit -> partial_buf
val queue : t -> Packet.t -> unit
(** process the output queue, return if a packet has been totally sent *)
val read_fd : backend_fd -> 'a -> string -> int -> int
val read_mmap : backend_mmap -> 'a -> string -> int -> int
val read : t -> string -> int -> int
val write_fd : backend_fd -> 'a -> string -> int -> int
val write_mmap : backend_mmap -> 'a -> string -> int -> int
val write : t -> string -> int -> int
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 newcon : backend -> t
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 open_mmap : Xenmmap.mmap_interface -> (unit -> unit) -> t
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
tools/ocaml/libs/xb/xb_stubs.c → tools/ocaml/libs/xb/xenbus_stubs.c
View File
File renamed without changes.
tools/ocaml/libs/xb/xs_ring.ml
+2 -2
View File
@@ -14,5 +14,5 @@
* 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"
external read: Xenmmap.mmap_interface -> string -> int -> int = "ml_interface_read"
external write: Xenmmap.mmap_interface -> string -> int -> int = "ml_interface_write"
tools/ocaml/libs/xc/META.in
+3 -3
View File
@@ -1,5 +1,5 @@
version = "@VERSION@"
description = "Xen Control Interface"
requires = "mmap,uuid"
archive(byte) = "xc.cma"
archive(native) = "xc.cmxa"
requires = "xenmmap,uuid"
archive(byte) = "xenctrl.cma"
archive(native) = "xenctrl.cmxa"
tools/ocaml/libs/xc/Makefile
+10 -10
View File
@@ -5,16 +5,16 @@ include $(TOPLEVEL)/common.make
CFLAGS += -I../mmap $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest)
OCAMLINCLUDE += -I ../mmap -I ../uuid
OBJS = xc
INTF = xc.cmi
LIBS = xc.cma xc.cmxa
OBJS = xenctrl
INTF = xenctrl.cmi
LIBS = xenctrl.cma xenctrl.cmxa
LIBS_xc = $(LDLIBS_libxenctrl) $(LDLIBS_libxenguest)
LIBS_xenctrl = $(LDLIBS_libxenctrl) $(LDLIBS_libxenguest)
xc_OBJS = $(OBJS)
xc_C_OBJS = xc_stubs
xenctrl_OBJS = $(OBJS)
xenctrl_C_OBJS = xenctrl_stubs
OCAML_LIBRARY = xc
OCAML_LIBRARY = xenctrl
all: $(INTF) $(LIBS)
@@ -23,11 +23,11 @@ libs: $(LIBS)
.PHONY: install
install: $(LIBS) META
mkdir -p $(OCAMLDESTDIR)
ocamlfind remove -destdir $(OCAMLDESTDIR) xc
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xc META $(INTF) $(LIBS) *.a *.so *.cmx
ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenctrl META $(INTF) $(LIBS) *.a *.so *.cmx
.PHONY: uninstall
uninstall:
ocamlfind remove -destdir $(OCAMLDESTDIR) xc
ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl
include $(TOPLEVEL)/Makefile.rules
tools/ocaml/libs/xc/xc.ml → tools/ocaml/libs/xc/xenctrl.ml
+4 -4
View File
@@ -214,7 +214,7 @@ external cpuid_check: handle -> (int64 * (int64 option)) -> string option array
= "stub_xc_cpuid_check"
external map_foreign_range: handle -> domid -> int
-> nativeint -> Mmap.mmap_interface
-> nativeint -> Xenmmap.mmap_interface
= "stub_map_foreign_range"
external domain_get_pfn_list: handle -> domid -> nativeint -> nativeint array
@@ -306,12 +306,12 @@ let coredump xch domid fd =
if Array.length pfns <> Nativeint.to_int nrpages then
failwith "could not get the page frame list";
let page_size = Mmap.getpagesize () in
let page_size = Xenmmap.getpagesize () in
for i = 0 to Nativeint.to_int nrpages - 1
do
let page = map_foreign_range xch domid page_size pfns.(i) in
let data = Mmap.read page 0 page_size in
Mmap.unmap page;
let data = Xenmmap.read page 0 page_size in
Xenmmap.unmap page;
dump data
done
tools/ocaml/libs/xc/xc.mli → tools/ocaml/libs/xc/xenctrl.mli
+1 -1
View File
@@ -132,7 +132,7 @@ external domain_memory_increase_reservation :
handle -> domid -> int64 -> unit
= "stub_xc_domain_memory_increase_reservation"
external map_foreign_range :
handle -> domid -> int -> nativeint -> Mmap.mmap_interface
handle -> domid -> int -> nativeint -> Xenmmap.mmap_interface
= "stub_map_foreign_range"
external domain_get_pfn_list :
handle -> domid -> nativeint -> nativeint array
tools/ocaml/libs/xc/xc_stubs.c → tools/ocaml/libs/xc/xenctrl_stubs.c
View File
File renamed without changes.
tools/ocaml/libs/xl/Makefile
+19 -19
View File
@@ -6,44 +6,44 @@ include $(TOPLEVEL)/common.make
CFLAGS += -Wno-unused
CFLAGS += $(CFLAGS_libxenlight)
OBJS = xl
INTF = xl.cmi
LIBS = xl.cma xl.cmxa
OBJS = xenlight
INTF = xenlight.cmi
LIBS = xenlight.cma xenlight.cmxa
LIBS_xl = $(LDLIBS_libxenlight)
LIBS_xenlight = $(LDLIBS_libxenlight)
xl_OBJS = $(OBJS)
xl_C_OBJS = xl_stubs
xenlight_OBJS = $(OBJS)
xenlight_C_OBJS = xenlight_stubs
OCAML_LIBRARY = xl
OCAML_LIBRARY = xenlight
GENERATED_FILES += xl.ml xl.ml.tmp xl.mli xl.mli.tmp
GENERATED_FILES += xenlight.ml xenlight.ml.tmp xenlight.mli xenlight.mli.tmp
GENERATED_FILES += _libxl_types.ml.in _libxl_types.mli.in
GENERATED_FILES += _libxl_types.inc
all: $(INTF) $(LIBS)
xl.ml: xl.ml.in _libxl_types.ml.in
xenlight.ml: xenlight.ml.in _libxl_types.ml.in
$(Q)sed -e '1i\
(*\
* AUTO-GENERATED FILE DO NOT EDIT\
* Generated from xl.ml.in and _libxl_types.ml.in\
* Generated from xenlight.ml.in and _libxl_types.ml.in\
*)\
' \
-e '/^(\* @@LIBXL_TYPES@@ \*)$$/r_libxl_types.ml.in' \
< xl.ml.in > xl.ml.tmp
$(Q)mv xl.ml.tmp xl.ml
< xenlight.ml.in > xenlight.ml.tmp
$(Q)mv xenlight.ml.tmp xenlight.ml
xl.mli: xl.mli.in _libxl_types.mli.in
xenlight.mli: xenlight.mli.in _libxl_types.mli.in
$(Q)sed -e '1i\
(*\
* AUTO-GENERATED FILE DO NOT EDIT\
* Generated from xl.mli.in and _libxl_types.mli.in\
* Generated from xenlight.mli.in and _libxl_types.mli.in\
*)\
' \
-e '/^(\* @@LIBXL_TYPES@@ \*)$$/r_libxl_types.mli.in' \
< xl.mli.in > xl.mli.tmp
$(Q)mv xl.mli.tmp xl.mli
< xenlight.mli.in > xenlight.mli.tmp
$(Q)mv xenlight.mli.tmp xenlight.mli
_libxl_types.ml.in _libxl_types.mli.in _libxl_types.inc: genwrap.py $(XEN_ROOT)/tools/libxl/libxl_types.idl \
$(XEN_ROOT)/tools/libxl/libxltypes.py
@@ -56,11 +56,11 @@ libs: $(LIBS)
.PHONY: install
install: $(LIBS) META
mkdir -p $(OCAMLDESTDIR)
ocamlfind remove -destdir $(OCAMLDESTDIR) xl
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xl META $(INTF) $(LIBS) *.a *.so *.cmx
ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenlight META $(INTF) $(LIBS) *.a *.so *.cmx
.PHONY: uninstall
uninstall:
ocamlfind remove -destdir $(OCAMLDESTDIR) xl
ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight
include $(TOPLEVEL)/Makefile.rules
tools/ocaml/libs/xl/xl.ml.in → tools/ocaml/libs/xl/xenlight.ml.in
View File
File renamed without changes.
tools/ocaml/libs/xl/xl.mli.in → tools/ocaml/libs/xl/xenlight.mli.in
View File
File renamed without changes.
tools/ocaml/libs/xl/xl_stubs.c → tools/ocaml/libs/xl/xenlight_stubs.c
View File
File renamed without changes.
tools/ocaml/libs/xs/META.in
+3 -3
View File
@@ -1,5 +1,5 @@
version = "@VERSION@"
description = "XenStore Interface"
requires = "unix,xb"
archive(byte) = "xs.cma"
archive(native) = "xs.cmxa"
requires = "unix,xenbus"
archive(byte) = "xenstore.cma"
archive(native) = "xenstore.cmxa"
tools/ocaml/libs/xs/Makefile
+16 -6
View File
@@ -3,6 +3,7 @@ XEN_ROOT=$(TOPLEVEL)/../..
include $(TOPLEVEL)/common.make
OCAMLINCLUDE += -I ../xb/
OCAMLOPTFLAGS += -for-pack Xenstore
.NOTPARALLEL:
# Ocaml is such a PITA!
@@ -12,7 +13,7 @@ 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
LIBS = xenstore.cma xenstore.cmxa
all: $(PREINTF) $(PRELIBS) $(INTF) $(LIBS) $(PROGRAMS)
@@ -20,18 +21,27 @@ bins: $(PROGRAMS)
libs: $(LIBS)
xs_OBJS = $(OBJS)
OCAML_NOC_LIBRARY = xs
xenstore_OBJS = xenstore
OCAML_NOC_LIBRARY = xenstore
xenstore.cmx : $(foreach obj, $(OBJS), $(obj).cmx)
$(E) " CMX $@"
$(Q)$(OCAMLOPT) -pack -o $@ $^
xenstore.cmo : $(foreach obj, $(OBJS), $(obj).cmo)
$(E) " CMO $@"
$(Q)$(OCAMLC) -pack -o $@ $^
.PHONY: install
install: $(LIBS) META
mkdir -p $(OCAMLDESTDIR)
ocamlfind remove -destdir $(OCAMLDESTDIR) xs
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xs META $(INTF) xs.mli xst.mli xsraw.mli $(LIBS) *.a *.cmx
ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore
ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenstore META $(LIBS) xenstore.cmo xenstore.cmi xenstore.cmx *.a
.PHONY: uninstall
uninstall:
ocamlfind remove -destdir $(OCAMLDESTDIR) xs
ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore
include $(TOPLEVEL)/Makefile.rules
tools/ocaml/libs/xs/queueop.ml
+1
View File
@@ -13,6 +13,7 @@
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*)
open Xenbus
let data_concat ls = (String.concat "\000" ls) ^ "\000"
let queue_path ty (tid: int) (path: string) con =
tools/ocaml/libs/xs/xs.ml
+1 -1
View File
@@ -69,7 +69,7 @@ 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
let get_fd xsh = Xenbus.Xb.get_fd xsh.con.Xsraw.xb
exception Timeout
tools/ocaml/libs/xs/xsraw.ml
+3 -1
View File
@@ -14,6 +14,8 @@
* GNU Lesser General Public License for more details.
*)
open Xenbus
exception Partial_not_empty
exception Unexpected_packet of string
@@ -27,7 +29,7 @@ let unexpected_packet expected received =
raise (Unexpected_packet s)
type con = {
xb: Xb.t;
xb: Xenbus.Xb.t;
watchevents: (string * string) Queue.t;
}
tools/ocaml/libs/xs/xsraw.mli
+6 -6
View File
@@ -16,8 +16,8 @@
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 unexpected_packet : Xenbus.Xb.Op.operation -> Xenbus.Xb.Op.operation -> 'a
type con = { xb : Xenbus.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
@@ -26,14 +26,14 @@ 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 pkt_recv : con -> Xenbus.Xb.Packet.t
val pkt_recv_timeout : con -> float -> bool * Xenbus.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 sync_recv : Xenbus.Xb.Op.operation -> con -> string
val sync : (Xenbus.Xb.t -> 'a) -> con -> string
val ack : string -> unit
val validate_path : string -> unit
val validate_watch_path : string -> unit
tools/ocaml/xenstored/Makefile
+4 -4
View File
@@ -35,11 +35,11 @@ INTF = symbol.cmi trie.cmi
XENSTOREDLIBS = \
unix.cmxa \
$(OCAML_TOPLEVEL)/libs/uuid/uuid.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/mmap.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/xenmmap.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/eventchn.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xc.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xb.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/xeneventchn.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xenctrl.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xenbus.cmxa \
-ccopt -L -ccopt $(XEN_ROOT)/tools/libxc
PROGRAMS = oxenstored
tools/ocaml/xenstored/connection.ml
+15 -15
View File
@@ -27,7 +27,7 @@ type watch = {
}
and t = {
xb: Xb.t;
xb: Xenbus.Xb.t;
dom: Domain.t option;
transactions: (int, Transaction.t) Hashtbl.t;
mutable next_tid: int;
@@ -93,10 +93,10 @@ let create xbcon dom =
Logging.new_connection ~tid:Transaction.none ~con:(get_domstr con);
con
let get_fd con = Xb.get_fd con.xb
let get_fd con = Xenbus.Xb.get_fd con.xb
let close con =
Logging.end_connection ~tid:Transaction.none ~con:(get_domstr con);
Xb.close con.xb
Xenbus.Xb.close con.xb
let get_perm con =
con.perm
@@ -108,9 +108,9 @@ let set_target con target_domid =
con.perm <- Perms.Connection.set_target (get_perm con) ~perms:[Perms.READ; Perms.WRITE] target_domid
let send_reply con tid rid ty data =
Xb.queue con.xb (Xb.Packet.create tid rid ty data)
Xenbus.Xb.queue con.xb (Xenbus.Xb.Packet.create tid rid ty data)
let send_error con tid rid err = send_reply con tid rid Xb.Op.Error (err ^ "\000")
let send_error con tid rid err = send_reply con tid rid Xenbus.Xb.Op.Error (err ^ "\000")
let send_ack con tid rid ty = send_reply con tid rid ty "OK\000"
let get_watch_path con path =
@@ -166,7 +166,7 @@ let list_watches con =
let fire_single_watch watch =
let data = Utils.join_by_null [watch.path; watch.token; ""] in
send_reply watch.con Transaction.none 0 Xb.Op.Watchevent data
send_reply watch.con Transaction.none 0 Xenbus.Xb.Op.Watchevent data
let fire_watch watch path =
let new_path =
@@ -179,7 +179,7 @@ let fire_watch watch path =
path
in
let data = Utils.join_by_null [ new_path; watch.token; "" ] in
send_reply watch.con Transaction.none 0 Xb.Op.Watchevent data
send_reply watch.con Transaction.none 0 Xenbus.Xb.Op.Watchevent data
let find_next_tid con =
let ret = con.next_tid in con.next_tid <- con.next_tid + 1; ret
@@ -203,15 +203,15 @@ let end_transaction con tid commit =
let get_transaction con tid =
Hashtbl.find con.transactions tid
let do_input con = Xb.input con.xb
let has_input con = Xb.has_in_packet con.xb
let pop_in con = Xb.get_in_packet con.xb
let has_more_input con = Xb.has_more_input con.xb
let do_input con = Xenbus.Xb.input con.xb
let has_input con = Xenbus.Xb.has_in_packet con.xb
let pop_in con = Xenbus.Xb.get_in_packet con.xb
let has_more_input con = Xenbus.Xb.has_more_input con.xb
let has_output con = Xb.has_output con.xb
let has_new_output con = Xb.has_new_output con.xb
let peek_output con = Xb.peek_output con.xb
let do_output con = Xb.output con.xb
let has_output con = Xenbus.Xb.has_output con.xb
let has_new_output con = Xenbus.Xb.has_new_output con.xb
let peek_output con = Xenbus.Xb.peek_output con.xb
let do_output con = Xenbus.Xb.output con.xb
let incr_ops con = con.stat_nb_ops <- con.stat_nb_ops + 1
tools/ocaml/xenstored/connections.ml
+2 -2
View File
@@ -26,12 +26,12 @@ type t = {
let create () = { anonymous = []; domains = Hashtbl.create 8; watches = Trie.create () }
let add_anonymous cons fd can_write =
let xbcon = Xb.open_fd fd in
let xbcon = Xenbus.Xb.open_fd fd in
let con = Connection.create xbcon None in
cons.anonymous <- con :: cons.anonymous
let add_domain cons dom =
let xbcon = Xb.open_mmap (Domain.get_interface dom) (fun () -> Domain.notify dom) in
let xbcon = Xenbus.Xb.open_mmap (Domain.get_interface dom) (fun () -> Domain.notify dom) in
let con = Connection.create xbcon (Some dom) in
Hashtbl.add cons.domains (Domain.get_id dom) con
tools/ocaml/xenstored/domain.ml
+3 -3
View File
@@ -20,10 +20,10 @@ let debug fmt = Logs.debug "general" fmt
type t =
{
id: Xc.domid;
id: Xenctrl.domid;
mfn: nativeint;
remote_port: int;
interface: Mmap.mmap_interface;
interface: Xenmmap.mmap_interface;
eventchn: Event.t;
mutable port: int;
}
@@ -47,7 +47,7 @@ let bind_interdomain dom =
let close dom =
debug "domain %d unbound port %d" dom.id dom.port;
Event.unbind dom.eventchn dom.port;
Mmap.unmap dom.interface;
Xenmmap.unmap dom.interface;
()
let make id mfn remote_port interface eventchn = {
tools/ocaml/xenstored/domains.ml
+10 -10
View File
@@ -16,7 +16,7 @@
type domains = {
eventchn: Event.t;
table: (Xc.domid, Domain.t) Hashtbl.t;
table: (Xenctrl.domid, Domain.t) Hashtbl.t;
}
let init eventchn =
@@ -33,16 +33,16 @@ let cleanup xc doms =
Hashtbl.iter (fun id _ -> if id <> 0 then
try
let info = Xc.domain_getinfo xc id in
if info.Xc.shutdown || info.Xc.dying then (
let info = Xenctrl.domain_getinfo xc id in
if info.Xenctrl.shutdown || info.Xenctrl.dying then (
Logs.debug "general" "Domain %u died (dying=%b, shutdown %b -- code %d)"
id info.Xc.dying info.Xc.shutdown info.Xc.shutdown_code;
if info.Xc.dying then
id info.Xenctrl.dying info.Xenctrl.shutdown info.Xenctrl.shutdown_code;
if info.Xenctrl.dying then
dead_dom := id :: !dead_dom
else
notify := true;
)
with Xc.Error _ ->
with Xenctrl.Error _ ->
Logs.debug "general" "Domain %u died -- no domain info" id;
dead_dom := id :: !dead_dom;
) doms.table;
@@ -57,7 +57,7 @@ let resume doms domid =
()
let create xc doms domid mfn port =
let interface = Xc.map_foreign_range xc domid (Mmap.getpagesize()) mfn in
let interface = Xenctrl.map_foreign_range xc domid (Xenmmap.getpagesize()) mfn in
let dom = Domain.make domid mfn port interface doms.eventchn in
Hashtbl.add doms.table domid dom;
Domain.bind_interdomain dom;
@@ -66,13 +66,13 @@ let create xc doms domid mfn port =
let create0 fake doms =
let port, interface =
if fake then (
0, Xc.with_intf (fun xc -> Xc.map_foreign_range xc 0 (Mmap.getpagesize()) 0n)
0, Xenctrl.with_intf (fun xc -> Xenctrl.map_foreign_range xc 0 (Xenmmap.getpagesize()) 0n)
) else (
let port = Utils.read_file_single_integer Define.xenstored_proc_port
and fd = Unix.openfile Define.xenstored_proc_kva
[ Unix.O_RDWR ] 0o600 in
let interface = Mmap.mmap fd Mmap.RDWR Mmap.SHARED
(Mmap.getpagesize()) 0 in
let interface = Xenmmap.mmap fd Xenmmap.RDWR Xenmmap.SHARED
(Xenmmap.getpagesize()) 0 in
Unix.close fd;
port, interface
)
tools/ocaml/xenstored/event.ml
+9 -9
View File
@@ -16,15 +16,15 @@
(**************** high level binding ****************)
type t = {
handle: Eventchn.handle;
handle: Xeneventchn.handle;
mutable virq_port: int;
}
let init () = { handle = Eventchn.init (); virq_port = -1; }
let fd eventchn = Eventchn.fd eventchn.handle
let bind_dom_exc_virq eventchn = eventchn.virq_port <- Eventchn.bind_dom_exc_virq eventchn.handle
let bind_interdomain eventchn domid port = Eventchn.bind_interdomain eventchn.handle domid port
let unbind eventchn port = Eventchn.unbind eventchn.handle port
let notify eventchn port = Eventchn.notify eventchn.handle port
let pending eventchn = Eventchn.pending eventchn.handle
let unmask eventchn port = Eventchn.unmask eventchn.handle port
let init () = { handle = Xeneventchn.init (); virq_port = -1; }
let fd eventchn = Xeneventchn.fd eventchn.handle
let bind_dom_exc_virq eventchn = eventchn.virq_port <- Xeneventchn.bind_dom_exc_virq eventchn.handle
let bind_interdomain eventchn domid port = Xeneventchn.bind_interdomain eventchn.handle domid port
let unbind eventchn port = Xeneventchn.unbind eventchn.handle port
let notify eventchn port = Xeneventchn.notify eventchn.handle port
let pending eventchn = Xeneventchn.pending eventchn.handle
let unmask eventchn port = Xeneventchn.unmask eventchn.handle port
tools/ocaml/xenstored/logging.ml
+31 -31
View File
@@ -39,7 +39,7 @@ type access_type =
| Commit
| Newconn
| Endconn
| XbOp of Xb.Op.operation
| XbOp of Xenbus.Xb.Op.operation
type access =
{
@@ -82,35 +82,35 @@ let string_of_access_type = function
| Endconn -> "endconn "
| XbOp op -> match op with
| Xb.Op.Debug -> "debug "
| Xenbus.Xb.Op.Debug -> "debug "
| Xb.Op.Directory -> "directory"
| Xb.Op.Read -> "read "
| Xb.Op.Getperms -> "getperms "
| Xenbus.Xb.Op.Directory -> "directory"
| Xenbus.Xb.Op.Read -> "read "
| Xenbus.Xb.Op.Getperms -> "getperms "
| Xb.Op.Watch -> "watch "
| Xb.Op.Unwatch -> "unwatch "
| Xenbus.Xb.Op.Watch -> "watch "
| Xenbus.Xb.Op.Unwatch -> "unwatch "
| Xb.Op.Transaction_start -> "t start "
| Xb.Op.Transaction_end -> "t end "
| Xenbus.Xb.Op.Transaction_start -> "t start "
| Xenbus.Xb.Op.Transaction_end -> "t end "
| Xb.Op.Introduce -> "introduce"
| Xb.Op.Release -> "release "
| Xb.Op.Getdomainpath -> "getdomain"
| Xb.Op.Isintroduced -> "is introduced"
| Xb.Op.Resume -> "resume "
| Xenbus.Xb.Op.Introduce -> "introduce"
| Xenbus.Xb.Op.Release -> "release "
| Xenbus.Xb.Op.Getdomainpath -> "getdomain"
| Xenbus.Xb.Op.Isintroduced -> "is introduced"
| Xenbus.Xb.Op.Resume -> "resume "
| Xb.Op.Write -> "write "
| Xb.Op.Mkdir -> "mkdir "
| Xb.Op.Rm -> "rm "
| Xb.Op.Setperms -> "setperms "
| Xb.Op.Restrict -> "restrict "
| Xb.Op.Set_target -> "settarget"
| Xenbus.Xb.Op.Write -> "write "
| Xenbus.Xb.Op.Mkdir -> "mkdir "
| Xenbus.Xb.Op.Rm -> "rm "
| Xenbus.Xb.Op.Setperms -> "setperms "
| Xenbus.Xb.Op.Restrict -> "restrict "
| Xenbus.Xb.Op.Set_target -> "settarget"
| Xb.Op.Error -> "error "
| Xb.Op.Watchevent -> "w event "
| Xenbus.Xb.Op.Error -> "error "
| Xenbus.Xb.Op.Watchevent -> "w event "
| x -> Xb.Op.to_string x
| x -> Xenbus.Xb.Op.to_string x
let file_exists file =
try
@@ -210,10 +210,10 @@ let commit = write_access_log Commit
let xb_op ~tid ~con ~ty data =
let print =
match ty with
| Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms -> !log_read_ops
| Xb.Op.Transaction_start | Xb.Op.Transaction_end ->
| Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !log_read_ops
| Xenbus.Xb.Op.Transaction_start | Xenbus.Xb.Op.Transaction_end ->
false (* transactions are managed below *)
| Xb.Op.Introduce | Xb.Op.Release | Xb.Op.Getdomainpath | Xb.Op.Isintroduced | Xb.Op.Resume ->
| Xenbus.Xb.Op.Introduce | Xenbus.Xb.Op.Release | Xenbus.Xb.Op.Getdomainpath | Xenbus.Xb.Op.Isintroduced | Xenbus.Xb.Op.Resume ->
!log_special_ops
| _ -> true
in
@@ -222,17 +222,17 @@ let xb_op ~tid ~con ~ty data =
let start_transaction ~tid ~con =
if !log_transaction_ops && tid <> 0
then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_start)
then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start)
let end_transaction ~tid ~con =
if !log_transaction_ops && tid <> 0
then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_end)
then write_access_log ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end)
let xb_answer ~tid ~con ~ty data =
let print = match ty with
| Xb.Op.Error when data="ENOENT " -> !log_read_ops
| Xb.Op.Error -> !log_special_ops
| Xb.Op.Watchevent -> true
| Xenbus.Xb.Op.Error when data="ENOENT " -> !log_read_ops
| Xenbus.Xb.Op.Error -> !log_special_ops
| Xenbus.Xb.Op.Watchevent -> true
| _ -> false
in
if print
tools/ocaml/xenstored/perms.ml
+3 -3
View File
@@ -43,9 +43,9 @@ struct
type t =
{
owner: Xc.domid;
owner: Xenctrl.domid;
other: permty;
acl: (Xc.domid * permty) list;
acl: (Xenctrl.domid * permty) list;
}
let create owner other acl =
@@ -88,7 +88,7 @@ end
module Connection =
struct
type elt = Xc.domid * (permty list)
type elt = Xenctrl.domid * (permty list)
type t =
{ main: elt;
target: elt option; }
tools/ocaml/xenstored/process.ml
+30 -30
View File
@@ -54,10 +54,10 @@ let split_one_path data con =
let process_watch ops cons =
let do_op_watch op cons =
let recurse = match (fst op) with
| Xb.Op.Write -> false
| Xb.Op.Mkdir -> false
| Xb.Op.Rm -> true
| Xb.Op.Setperms -> false
| Xenbus.Xb.Op.Write -> false
| Xenbus.Xb.Op.Mkdir -> false
| Xenbus.Xb.Op.Rm -> true
| Xenbus.Xb.Op.Setperms -> false
| _ -> raise (Failure "huh ?") in
Connections.fire_watches cons (snd op) recurse in
List.iter (fun op -> do_op_watch op cons) ops
@@ -83,7 +83,7 @@ let do_debug con t domains cons data =
then None
else try match split None '\000' data with
| "print" :: msg :: _ ->
Logging.xb_op ~tid:0 ~ty:Xb.Op.Debug ~con:"=======>" msg;
Logging.xb_op ~tid:0 ~ty:Xenbus.Xb.Op.Debug ~con:"=======>" msg;
None
| "quota" :: domid :: _ ->
let domid = int_of_string domid in
@@ -120,7 +120,7 @@ let do_watch con t rid domains cons data =
| _ -> raise Invalid_Cmd_Args
in
let watch = Connections.add_watch cons con node token in
Connection.send_ack con (Transaction.get_id t) rid Xb.Op.Watch;
Connection.send_ack con (Transaction.get_id t) rid Xenbus.Xb.Op.Watch;
Connection.fire_single_watch watch
let do_unwatch con t domains cons data =
@@ -165,7 +165,7 @@ let do_introduce con t domains cons data =
if Domains.exist domains domid then
Domains.find domains domid
else try
let ndom = Xc.with_intf (fun xc ->
let ndom = Xenctrl.with_intf (fun xc ->
Domains.create xc domains domid mfn port) in
Connections.add_domain cons ndom;
Connections.fire_spec_watches cons "@introduceDomain";
@@ -299,25 +299,25 @@ let reply_none fct ty con t rid doms cons data =
let function_of_type ty =
match ty with
| Xb.Op.Debug -> reply_data_or_ack do_debug
| Xb.Op.Directory -> reply_data do_directory
| Xb.Op.Read -> reply_data do_read
| Xb.Op.Getperms -> reply_data do_getperms
| Xb.Op.Watch -> reply_none do_watch
| Xb.Op.Unwatch -> reply_ack do_unwatch
| Xb.Op.Transaction_start -> reply_data do_transaction_start
| Xb.Op.Transaction_end -> reply_ack do_transaction_end
| Xb.Op.Introduce -> reply_ack do_introduce
| Xb.Op.Release -> reply_ack do_release
| Xb.Op.Getdomainpath -> reply_data do_getdomainpath
| Xb.Op.Write -> reply_ack do_write
| Xb.Op.Mkdir -> reply_ack do_mkdir
| Xb.Op.Rm -> reply_ack do_rm
| Xb.Op.Setperms -> reply_ack do_setperms
| Xb.Op.Isintroduced -> reply_data do_isintroduced
| Xb.Op.Resume -> reply_ack do_resume
| Xb.Op.Set_target -> reply_ack do_set_target
| Xb.Op.Restrict -> reply_ack do_restrict
| Xenbus.Xb.Op.Debug -> reply_data_or_ack do_debug
| Xenbus.Xb.Op.Directory -> reply_data do_directory
| Xenbus.Xb.Op.Read -> reply_data do_read
| Xenbus.Xb.Op.Getperms -> reply_data do_getperms
| Xenbus.Xb.Op.Watch -> reply_none do_watch
| Xenbus.Xb.Op.Unwatch -> reply_ack do_unwatch
| Xenbus.Xb.Op.Transaction_start -> reply_data do_transaction_start
| Xenbus.Xb.Op.Transaction_end -> reply_ack do_transaction_end
| Xenbus.Xb.Op.Introduce -> reply_ack do_introduce
| Xenbus.Xb.Op.Release -> reply_ack do_release
| Xenbus.Xb.Op.Getdomainpath -> reply_data do_getdomainpath
| Xenbus.Xb.Op.Write -> reply_ack do_write
| Xenbus.Xb.Op.Mkdir -> reply_ack do_mkdir
| Xenbus.Xb.Op.Rm -> reply_ack do_rm
| Xenbus.Xb.Op.Setperms -> reply_ack do_setperms
| Xenbus.Xb.Op.Isintroduced -> reply_data do_isintroduced
| Xenbus.Xb.Op.Resume -> reply_ack do_resume
| Xenbus.Xb.Op.Set_target -> reply_ack do_set_target
| Xenbus.Xb.Op.Restrict -> reply_ack do_restrict
| _ -> reply_ack do_error
let input_handle_error ~cons ~doms ~fct ~ty ~con ~t ~rid ~data =
@@ -370,11 +370,11 @@ let write_answer_log ~ty ~tid ~con ~data =
let do_input store cons doms con =
if Connection.do_input con then (
let packet = Connection.pop_in con in
let tid, rid, ty, data = Xb.Packet.unpack packet in
let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in
(* As we don't log IO, do not call an unnecessary sanitize_data
Logs.info "io" "[%s] -> [%d] %s \"%s\""
(Connection.get_domstr con) tid
(Xb.Op.to_string ty) (sanitize_data data); *)
(Xenbus.Xb.Op.to_string ty) (sanitize_data data); *)
process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data;
write_access_log ~ty ~tid ~con ~data;
Connection.incr_ops con;
@@ -384,11 +384,11 @@ let do_output store cons doms con =
if Connection.has_output con then (
if Connection.has_new_output con then (
let packet = Connection.peek_output con in
let tid, rid, ty, data = Xb.Packet.unpack packet in
let tid, rid, ty, data = Xenbus.Xb.Packet.unpack packet in
(* As we don't log IO, do not call an unnecessary sanitize_data
Logs.info "io" "[%s] <- %s \"%s\""
(Connection.get_domstr con)
(Xb.Op.to_string ty) (sanitize_data data);*)
(Xenbus.Xb.Op.to_string ty) (sanitize_data data);*)
write_answer_log ~ty ~tid ~con ~data;
);
ignore (Connection.do_output con)
tools/ocaml/xenstored/quota.ml
+1 -1
View File
@@ -26,7 +26,7 @@ let maxsize = ref (4096)
type t = {
maxent: int; (* max entities per domU *)
maxsize: int; (* max size of data store in one node *)
cur: (Xc.domid, int) Hashtbl.t; (* current domains quota *)
cur: (Xenctrl.domid, int) Hashtbl.t; (* current domains quota *)
}
let to_string quota domid =
tools/ocaml/xenstored/transaction.ml
+5 -5
View File
@@ -74,7 +74,7 @@ type ty = No | Full of (int * Store.Node.t * Store.t)
type t = {
ty: ty;
store: Store.t;
mutable ops: (Xb.Op.operation * Store.Path.t) list;
mutable ops: (Xenbus.Xb.Op.operation * Store.Path.t) list;
mutable read_lowpath: Store.Path.t option;
mutable write_lowpath: Store.Path.t option;
}
@@ -105,23 +105,23 @@ let write t perm path value =
if path_exists
then set_write_lowpath t path
else set_write_lowpath t (Store.Path.get_parent path);
add_wop t Xb.Op.Write path
add_wop t Xenbus.Xb.Op.Write path
let mkdir ?(with_watch=true) t perm path =
Store.mkdir t.store perm path;
set_write_lowpath t path;
if with_watch then
add_wop t Xb.Op.Mkdir path
add_wop t Xenbus.Xb.Op.Mkdir path
let setperms t perm path perms =
Store.setperms t.store perm path perms;
set_write_lowpath t path;
add_wop t Xb.Op.Setperms path
add_wop t Xenbus.Xb.Op.Setperms path
let rm t perm path =
Store.rm t.store perm path;
set_write_lowpath t (Store.Path.get_parent path);
add_wop t Xb.Op.Rm path
add_wop t Xenbus.Xb.Op.Rm path
let ls t perm path =
let r = Store.ls t.store perm path in
tools/ocaml/xenstored/xenstored.ml
+5 -5
View File
@@ -35,7 +35,7 @@ let process_connection_fds store cons domains rset wset =
if err <> Unix.ECONNRESET then
error "closing socket connection: read error: %s"
(Unix.error_message err)
| Xb.End_of_file ->
| Xenbus.Xb.End_of_file ->
Connections.del_anonymous cons c;
debug "closing socket connection"
in
@@ -170,7 +170,7 @@ let from_channel_f chan domain_f watch_f store_f =
let from_channel store cons doms chan =
(* don't let the permission get on our way, full perm ! *)
let op = Store.get_ops store Perms.Connection.full_rights in
let xc = Xc.interface_open () in
let xc = Xenctrl.interface_open () in
let domain_f domid mfn port =
let ndom =
@@ -190,7 +190,7 @@ let from_channel store cons doms chan =
op.Store.setperms path perms
in
finally (fun () -> from_channel_f chan domain_f watch_f store_f)
(fun () -> Xc.interface_close xc)
(fun () -> Xenctrl.interface_close xc)
let from_file store cons doms file =
let channel = open_in file in
@@ -282,7 +282,7 @@ let _ =
Store.mkdir store (Perms.Connection.create 0) localpath;
if cf.domain_init then (
let usingxiu = Xc.is_fake () in
let usingxiu = Xenctrl.is_fake () in
Connections.add_domain cons (Domains.create0 usingxiu domains);
Event.bind_dom_exc_virq eventchn
);
@@ -301,7 +301,7 @@ let _ =
(if cf.domain_init then [ Event.fd eventchn ] else [])
in
let xc = Xc.interface_open () in
let xc = Xenctrl.interface_open () in
let process_special_fds rset =
let accept_connection can_write fd =
Reference in new issue
xen-project/xen
Block a user
Blocking a user prevents them from interacting with repositories, such as opening or commenting on pull requests or issues. Learn more about blocking a user.

The note is not visible to the blocked user.