con.watches [] in
List.concat ll
-let fire_single_watch watch =
+let dbg fmt = Logging.debug "connection" fmt
+let info fmt = Logging.info "connection" fmt
+
+let lookup_watch_perm path = function
+| None -> []
+| Some root ->
+ 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 -> []
+ with Define.Invalid_path | Not_found -> []
+
+let lookup_watch_perms oldroot root path =
+ lookup_watch_perm path oldroot @ lookup_watch_perm path (Some root)
+
+let fire_single_watch_unchecked watch =
let data = Utils.join_by_null [watch.path; watch.token; ""] in
send_reply watch.con Transaction.none 0 Xenbus.Xb.Op.Watchevent data
-let fire_watch watch path =
+let fire_single_watch (oldroot, root) watch =
+ let abspath = get_watch_path watch.con watch.path |> Store.Path.of_string in
+ let perms = lookup_watch_perms oldroot root abspath in
+ if List.exists (Perms.has watch.con.perm READ) perms then
+ fire_single_watch_unchecked watch
+ else
+ let perms = perms |> List.map (Perms.Node.to_string ~sep:" ") |> String.concat ", " in
+ let con = get_domstr watch.con in
+ Logging.watch_not_fired ~con perms (Store.Path.to_string abspath)
+
+let fire_watch roots watch path =
let new_path =
if watch.is_relative && path.[0] = '/'
then begin
end else
path
in
- fire_single_watch { watch with path = new_path }
+ fire_single_watch roots { watch with path = new_path }
(* Search for a valid unused transaction id. *)
let rec valid_transaction_id con proposed_id =
watch
(* path is absolute *)
-let fire_watches cons path recurse =
+let fire_watches ?oldroot root cons path recurse =
let key = key_of_path path in
let path = Store.Path.to_string path in
+ let roots = oldroot, root in
let fire_watch _ = function
| None -> ()
- | Some watches -> List.iter (fun w -> Connection.fire_watch w path) watches
+ | Some watches -> List.iter (fun w -> Connection.fire_watch roots w path) watches
in
let fire_rec x = function
| None -> ()
| Some watches ->
- List.iter (fun w -> Connection.fire_single_watch w) watches
+ List.iter (Connection.fire_single_watch roots) watches
in
Trie.iter_path fire_watch cons.watches key;
if recurse then
Trie.iter fire_rec (Trie.sub cons.watches key)
-let fire_spec_watches cons specpath =
+let fire_spec_watches root cons specpath =
iter cons (fun con ->
- List.iter (fun w -> Connection.fire_single_watch w) (Connection.get_watches con specpath))
+ List.iter (Connection.fire_single_watch (None, root)) (Connection.get_watches con specpath))
let set_target cons domain target_domain =
let con = find_domain cons domain in
let xenstored_log_nb_chars = ref (-1)
let xenstored_logger = ref (None: logger option)
+let debug_enabled () = !xenstored_log_level = Debug
+
let set_xenstored_log_destination s =
xenstored_log_destination := log_destination_of_string s
| Commit
| Newconn
| Endconn
+ | Watch_not_fired
| XbOp of Xenbus.Xb.Op.operation
let string_of_tid ~con tid =
| Commit -> "commit "
| Newconn -> "newconn "
| Endconn -> "endconn "
+ | Watch_not_fired -> "w notfired"
| XbOp op -> match op with
| Xenbus.Xb.Op.Debug -> "debug "
| _ -> false, Debug
in
if print then access_logging ~tid ~con ~data (XbOp ty) ~level
+
+let watch_not_fired ~con perms path =
+ let data = Printf.sprintf "EPERM perms=[%s] path=%s" perms path in
+ access_logging ~tid:0 ~con ~data Watch_not_fired ~level:Info
let string_of_perm perm =
Printf.sprintf "%c%u" (char_of_permty (snd perm)) (fst perm)
-let to_string permvec =
+let to_string ?(sep="\000") permvec =
let l = ((permvec.owner, permvec.other) :: permvec.acl) in
- String.concat "\000" (List.map string_of_perm l)
+ String.concat sep (List.map string_of_perm l)
end
then Connection.is_owner connection (Node.get_owner node)
else true
-(* check if the current connection has the requested perm on the current node *)
-let check (connection:Connection.t) request (node:Node.t) =
+(* check if the current connection lacks the requested perm on the current node *)
+let lacks (connection:Connection.t) request (node:Node.t) =
let check_acl domainid =
let perm =
if List.mem_assoc domainid (Node.get_acl node)
info "Permission denied: Domain %d has write only access" domainid;
false
in
- if !activate
+ !activate
&& not (Connection.is_dom0 connection)
&& not (check_owner connection node)
&& not (List.exists check_acl (Connection.get_owners connection))
+
+(* check if the current connection has the requested perm on the current node.
+* Raises an exception if it doesn't. *)
+let check connection request node =
+ if lacks connection request node
then raise Define.Permission_denied
+(* check if the current connection has the requested perm on the current node *)
+let has connection request node = not (lacks connection request node)
+
let equiv perm1 perm2 =
(Node.to_string perm1) = (Node.to_string perm2)
| path :: "" :: [] -> Store.Path.create path (Connection.get_path con)
| _ -> raise Invalid_Cmd_Args
-let process_watch ops cons =
+let process_watch t cons =
+ let oldroot = t.Transaction.oldroot in
+ let newroot = Store.get_root t.store in
+ let ops = Transaction.get_paths t |> List.rev in
let do_op_watch op cons =
- let recurse = match (fst op) with
- | Xenbus.Xb.Op.Write -> false
- | Xenbus.Xb.Op.Mkdir -> false
- | Xenbus.Xb.Op.Rm -> true
- | Xenbus.Xb.Op.Setperms -> false
+ let recurse, oldroot, root = match (fst op) with
+ | Xenbus.Xb.Op.Write|Xenbus.Xb.Op.Mkdir -> false, None, newroot
+ | Xenbus.Xb.Op.Rm -> true, None, oldroot
+ | Xenbus.Xb.Op.Setperms -> false, Some oldroot, newroot
| _ -> raise (Failure "huh ?") in
- Connections.fire_watches cons (snd op) recurse in
+ Connections.fire_watches ?oldroot root cons (snd op) recurse in
List.iter (fun op -> do_op_watch op cons) ops
let create_implicit_path t perm path =
fct con t doms cons data;
Packet.Ack (fun () ->
if Transaction.get_id t = Transaction.none then
- process_watch (Transaction.get_paths t) cons
+ process_watch t cons
)
let reply_data fct con t doms cons data =
Connection.end_transaction c tid None
)
-let do_watch con t domains cons data =
+let do_watch con t _domains cons data =
let (node, token) =
match (split None '\000' data) with
| [node; token; ""] -> node, token
| _ -> raise Invalid_Cmd_Args
in
let watch = Connections.add_watch cons con node token in
- Packet.Ack (fun () -> Connection.fire_single_watch watch)
+ Packet.Ack (fun () ->
+ (* xenstore.txt says this watch is fired immediately,
+ implying even if path doesn't exist or is unreadable *)
+ Connection.fire_single_watch_unchecked watch)
let do_unwatch con t domains cons data =
let (node, token) =
if not success then
raise Transaction_again;
if commit then begin
- process_watch (List.rev (Transaction.get_paths t)) cons;
+ process_watch t cons;
match t.Transaction.ty with
| Transaction.No ->
() (* no need to record anything *)
else try
let ndom = Domains.create domains domid mfn port in
Connections.add_domain cons ndom;
- Connections.fire_spec_watches cons Store.Path.introduce_domain;
+ Connections.fire_spec_watches (Transaction.get_root t) cons Store.Path.introduce_domain;
ndom
with _ -> raise Invalid_Cmd_Args
in
Domains.del domains domid;
Connections.del_domain cons domid;
if fire_spec_watches
- then Connections.fire_spec_watches cons Store.Path.release_domain
+ then Connections.fire_spec_watches (Transaction.get_root t) cons Store.Path.release_domain
else raise Invalid_Cmd_Args
let do_resume con t domains cons data =
Transaction.none
| _ -> fun x -> x
+
+let () = Printexc.record_backtrace true
(**
* Nothrow guarantee.
*)
(* Put the response on the wire *)
send_response ty con t rid response
with exn ->
- error "process packet: %s" (Printexc.to_string exn);
+ let bt = Printexc.get_backtrace () in
+ error "process packet: %s. %s" (Printexc.to_string exn) bt;
Connection.send_error con tid rid "EIO"
let do_input store cons doms con =
start_count: int64;
store: Store.t; (* This is the store that we change in write operations. *)
quota: Quota.t;
+ oldroot: Store.Node.t;
mutable paths: (Xenbus.Xb.Op.operation * Store.Path.t) list;
mutable operations: (Packet.request * Packet.response) list;
mutable read_lowpath: Store.Path.t option;
start_count = !counter;
store = if id = none then store else Store.copy store;
quota = Quota.copy store.Store.quota;
+ oldroot = Store.get_root store;
paths = [];
operations = [];
read_lowpath = None;
let get_store t = t.store
let get_paths t = t.paths
+let get_root t = Store.get_root t.store
+
let is_read_only t = t.paths = []
let add_wop t ty path = t.paths <- (ty, path) :: t.paths
let add_operation ~perm t request response =
let (notify, deaddom) = Domains.cleanup domains in
List.iter (Connections.del_domain cons) deaddom;
if deaddom <> [] || notify then
- Connections.fire_spec_watches cons Store.Path.release_domain
+ Connections.fire_spec_watches
+ (Store.get_root store)
+ cons Store.Path.release_domain
)
else
let c = Connections.find_domain_by_port cons port in
projects / xen.git / commitdiff