Permalink
Browse files

[fix] db/transactions: various tiny fixes

  • Loading branch information...
1 parent 675bf67 commit cbe42b7efbeaa716400c12253a497214486e9dea Louis Gesbert committed Jul 19, 2011
Showing with 29 additions and 20 deletions.
  1. +20 −11 opabsl/mlbsl/opa_transaction.ml
  2. +9 −9 opabsl/mlbsl/path.ml
@@ -27,8 +27,13 @@ module E = Badop_engine
open C.Ops (* This file follows the duck-style cps guidelines © *)
##extern-type [normalize] status = \
- | Active of (Badoplink.database * Badoplink.transaction) list \
+ | Active of (Badop_engine.t * Badoplink.transaction) list \
| Aborted
+(*| Busy of (status C.continuation) Queue.t;
+ *todo*: to prevent
+ race-condition if ever two threads use the same transaction
+ simultaneously (at the time being, they would override each
+ other's transaction and write operations may be lost) *)
(* A sub-transaction is a transaction started within another one ;
it shares the status reference of its parent *)
@@ -69,31 +74,35 @@ let set_global_transaction db tr k =
| None ->
#<If:DBGEN_DEBUG> Logger.error "Set global transaction without context..." #<End>;
ServerLib.void |> set k {
- status = ref (Active [ db,tr ]);
+ status = ref (Active [ db.B.db_engine,tr ]);
sub = false;
};
| Some { status = { contents = Active trs } as status; _ } ->
- status := Active (update_tr db tr trs);
+ status := Active (update_tr db.B.db_engine tr trs);
ServerLib.void |> k
| Some { status = { contents = Aborted }; _ } ->
Logger.error "'set transaction' within a broken transaction context, this shouldn't happen";
ServerLib.void |> k
##register [opacapi;restricted:dbgen,cps-bypass] get_global_transaction_opt: \
- Badoplink.database, continuation(opa[option(Badoplink.transaction)]) -> void
+ Badoplink.database, continuation(opa[option(Badoplink.transaction)]) -> void
let get_db_transaction db k =
match get_opt k with
| None -> None |> k
| Some ({ status = { contents = Active trs }; _ } as t) -> (
- match Base.List.assq_opt db trs with
- | Some tr -> Some tr |> k
+ match Base.List.assq_opt db.B.db_engine trs with
+ | Some tr ->
+ Some tr |> k
| None ->
db.B.db_engine.E.tr_start db.B.db
(fun _exc ->
#<If:DBGEN_DEBUG> Logger.error "get_gl_trans/fail: %s" (Printexc.to_string _exc) #<End>;
abort t)
- @> fun tr -> Some { B. tr_engine = db.B.db_engine; tr = tr } |> k
+ @> fun tr ->
+ let tr = { B. tr_engine = db.B.db_engine; tr = tr } in
+ t.status := Active (update_tr db.B.db_engine tr trs);
+ Some tr |> k
)
| Some { status = { contents = Aborted }; _ } ->
Logger.error "'get transaction' within a broken transaction context, this shouldn't happen";
@@ -108,7 +117,7 @@ let init t dbs k = match !(t.status) with
| Active trs ->
C.iter_list
(fun db k ->
- match Base.List.assq_opt db trs with
+ match Base.List.assq_opt db.B.db_engine trs with
| Some _ -> () |> k
| None ->
db.B.db_engine.E.tr_start db.B.db
@@ -119,9 +128,9 @@ let init t dbs k = match !(t.status) with
match !(t.status) with
| Active trs ->
(* The call case in opa stdlib should guarantee this race condition doesn't happen *)
- assert (not (List.exists (fun (db',_) -> db' == db) trs));
+ assert (not (List.exists (fun (db',_) -> db' == db.B.db_engine) trs));
let tr = { B. tr_engine = db.B.db_engine; tr = tr } in
- t.status := Active ((db,tr) :: trs);
+ t.status := Active ((db.B.db_engine,tr) :: trs);
() |> k
| Aborted -> () |> k)
(BslNativeLib.opa_list_to_ocaml_list (fun db -> db) dbs)
@@ -211,7 +220,7 @@ let commit t k =
QmlCpsServerLib.map_list
(fun (db,tr) k ->
tr.B.tr_engine.E.tr_prepare tr.B.tr
- @> fun (tr,success) -> ({ B. tr_engine = db.B.db_engine; tr = tr }, success) |> k)
+ @> fun (tr,success) -> ({ B. tr_engine = db; tr = tr }, success) |> k)
trs
@> C.ccont_ml k
@> fun prepare_result ->
View
@@ -50,7 +50,7 @@ type ref_p_
(* Used for hidden embedded data in records: at first we put the current transaction, then
when accessed it's checked and may be turned into a revision if there is one that holds
the expected data. *)
-##extern-type [normalize] trans_or_rev = Transaction of Badoplink.transaction | Revision of Badoplink.revision
+##extern-type [normalize] trans_or_rev = Transaction of Badoplink.transaction | Revision of Badop_engine.t * Badoplink.revision
##extern-type [normalize] embed_info = { embedded_path: Badoplink.path; embedded_transaction: trans_or_rev }
@@ -104,7 +104,7 @@ let get_lazy_info_opt r k =
@> function
| `Answer (Badop.Stat (D.Response (_path, Some rev, _kind))) ->
(* The info is valid and bound to revision rev ; update the lazy data *)
- let embed_info = { embed_info with embedded_transaction = Revision rev } in
+ let embed_info = { embed_info with embedded_transaction = Revision (tr.B.tr_engine,rev) } in
ignore (ServerLib.inject_lazy_data record (Some (`path (Obj.repr embed_info))));
ServerLib.wrap_option (Some embed_info) |> k
| _ -> (* The info is not valid (doesn't belong to a committed rev) *)
@@ -290,17 +290,17 @@ let do_in_trans
##register [opacapi;restricted:dbgen,cps-bypass] copy: Badoplink.transaction, embed_info, Badoplink.path, continuation(Badoplink.transaction) -> void
let copy tr embed dbpath k =
- (* FIXME: we need to check that we don't copy between different databases,
- otherwise Sharing + MultiDB = *BOOM* *)
match embed.embedded_transaction with
| Transaction _ ->
Badoplink.error "Bad internal copy query from a transaction" @> k
(* this should have been resolved to a Revision or discarded by get_lazy_data_opt *)
- | Revision revision ->
- tr.B.tr_engine.E.write tr.B.tr dbpath (Badop.Copy (D.query (embed.embedded_path, Some revision)))
- @> function
- | Badop.Copy (D.Response resp) -> { tr with Badoplink.tr = resp } |> k
- | _ -> assert false
+ | Revision (engine,revision) when engine == tr.B.tr_engine ->
+ (tr.B.tr_engine.E.write tr.B.tr dbpath (Badop.Copy (D.query (embed.embedded_path, Some revision)))
+ @> function
+ | Badop.Copy (D.Response resp) -> { tr with Badoplink.tr = resp } |> k
+ | _ -> assert false)
+ | _ ->
+ Badoplink.error "Error: attempt to share between databases; fixme" @> k
##register[cps-bypass] write: t( ref_p, 'a), 'a, continuation(opa[void]) -> void
let write t x k = match t with

0 comments on commit cbe42b7

Please sign in to comment.