aboutsummaryrefslogtreecommitdiffstats
path: root/tools/ocaml/xenstored
diff options
context:
space:
mode:
authorJon Ludlam <jonathan.ludlam@eu.citrix.com>2011-10-10 16:37:07 +0100
committerJon Ludlam <jonathan.ludlam@eu.citrix.com>2011-10-10 16:37:07 +0100
commit7ceaa0c7449e841d7ca7db889c3041dc3fedbb3b (patch)
tree5a31c840895e59e1ef01f4d08cc1354506559f1e /tools/ocaml/xenstored
parentdf0c75a05f6782a88e0471a9c5e070f8900a875f (diff)
downloadxen-7ceaa0c7449e841d7ca7db889c3041dc3fedbb3b.tar.gz
xen-7ceaa0c7449e841d7ca7db889c3041dc3fedbb3b.tar.bz2
xen-7ceaa0c7449e841d7ca7db889c3041dc3fedbb3b.zip
tools/ocaml: Rename the ocaml libraries
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>
Diffstat (limited to 'tools/ocaml/xenstored')
-rw-r--r--tools/ocaml/xenstored/Makefile8
-rw-r--r--tools/ocaml/xenstored/connection.ml30
-rw-r--r--tools/ocaml/xenstored/connections.ml4
-rw-r--r--tools/ocaml/xenstored/domain.ml6
-rw-r--r--tools/ocaml/xenstored/domains.ml20
-rw-r--r--tools/ocaml/xenstored/event.ml18
-rw-r--r--tools/ocaml/xenstored/logging.ml62
-rw-r--r--tools/ocaml/xenstored/perms.ml6
-rw-r--r--tools/ocaml/xenstored/process.ml60
-rw-r--r--tools/ocaml/xenstored/quota.ml2
-rw-r--r--tools/ocaml/xenstored/transaction.ml10
-rw-r--r--tools/ocaml/xenstored/xenstored.ml10
12 files changed, 118 insertions, 118 deletions
diff --git a/tools/ocaml/xenstored/Makefile b/tools/ocaml/xenstored/Makefile
index 4e674ab963..e573e57d31 100644
--- a/tools/ocaml/xenstored/Makefile
+++ b/tools/ocaml/xenstored/Makefile
@@ -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
diff --git a/tools/ocaml/xenstored/connection.ml b/tools/ocaml/xenstored/connection.ml
index 70cdbbfa91..e149a5b6f6 100644
--- a/tools/ocaml/xenstored/connection.ml
+++ b/tools/ocaml/xenstored/connection.ml
@@ -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
diff --git a/tools/ocaml/xenstored/connections.ml b/tools/ocaml/xenstored/connections.ml
index c331babb42..09b725cf3f 100644
--- a/tools/ocaml/xenstored/connections.ml
+++ b/tools/ocaml/xenstored/connections.ml
@@ -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
diff --git a/tools/ocaml/xenstored/domain.ml b/tools/ocaml/xenstored/domain.ml
index 258d172a5f..622984fc89 100644
--- a/tools/ocaml/xenstored/domain.ml
+++ b/tools/ocaml/xenstored/domain.ml
@@ -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 = {
diff --git a/tools/ocaml/xenstored/domains.ml b/tools/ocaml/xenstored/domains.ml
index 54d50d8ec0..9fca17ff84 100644
--- a/tools/ocaml/xenstored/domains.ml
+++ b/tools/ocaml/xenstored/domains.ml
@@ -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
)
diff --git a/tools/ocaml/xenstored/event.ml b/tools/ocaml/xenstored/event.ml
index b2df7a495d..cca8d93543 100644
--- a/tools/ocaml/xenstored/event.ml
+++ b/tools/ocaml/xenstored/event.ml
@@ -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
diff --git a/tools/ocaml/xenstored/logging.ml b/tools/ocaml/xenstored/logging.ml
index 61983098bc..2a34e6cbb9 100644
--- a/tools/ocaml/xenstored/logging.ml
+++ b/tools/ocaml/xenstored/logging.ml
@@ -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
diff --git a/tools/ocaml/xenstored/perms.ml b/tools/ocaml/xenstored/perms.ml
index 0462d5378a..70282c3862 100644
--- a/tools/ocaml/xenstored/perms.ml
+++ b/tools/ocaml/xenstored/perms.ml
@@ -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; }
diff --git a/tools/ocaml/xenstored/process.ml b/tools/ocaml/xenstored/process.ml
index 1549774d00..a6b5e45896 100644
--- a/tools/ocaml/xenstored/process.ml
+++ b/tools/ocaml/xenstored/process.ml
@@ -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)
diff --git a/tools/ocaml/xenstored/quota.ml b/tools/ocaml/xenstored/quota.ml
index 4091e40d62..56bbf0b496 100644
--- a/tools/ocaml/xenstored/quota.ml
+++ b/tools/ocaml/xenstored/quota.ml
@@ -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 =
diff --git a/tools/ocaml/xenstored/transaction.ml b/tools/ocaml/xenstored/transaction.ml
index 6942b2503c..e59d6814bf 100644
--- a/tools/ocaml/xenstored/transaction.ml
+++ b/tools/ocaml/xenstored/transaction.ml
@@ -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
diff --git a/tools/ocaml/xenstored/xenstored.ml b/tools/ocaml/xenstored/xenstored.ml
index 91cde8deed..1ef4f71a14 100644
--- a/tools/ocaml/xenstored/xenstored.ml
+++ b/tools/ocaml/xenstored/xenstored.ml
@@ -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 =