diff --git a/Makefile b/Makefile index cb7fa66..601c0d8 100644 --- a/Makefile +++ b/Makefile @@ -2,6 +2,11 @@ DUNE = dune JOBS = $(shell getconf _NPROCESSORS_ONLN) PROFILE = release +# K&R style indentation, could use in format target below +INDENT += -nbad -bap -nbc -br -brs -c33 -cd33 -ncdb -ce -ci4 -cli0 +INDENT += -d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs +INDENT += -npsl -nsc -nsob + .PHONY: build check test clean format install build: diff --git a/mmap/xenmmap_stubs.c b/mmap/xenmmap_stubs.c index fe1fea8..afe0e7e 100644 --- a/mmap/xenmmap_stubs.c +++ b/mmap/xenmmap_stubs.c @@ -30,6 +30,7 @@ #include #include #include +#include #define Intf_val(a) ((struct mmap_interface *)Data_abstract_val(a)) #define Wsize_bsize_round(n) (Wsize_bsize( (n) + sizeof(value) - 1 )) @@ -89,10 +90,15 @@ stub_mmap_init (value fd, value pflag, value mflag, value len, value offset) caml_invalid_argument ("negative size"); if (Int_val (offset) < 0) caml_invalid_argument ("negative offset"); - length = Int_val (len); + length = Long_val (len); + + int c_fd = Int_val (fd); + size_t c_offset = Long_val (offset); + + caml_release_runtime_system (); + addr = mmap (NULL, length, c_pflag, c_mflag, c_fd, c_offset); + caml_acquire_runtime_system (); - addr = mmap (NULL, length, c_pflag, c_mflag, Int_val (fd), - Int_val (offset)); if (MAP_FAILED == addr) uerror ("mmap", Nothing); @@ -104,9 +110,16 @@ CAMLprim value stub_mmap_final (value intf) { CAMLparam1 (intf); + void *addr = Intf_val (intf)->addr; + + if (addr != MAP_FAILED) + { + int len = Intf_val (intf)->len; + caml_release_runtime_system (); + munmap (addr, len); + caml_acquire_runtime_system (); + } - if (Intf_val (intf)->addr != MAP_FAILED) - munmap (Intf_val (intf)->addr, Intf_val (intf)->len); Intf_val (intf)->addr = MAP_FAILED; CAMLreturn (Val_unit); diff --git a/ocaml-evtchn/lib/eventchn_stubs.c b/ocaml-evtchn/lib/eventchn_stubs.c index ceb56bf..1129b71 100644 --- a/ocaml-evtchn/lib/eventchn_stubs.c +++ b/ocaml-evtchn/lib/eventchn_stubs.c @@ -32,53 +32,87 @@ #include #include #include +#include -#define _H(__h) ((xenevtchn_handle *)(__h)) -#define XENEVTCHN_NO_CLOEXEC (1 << 0) +static inline xenevtchn_handle * +xce_of_val (value v) +{ + return *(xenevtchn_handle **) Data_custom_val (v); +} + +static void +stub_evtchn_finalize (value v) +{ + xenevtchn_close (xce_of_val (v)); +} -xenevtchn_handle *global_xce = NULL; +static struct custom_operations xenevtchn_ops = { + .identifier = "xenevtchn", + .finalize = stub_evtchn_finalize, + .compare = custom_compare_default, /* Can't compare */ + .hash = custom_hash_default, /* Can't hash */ + .serialize = custom_serialize_default, /* Can't serialize */ + .deserialize = custom_deserialize_default, /* Can't deserialize */ + .compare_ext = custom_compare_ext_default, /* Can't compare */ +}; CAMLprim value stub_evtchn_init (value cloexec) { CAMLparam1 (cloexec); + CAMLlocal1 (result); + xenevtchn_handle *xce; unsigned int flags = 0; + if (!Bool_val (cloexec)) flags |= XENEVTCHN_NO_CLOEXEC; - if (global_xce == NULL) + result = caml_alloc_custom (&xenevtchn_ops, sizeof (xce), 0, 1); + + caml_release_runtime_system (); + xce = xenevtchn_open (NULL, flags); + caml_acquire_runtime_system (); + + if (xce == NULL) { - global_xce = xenevtchn_open (NULL, flags); + caml_failwith (strerror (errno)); } - if (global_xce == NULL) - caml_failwith (strerror (errno)); - - CAMLreturn ((value) global_xce); + *(xenevtchn_handle **) Data_custom_val (result) = xce; + CAMLreturn (result); } CAMLprim value -stub_evtchn_fd (value xce) +stub_evtchn_fd (value xce_val) { - CAMLparam1 (xce); + CAMLparam1 (xce_val); + xenevtchn_handle *xce = xce_of_val (xce_val); int fd; - fd = xenevtchn_fd (_H (xce)); + /* Don't drop the GC lock. This is a simple read out of memory */ + fd = xenevtchn_fd (xce); if (fd == -1) { - perror ("xc_evtchn_fd"); caml_failwith (strerror (errno)); } + CAMLreturn (Val_int (fd)); } CAMLprim value -stub_evtchn_notify (value xce, value port) +stub_evtchn_notify (value xce_val, value port_val) { - CAMLparam2 (xce, port); - if (xenevtchn_notify (_H (xce), Int_val (port)) == -1) + CAMLparam2 (xce_val, port_val); + xenevtchn_handle *xce = xce_of_val (xce_val); + int rc; + int port = Int_val (port_val); + + caml_release_runtime_system (); + rc = xenevtchn_notify (xce, port); + caml_acquire_runtime_system (); + + if (rc == -1) { - perror ("xc_evtchn_notify"); caml_failwith (strerror (errno)); } @@ -86,16 +120,21 @@ stub_evtchn_notify (value xce, value port) } CAMLprim value -stub_evtchn_bind_interdomain (value xce, value domid, value remote_port) +stub_evtchn_bind_interdomain (value xce_val, value domid_val, + value remote_port_val) { - CAMLparam3 (xce, domid, remote_port); + CAMLparam3 (xce_val, domid_val, remote_port_val); + xenevtchn_handle *xce = xce_of_val (xce_val); xenevtchn_port_or_error_t rc; + int domid = Int_val (domid_val); + int remote_port = Int_val (remote_port_val); + + caml_release_runtime_system (); + rc = xenevtchn_bind_interdomain (xce, domid, remote_port); + caml_acquire_runtime_system (); - rc = xenevtchn_bind_interdomain (_H (xce), Int_val (domid), - Int_val (remote_port)); if (rc == -1) { - perror ("xc_evtchn_bind_interdomain"); caml_failwith (strerror (errno)); } @@ -103,15 +142,18 @@ stub_evtchn_bind_interdomain (value xce, value domid, value remote_port) } CAMLprim value -stub_evtchn_alloc_unbound (value xce, value remote_domid) +stub_evtchn_alloc_unbound (value xce_val, value remote_domid_val) { - CAMLparam2 (xce, remote_domid); + CAMLparam2 (xce_val, remote_domid_val); + xenevtchn_handle *xce = xce_of_val (xce_val); xenevtchn_port_or_error_t rc; + int remote_domid = Int_val (remote_domid_val); - rc = xenevtchn_bind_unbound_port (_H (xce), Int_val (remote_domid)); + caml_release_runtime_system (); + rc = xenevtchn_bind_unbound_port (xce, remote_domid); + caml_acquire_runtime_system (); if (rc == -1) { - perror ("xc_evtchn_bind_unbound_port"); caml_failwith (strerror (errno)); } @@ -127,15 +169,18 @@ stub_evtchn_virq_dom_exc (value unit) } CAMLprim value -stub_evtchn_bind_virq (value xce, value virq) +stub_evtchn_bind_virq (value xce_val, value virq_val) { - CAMLparam2 (xce, virq); + CAMLparam2 (xce_val, virq_val); xenevtchn_port_or_error_t rc; + xenevtchn_handle *xce = xce_of_val (xce_val); + int virq = Int_val (virq_val); - rc = xenevtchn_bind_virq (_H (xce), Int_val (virq)); + caml_release_runtime_system (); + rc = xenevtchn_bind_virq (xce, virq); + caml_acquire_runtime_system (); if (rc == -1) { - perror ("xc_evtchn_bind_virq"); caml_failwith (strerror (errno)); } @@ -143,12 +188,18 @@ stub_evtchn_bind_virq (value xce, value virq) } CAMLprim value -stub_evtchn_unbind (value xce, value port) +stub_evtchn_unbind (value xce_val, value port_val) { - CAMLparam2 (xce, port); - if (xenevtchn_unbind (_H (xce), Int_val (port)) == -1) + CAMLparam2 (xce_val, port_val); + xenevtchn_handle *xce = xce_of_val (xce_val); + int port = Int_val (port_val); + int rc; + + caml_release_runtime_system (); + rc = xenevtchn_unbind (xce, port); + caml_acquire_runtime_system (); + if (rc == -1) { - perror ("xc_evtchn_unbind"); caml_failwith (strerror (errno)); } @@ -156,18 +207,20 @@ stub_evtchn_unbind (value xce, value port) } CAMLprim value -stub_evtchn_pending (value xce) +stub_evtchn_pending (value xce_val) { - CAMLparam1 (xce); + CAMLparam1 (xce_val); CAMLlocal1 (generation); xenevtchn_port_or_error_t port; + xenevtchn_handle *xce = xce_of_val (xce_val); generation = caml_alloc_tuple (2); - port = xenevtchn_pending (_H (xce)); + caml_release_runtime_system (); + port = xenevtchn_pending (xce); + caml_acquire_runtime_system (); if (port == -1) { - perror ("xc_evtchn_pending"); caml_failwith (strerror (errno)); } @@ -178,12 +231,18 @@ stub_evtchn_pending (value xce) } CAMLprim value -stub_evtchn_unmask (value xce, value port) +stub_evtchn_unmask (value xce_val, value port_val) { - CAMLparam2 (xce, port); - if (xenevtchn_unmask (_H (xce), Int_val (port)) == -1) + CAMLparam2 (xce_val, port_val); + xenevtchn_handle *xce = xce_of_val (xce_val); + int port = Int_val (port_val); + int rc; + + caml_release_runtime_system (); + rc = xenevtchn_unmask (xce, port); + caml_acquire_runtime_system (); + if (rc == -1) { - perror ("xc_evtchn_unmask"); caml_failwith (strerror (errno)); } diff --git a/oxenstored/config.ml b/oxenstored/config.ml index a2eef03..1bd57a8 100644 --- a/oxenstored/config.ml +++ b/oxenstored/config.ml @@ -65,7 +65,9 @@ let parse_line stream = try let line = trim_spaces (input_line stream) in if String.length line > 0 && line.[0] <> '#' then - match to_config line with + match + to_config line + with | None -> read_filter_line () | Some x -> diff --git a/oxenstored/connection.ml b/oxenstored/connection.ml index 92d9979..65a3c0b 100644 --- a/oxenstored/connection.ml +++ b/oxenstored/connection.ml @@ -433,10 +433,9 @@ let lookup_watch_perm path = function try Store.Path.apply root path @@ fun parent name -> Store.Node.get_perms parent - :: - ( try [Store.Node.get_perms (Store.Node.find parent name)] - with Not_found -> [] - ) + :: ( try [Store.Node.get_perms (Store.Node.find parent name)] + with Not_found -> [] + ) with Define.Invalid_path | Not_found -> [] ) @@ -491,7 +490,9 @@ let fire_single_watch source (oldroot, root) depth watch = if watch.path.[0] = '@' then true else - match watch.depth with + match + watch.depth + with | None -> true | Some x when x >= depth - watch.path_depth -> @@ -523,14 +524,14 @@ let fire_watch source roots watch path depth = (* Search for a valid unused transaction id. *) let rec valid_transaction_id con proposed_id = (* - * Clip proposed_id to the range [1, 0x3ffffffe] - * - * The chosen id must not trucate when written into the uint32_t tx_id - * field, and needs to fit within the positive range of a 31 bit ocaml - * integer to function when compiled as 32bit. - * - * Oxenstored therefore supports only 1 billion open transactions. - *) + * Clip proposed_id to the range [1, 0x3ffffffe] + * + * The chosen id must not trucate when written into the uint32_t tx_id + * field, and needs to fit within the positive range of a 31 bit ocaml + * integer to function when compiled as 32bit. + * + * Oxenstored therefore supports only 1 billion open transactions. + *) let id = if proposed_id <= 0 || proposed_id >= 0x3fffffff then 1 else proposed_id in diff --git a/oxenstored/connections.ml b/oxenstored/connections.ml index c00e9f1..a017a76 100644 --- a/oxenstored/connections.ml +++ b/oxenstored/connections.ml @@ -178,7 +178,9 @@ let add_watch cons con path token depth = ( if is_special_watch then (* No depth can be specified for @releaseDomain/domid watches. Only depth=1 can be specified for other special watches *) - match depth with + match + depth + with | Some _ when String.starts_with ~prefix:"@releaseDomain/" apath -> raise (Invalid_argument diff --git a/oxenstored/domains.ml b/oxenstored/domains.ml index c09dcb2..01d860a 100644 --- a/oxenstored/domains.ml +++ b/oxenstored/domains.ml @@ -24,7 +24,9 @@ let load_plug fname = let fail_with fmt = Printf.ksprintf failwith fmt in let fname = Dynlink.adapt_filename fname in if Sys.file_exists fname then - try Dynlink.loadfile fname with + try + Dynlink.loadfile fname + with | Dynlink.Error err as e -> error "ERROR loading plugin '%s': %s\n%!" fname (Dynlink.error_message err) ; diff --git a/oxenstored/process.ml b/oxenstored/process.ml index 5aa9b53..b8aac07 100644 --- a/oxenstored/process.ml +++ b/oxenstored/process.ml @@ -232,7 +232,9 @@ module LiveUpdate = struct let should_run cons = let t = !state in if t.pending then ( - match Connections.prevents_quit cons with + match + Connections.prevents_quit cons + with | [] -> true | _ when Unix.gettimeofday () < t.deadline -> @@ -792,8 +794,9 @@ let do_introduce con t domains cons data = if Domains.exist domains domid then ( let edom = Domains.find domains domid in if Domain.get_mfn edom = mfn && Connections.find_domain cons domid != con - then (* Use XS_INTRODUCE for recreating the xenbus event-channel. *) + then Domain.rebind_evtchn edom remote_port ; + (* Use XS_INTRODUCE for recreating the xenbus event-channel. *) edom ) else try diff --git a/oxenstored/store.ml b/oxenstored/store.ml index 7d50349..3f39015 100644 --- a/oxenstored/store.ml +++ b/oxenstored/store.ml @@ -152,7 +152,9 @@ module Path = struct else if s = "/" then [] else - match String.split '/' s with + match + String.split '/' s + with | "" :: path when is_valid path -> path | _ -> @@ -216,7 +218,9 @@ module Path = struct if path = [] then Some rnode else - try Some (lookup_get rnode path) with Define.Doesnt_exist -> None + try + Some (lookup_get rnode path) + with Define.Doesnt_exist -> None (* get the deepest existing node for this path, return the node and a flag on the existence of the full path *) let rec get_deepest_existing_node node = function diff --git a/oxenstored/transaction.ml b/oxenstored/transaction.ml index 1235287..38c46a4 100644 --- a/oxenstored/transaction.ml +++ b/oxenstored/transaction.ml @@ -83,15 +83,21 @@ let test_coalesce oldroot currentroot optpath = let can_coalesce oldroot currentroot path = if !do_coalesce then - try test_coalesce oldroot currentroot path with _ -> false + try + test_coalesce oldroot currentroot path + with _ -> false else false type ty = | No - | Full of (int * (* Transaction id *) - Store.t * (* Original store *) - Store.t) + | Full of + ( int + * (* Transaction id *) + Store.t + * (* Original store *) + Store.t + ) (* A pointer to the canonical store: its root changes on each transaction-commit *) type t = { diff --git a/oxenstored/trie.ml b/oxenstored/trie.ml index 812226e..d8cf767 100644 --- a/oxenstored/trie.ml +++ b/oxenstored/trie.ml @@ -68,8 +68,8 @@ let rec map f tree = tree |> StringMap.map aux |> StringMap.filter (fun _ n -> - n.Node.value <> None || not (StringMap.is_empty n.Node.children) - ) + n.Node.value <> None || not (StringMap.is_empty n.Node.children) + ) let rec fold f tree acc = let aux key node accu = diff --git a/oxenstored/xenstored.ml b/oxenstored/xenstored.ml index 3d02891..6cea2d4 100644 --- a/oxenstored/xenstored.ml +++ b/oxenstored/xenstored.ml @@ -326,7 +326,8 @@ module DB = struct Event.dump evtchn chan ; (* dump connections related to domains: domid, mfn, eventchn port/ sockets, and watches *) - Connections.iter cons (fun con -> Connection.dump con chan) ; + Connections.iter cons (fun con -> Connection.dump con chan + ) ; (* dump the store *) Store.dump_fct store (fun path node -> @@ -660,7 +661,9 @@ let main () = let elapsed = Unix.gettimeofday () -. now in debug "periodic_ops took %F seconds." elapsed ; ( if !quit then - match Connections.prevents_quit cons with + match + Connections.prevents_quit cons + with | [] -> () | domains -> diff --git a/xenbus/xb.ml b/xenbus/xb.ml index 0363c48..852a620 100644 --- a/xenbus/xb.ml +++ b/xenbus/xb.ml @@ -361,7 +361,9 @@ let open_mmap mmap notifyfct ~under_testing = let close con ~under_testing = if not under_testing then - match con.backend with + match + con.backend + with | Fd backend -> Unix.close backend.fd | Xenmmap backend -> diff --git a/xsd_glue/domain_getinfo_plugin_v1/domain_getinfo_stubs_v1.c b/xsd_glue/domain_getinfo_plugin_v1/domain_getinfo_stubs_v1.c index 10d7a0b..e77e6fb 100644 --- a/xsd_glue/domain_getinfo_plugin_v1/domain_getinfo_stubs_v1.c +++ b/xsd_glue/domain_getinfo_plugin_v1/domain_getinfo_stubs_v1.c @@ -44,7 +44,7 @@ static struct custom_operations xsd_glue_xenctrl_ops = { }; CAMLnoreturn_start static void CAMLnoreturn_end -xsd_glue_failwith (xc_interface * xch, const char *func, unsigned int line) +xsd_glue_failwith (xc_interface *xch, const char *func, unsigned int line) { CAMLparam0 (); CAMLlocal1 (msg); @@ -99,7 +99,7 @@ stub_xsd_glue_xc_interface_open (value unit) } static value -xsd_glue_alloc_domaininfo (const xc_domaininfo_t * info) +xsd_glue_alloc_domaininfo (const xc_domaininfo_t *info) { CAMLparam0 (); CAMLlocal1 (result);