1(*
2 * Copyright (c) 2017 Citrix Systems Ltd.
3 *
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU Lesser General Public License as published
6 * by the Free Software Foundation; version 2.1 only. with the special
7 * exception on linking described in file LICENSE.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 * GNU Lesser General Public License for more details.
13 *)
14
15type history_record = {
16  con: Connection.t;   (* connection that made a change *)
17  tid: int;            (* transaction id of the change (may be Transaction.none) *)
18  before: Store.t;     (* the store before the change *)
19  after: Store.t;      (* the store after the change *)
20  finish_count: int64; (* the commit-count at which the transaction finished *)
21}
22
23let history : history_record list ref = ref []
24
25(* Keep only enough commit-history to protect the running transactions that we are still tracking *)
26(* There is scope for optimisation here, replacing List.filter with something more efficient,
27 * probably on a different list-like structure. *)
28let trim ?txn () =
29  Transaction.trim_short_running_transactions txn;
30  history := match Transaction.oldest_short_running_transaction () with
31    | None -> [] (* We have no open transaction, so no history is needed *)
32    | Some (_, txn) -> (
33        (* keep records with finish_count recent enough to be relevant *)
34        List.filter (fun r -> r.finish_count > txn.Transaction.start_count) !history
35      )
36
37let end_transaction txn con tid commit =
38  let success = Connection.end_transaction con tid commit in
39  trim ~txn ();
40  success
41
42let reconnect con =
43  trim ();
44  Connection.do_reconnect con
45
46let push (x: history_record) =
47  let dom = x.con.Connection.dom in
48  match dom with
49  | None -> () (* treat socket connections as always free to conflict *)
50  | Some d -> if not (Domain.is_free_to_conflict d) then history := x :: !history
51
52(* Find the connections from records since commit-count [since] for which [f record] returns [true] *)
53let filter_connections ~ignore ~since ~f =
54  (* The "mem" call is an optimisation, to avoid calling f if we have picked con already. *)
55  (* Using a hash table rather than a list is to optimise the "mem" call. *)
56  List.fold_left (fun acc hist_rec ->
57      if hist_rec.finish_count > since
58      && not (hist_rec.con == ignore)
59      && not (Hashtbl.mem acc hist_rec.con)
60      && f hist_rec
61      then Hashtbl.replace acc hist_rec.con ();
62      acc
63    ) (Hashtbl.create 1023) !history
64