Lines Matching refs:t
46 (* when we don't want a limit, apply a max limit of 8 arguments.
70 let create_implicit_path t perm path =
72 if not (Transaction.path_exists t dirname) then (
77 if Transaction.path_exists t h then
82 List.iter (fun s -> Transaction.mkdir ~with_watch:false t perm s) ret
86 let do_debug con t domains cons data =
95 let quota = (Store.get_quota t.Transaction.store) in
107 let do_directory con t domains cons data =
109 let entries = Transaction.ls t (Connection.get_perm con) path in
115 let do_read con t domains cons data =
117 Transaction.read t (Connection.get_perm con) path
119 let do_getperms con t domains cons data =
121 let perms = Transaction.getperms t (Connection.get_perm con) path in
124 let do_getdomainpath con t domains cons data =
132 let do_write con t domains cons data =
138 create_implicit_path t (Connection.get_perm con) path;
139 Transaction.write t (Connection.get_perm con) path value
141 let do_mkdir con t domains cons data =
143 create_implicit_path t (Connection.get_perm con) path;
145 Transaction.mkdir t (Connection.get_perm con) path
149 let do_rm con t domains cons data =
152 Transaction.rm t (Connection.get_perm con) path
156 let do_setperms con t domains cons data =
164 Transaction.setperms t (Connection.get_perm con) path perms
166 let do_error con t domains cons data =
169 let do_isintroduced con t domains cons data =
178 let do_reset_watches con t domains cons data =
183 let do_set_target con t domains cons data =
191 let send_response ty con t rid response =
194 Connection.send_ack con (Transaction.get_id t) rid ty;
198 Connection.send_reply con (Transaction.get_id t) rid ty ret
200 Connection.send_error con (Transaction.get_id t) rid e
202 let reply_ack fct con t doms cons data =
203 fct con t doms cons data;
205 if Transaction.get_id t = Transaction.none then
206 process_watch (Transaction.get_paths t) cons
209 let reply_data fct con t doms cons data =
210 let ret = fct con t doms cons data in
213 let reply_data_or_ack fct con t doms cons data =
214 match fct con t doms cons data with
218 let reply_none fct con t doms cons data =
220 fct con t doms cons data
248 let input_handle_error ~cons ~doms ~fct ~con ~t ~req =
252 fct con t doms cons req.Packet.data
291 let transaction_replay c t doms cons =
292 match t.Transaction.ty with
304 let response' = input_handle_error ~cons ~doms ~fct ~con:c ~t:txn ~req:request in
312 … List.iter (perform_exn ~wlog:true replay_t) (Transaction.get_operations t); (* May throw EAGAIN *)
330 try List.iter (perform_exn ~wlog:false trial_t) (Transaction.get_operations t);
339 …let guilty_cons = History.filter_connections ~ignore:c ~since:t.Transaction.start_count ~f:judge_a…
354 let do_watch con t domains cons data =
363 let do_unwatch con t domains cons data =
371 let do_transaction_start con t domains cons data =
372 if Transaction.get_id t <> Transaction.none then
374 let store = Transaction.get_store t in
377 let do_transaction_end con t domains cons data =
385 let commit = commit && not (Transaction.is_read_only t) in
388 History.end_transaction t con (Transaction.get_id t) commit in
392 process_watch (List.rev (Transaction.get_paths t)) cons;
393 match t.Transaction.ty with
400 let do_introduce con t domains cons data =
423 let do_release con t domains cons data =
438 let do_resume con t domains cons data =
505 let t =
512 let execute () = input_handle_error ~cons ~doms ~fct ~con ~t ~req in
528 Transaction.add_operation ~perm:(Connection.get_perm con) t req response;
535 send_response ty con t rid response
561 (* As we don't log IO, do not call an unnecessary sanitize_data
575 (* As we don't log IO, do not call an unnecessary sanitize_data