Permalink
Browse files

Start splitting the xenstore server into a core 'server' (separate fr…

…om unix/xen config and comms)
  • Loading branch information...
1 parent 75fb03f commit 10c26c4f743ac03f3dfe1e8b60ae0407a7193741 David Scott committed Apr 3, 2012
View
@@ -27,6 +27,13 @@ Library xenstore_unix
Modules: Xs_transport_unix
BuildDepends: lwt
+Library xenstore_server
+ Path: server
+ Findlibname: server
+ FindlibParent: xenstore
+ Modules: Trie
+ BuildDepends: lwt, xenstore
+
Executable xs_test
Path: lib_test
MainIs: xs_test.ml
@@ -44,14 +51,6 @@ Executable xs
Install: true
BuildDepends: lwt, lwt.unix, bitstring, xenstore, xenstore.client, xenstore.unix
-Executable oxenstored
- Path: server
- MainIs: xenstored.ml
- Custom: true
- CompiledObject: best
- Install: true
- BuildDepends: lwt, lwt.unix, bitstring, xenstore
-
Flag tests
Description: Build and run tests
Default: true
View
@@ -1,5 +1,5 @@
# OASIS_START
-# DO NOT EDIT (digest: 30e2580791dbccc3719a7bea099dfe24)
+# DO NOT EDIT (digest: cc52fbf3733732f352828373aa0ce9e3)
# Library xenstore
"core": include
<core/*.ml{,i}>: pkg_lwt
@@ -14,18 +14,6 @@
<client/*.ml{,i}>: pkg_lwt
<client/*.ml{,i}>: pkg_bitstring.syntax
<client/*.ml{,i}>: pkg_bitstring
-# Executable oxenstored
-<server/xenstored.{native,byte}>: use_xenstore
-<server/xenstored.{native,byte}>: pkg_lwt.unix
-<server/xenstored.{native,byte}>: pkg_lwt
-<server/xenstored.{native,byte}>: pkg_bitstring.syntax
-<server/xenstored.{native,byte}>: pkg_bitstring
-<server/*.ml{,i}>: use_xenstore
-<server/*.ml{,i}>: pkg_lwt.unix
-<server/*.ml{,i}>: pkg_lwt
-<server/*.ml{,i}>: pkg_bitstring.syntax
-<server/*.ml{,i}>: pkg_bitstring
-<server/xenstored.{native,byte}>: custom
# Executable xs
<cli/xs_client_cli.{native,byte}>: use_xenstore_client
<cli/xs_client_cli.{native,byte}>: use_xenstore_unix
@@ -56,6 +44,12 @@
<lib_test/*.ml{,i}>: pkg_bitstring.syntax
<lib_test/*.ml{,i}>: pkg_bitstring
<lib_test/xs_test.{native,byte}>: custom
+# Library xenstore_server
+"server": include
+<server/*.ml{,i}>: use_xenstore
+<server/*.ml{,i}>: pkg_lwt
+<server/*.ml{,i}>: pkg_bitstring.syntax
+<server/*.ml{,i}>: pkg_bitstring
# OASIS_STOP
true: annot
<*/*>: syntax_camlp4o
View
@@ -1,5 +1,5 @@
# OASIS_START
-# DO NOT EDIT (digest: e141d0d7f888b9205407a8a071253c71)
+# DO NOT EDIT (digest: b15dee45b3a596f1573ea20271fdf7cd)
version = "0.9-dev"
description = "Xenstore protocol library"
requires = "lwt bitstring bitstring.syntax"
@@ -23,5 +23,14 @@ package "client" (
archive(native) = "xenstore_client.cmxa"
exists_if = "xenstore_client.cma"
)
+
+package "server" (
+ version = "0.9-dev"
+ description = "Xenstore protocol library"
+ requires = "lwt xenstore"
+ archive(byte) = "xenstore_server.cma"
+ archive(native) = "xenstore_server.cmxa"
+ exists_if = "xenstore_server.cma"
+)
# OASIS_STOP
View
@@ -1,5 +1,5 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: 9dfc37214ad1971e6e80810e68889847) *)
+(* DO NOT EDIT (digest: ee3b44b8284f705fbdc6c39b3a91f52b) *)
module OASISGettext = struct
# 21 "/tmp/buildd/oasis-0.2.0/src/oasis/OASISGettext.ml"
@@ -455,7 +455,8 @@ let package_default =
[
("core/xenstore", ["core"]);
("unix/xenstore_unix", ["unix"]);
- ("client/xenstore_client", ["client"])
+ ("client/xenstore_client", ["client"]);
+ ("server/xenstore_server", ["server"])
];
lib_c = [];
flags = [];
File renamed without changes.
@@ -110,7 +110,7 @@ let set_target con target_domid =
let send_reply con 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 Xenbus.Xb.Op.Error (err ^ "\000")
+let send_error con tid rid err = send_reply con tid rid Xs_packet.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 Xenbus.Xb.Op.Watchevent data
+ send_reply watch.con Transaction.none 0 Xs_packet.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 Xenbus.Xb.Op.Watchevent data
+ send_reply watch.con Transaction.none 0 Xs_packet.Op.Watchevent data
let find_next_tid con =
let ret = con.next_tid in con.next_tid <- con.next_tid + 1; ret
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
@@ -143,7 +143,7 @@ type access_type =
| Commit
| Newconn
| Endconn
- | XbOp of Xenbus.Xb.Op.operation
+ | XbOp of Xs_packet.Op.t
let string_of_tid ~con tid =
if tid = 0
@@ -157,37 +157,38 @@ let string_of_access_type = function
| Newconn -> "newconn "
| Endconn -> "endconn "
- | XbOp op -> match op with
- | Xenbus.Xb.Op.Debug -> "debug "
+ | XbOp op ->
+ let open Xs_packet.Op in match op with
+ | Debug -> "debug "
- | Xenbus.Xb.Op.Directory -> "directory"
- | Xenbus.Xb.Op.Read -> "read "
- | Xenbus.Xb.Op.Getperms -> "getperms "
+ | Directory -> "directory"
+ | Read -> "read "
+ | Getperms -> "getperms "
- | Xenbus.Xb.Op.Watch -> "watch "
- | Xenbus.Xb.Op.Unwatch -> "unwatch "
+ | Watch -> "watch "
+ | Unwatch -> "unwatch "
- | Xenbus.Xb.Op.Transaction_start -> "t start "
- | Xenbus.Xb.Op.Transaction_end -> "t end "
+ | Transaction_start -> "t start "
+ | Transaction_end -> "t end "
- | 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 "
+ | Introduce -> "introduce"
+ | Release -> "release "
+ | Getdomainpath -> "getdomain"
+ | Isintroduced -> "is introduced"
+ | Resume -> "resume "
- | 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"
-
- | Xenbus.Xb.Op.Error -> "error "
- | Xenbus.Xb.Op.Watchevent -> "w event "
- | Xenbus.Xb.Op.Invalid -> "invalid "
+ | Write -> "write "
+ | Mkdir -> "mkdir "
+ | Rm -> "rm "
+ | Setperms -> "setperms "
+(* | Restrict -> "restrict "*)
+ | Set_target -> "settarget"
+
+ | Error -> "error "
+ | Watchevent -> "w event "
+(* | Invalid -> "invalid " *)
(*
- | x -> Xenbus.Xb.Op.to_string x
+ | x -> to_string x
*)
let sanitize_data data =
@@ -239,28 +240,30 @@ let conflict = access_logging Conflict
let commit = access_logging Commit
let xb_op ~tid ~con ~ty data =
- let print = match ty with
- | Xenbus.Xb.Op.Read | Xenbus.Xb.Op.Directory | Xenbus.Xb.Op.Getperms -> !access_log_read_ops
- | Xenbus.Xb.Op.Transaction_start | Xenbus.Xb.Op.Transaction_end ->
+ let print =
+ let open Xs_packet.Op in match ty with
+ | Read | Directory | Getperms -> !access_log_read_ops
+ | Transaction_start | Transaction_end ->
false (* transactions are managed below *)
- | Xenbus.Xb.Op.Introduce | Xenbus.Xb.Op.Release | Xenbus.Xb.Op.Getdomainpath | Xenbus.Xb.Op.Isintroduced | Xenbus.Xb.Op.Resume ->
+ | Introduce | Release | Getdomainpath | Isintroduced | Resume ->
!access_log_special_ops
| _ -> true in
if print then access_logging ~tid ~con ~data (XbOp ty)
let start_transaction ~tid ~con =
if !access_log_transaction_ops && tid <> 0
- then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_start)
+ then access_logging ~tid ~con (XbOp Xs_packet.Op.Transaction_start)
let end_transaction ~tid ~con =
if !access_log_transaction_ops && tid <> 0
- then access_logging ~tid ~con (XbOp Xenbus.Xb.Op.Transaction_end)
+ then access_logging ~tid ~con (XbOp Xs_packet.Op.Transaction_end)
let xb_answer ~tid ~con ~ty data =
- let print = match ty with
- | Xenbus.Xb.Op.Error when String.startswith "ENOENT " data -> !access_log_read_ops
- | Xenbus.Xb.Op.Error -> true
- | Xenbus.Xb.Op.Watchevent -> true
+ let print =
+ let open Xs_packet.Op in match ty with
+ | Error when String.startswith "ENOENT " data -> !access_log_read_ops
+ | Error -> true
+ | Watchevent -> true
| _ -> false
in
if print then access_logging ~tid ~con ~data (XbOp ty)
File renamed without changes.
File renamed without changes.
@@ -21,6 +21,8 @@ open Stdext
let activate = ref true
+type domid = int
+
type permty = READ | WRITE | RDWR | NONE
let char_of_permty perm =
@@ -45,9 +47,9 @@ struct
type t =
{
- owner: Xenctrl.domid;
+ owner: domid;
other: permty;
- acl: (Xenctrl.domid * permty) list;
+ acl: (domid * permty) list;
}
let create owner other acl =
@@ -90,7 +92,7 @@ end
module Connection =
struct
-type elt = Xenctrl.domid * (permty list)
+type elt = domid * (permty list)
type t =
{ main: elt;
target: elt option; }
File renamed without changes.
@@ -18,6 +18,8 @@ exception Limit_reached
exception Data_too_big
exception Transaction_opened
+type domid = int
+
let warn fmt = Logging.warn "quota" fmt
let activate = ref true
let maxent = ref (10000)
@@ -26,7 +28,7 @@ let maxsize = ref (4096)
type t = {
maxent: int; (* max entities per domU *)
maxsize: int; (* max size of data store in one node *)
- cur: (Xenctrl.domid, int) Hashtbl.t; (* current domains quota *)
+ cur: (domid, int) Hashtbl.t; (* current domains quota *)
}
let to_string quota domid =
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
@@ -74,7 +74,7 @@ type ty = No | Full of (int * Store.Node.t * Store.t)
type t = {
ty: ty;
store: Store.t;
- mutable ops: (Xenbus.Xb.Op.operation * Store.Path.t) list;
+ mutable ops: (Xs_packet.Op.t * 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 Xenbus.Xb.Op.Write path
+ add_wop t Xs_packet.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 Xenbus.Xb.Op.Mkdir path
+ add_wop t Xs_packet.Op.Mkdir path
let setperms t perm path perms =
Store.setperms t.store perm path perms;
set_write_lowpath t path;
- add_wop t Xenbus.Xb.Op.Setperms path
+ add_wop t Xs_packet.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 Xenbus.Xb.Op.Rm path
+ add_wop t Xs_packet.Op.Rm path
let ls t perm path =
let r = Store.ls t.store perm path in
File renamed without changes.
@@ -210,7 +210,7 @@ let to_file store cons file =
(fun () -> close_out channel)
end
-let _ =
+let main () =
let cf = do_argv in
let pidfile =
if Sys.file_exists (config_filename cf) then
@@ -391,3 +391,8 @@ let _ =
info "stopping xenstored";
DB.to_file store cons "/var/run/xenstored/db";
()
+
+let _ =
+ Lwt_main.run (main ())
+
+
Oops, something went wrong.

0 comments on commit 10c26c4

Please sign in to comment.