Lines Matching refs:t
46 (* when we don't want a limit, apply a max limit of 8 arguments.
59 let process_watch t cons =
60 let oldroot = t.Transaction.oldroot in
61 let newroot = Store.get_root t.store in
62 let ops = Transaction.get_paths t |> List.rev in
72 let create_implicit_path t perm path =
74 if not (Transaction.path_exists t dirname) then (
79 if Transaction.path_exists t h then
84 List.iter (fun s -> Transaction.mkdir ~with_watch:false t perm s) ret
88 let do_debug con t _domains cons data =
97 let quota = (Store.get_quota t.Transaction.store) in
109 let do_directory con t _domains _cons data =
111 let entries = Transaction.ls t (Connection.get_perm con) path in
117 let do_read con t _domains _cons data =
119 Transaction.read t (Connection.get_perm con) path
121 let do_getperms con t _domains _cons data =
123 let perms = Transaction.getperms t (Connection.get_perm con) path in
134 let do_write con t _domains _cons data =
140 create_implicit_path t (Connection.get_perm con) path;
141 Transaction.write t (Connection.get_perm con) path value
143 let do_mkdir con t _domains _cons data =
145 create_implicit_path t (Connection.get_perm con) path;
147 Transaction.mkdir t (Connection.get_perm con) path
151 let do_rm con t _domains _cons data =
154 Transaction.rm t (Connection.get_perm con) path
158 let do_setperms con t _domains _cons data =
166 Transaction.setperms t (Connection.get_perm con) path perms
195 let send_response ty con t rid response =
198 Connection.send_ack con (Transaction.get_id t) rid ty;
202 Connection.send_reply con (Transaction.get_id t) rid ty ret
204 Connection.send_error con (Transaction.get_id t) rid e
206 let reply_ack fct con t doms cons data =
207 fct con t doms cons data;
209 if Transaction.get_id t = Transaction.none then
210 process_watch t cons
213 let reply_data fct con t doms cons data =
214 let ret = fct con t doms cons data in
217 let reply_data_or_ack fct con t doms cons data =
218 match fct con t doms cons data with
222 let reply_none fct con t doms cons data =
224 fct con t doms cons data
252 let input_handle_error ~cons ~doms ~fct ~con ~t ~req =
256 fct con t doms cons req.Packet.data
295 let transaction_replay c t doms cons =
296 match t.Transaction.ty with
308 let response' = input_handle_error ~cons ~doms ~fct ~con:c ~t:txn ~req:request in
316 … List.iter (perform_exn ~wlog:true replay_t) (Transaction.get_operations t); (* May throw EAGAIN *)
334 try List.iter (perform_exn ~wlog:false trial_t) (Transaction.get_operations t);
343 …let guilty_cons = History.filter_connections ~ignore:c ~since:t.Transaction.start_count ~f:judge_a…
358 let do_watch con t _domains cons data =
367 implying even if path doesn't exist or is unreadable *)
378 let do_transaction_start con t _domains _cons _data =
379 if Transaction.get_id t <> Transaction.none then
381 let store = Transaction.get_store t in
384 let do_transaction_end con t domains cons data =
392 let commit = commit && not (Transaction.is_read_only t) in
395 History.end_transaction t con (Transaction.get_id t) commit in
399 process_watch t cons;
400 match t.Transaction.ty with
407 let do_introduce con t domains cons data =
428 Connections.fire_spec_watches (Transaction.get_root t) cons Store.Path.introduce_domain;
435 let do_release con t domains cons data =
446 Store.reset_permissions (Transaction.get_store t) domid;
448 then Connections.fire_spec_watches (Transaction.get_root t) cons Store.Path.release_domain
527 let t =
534 let execute () = input_handle_error ~cons ~doms ~fct ~con ~t ~req in
550 Transaction.add_operation ~perm:(Connection.get_perm con) t req response;
557 send_response ty con t rid response
584 (* As we don't log IO, do not call an unnecessary sanitize_data
598 (* As we don't log IO, do not call an unnecessary sanitize_data