Skip to content
This repository
Newer
Older
100644 866 lines (747 sloc) 31.883 kb
fccc6851 » MLstate
2011-06-21 Initial open-source release
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (* depends *)
19
20 (* shorthands *)
21 module DT = DbTypes
22
23 (* debug *)
24 #<Debugvar:DEBUG_DB$minlevel 1>
25
26 (* -- *)
27
28
29 (* shorthands *)
30 type 'a intmap = 'a IntMap.t
31 module List = BaseList
32 module Tr = Transaction
33
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
34 module WIM = Weak.Make(struct
35 type t = Tr.t
36 let equal a b = compare (Tr.get_num a) (Tr.get_num b) = 0
37 let hash = Tr.get_num
38 end)
39
fccc6851 » MLstate
2011-06-21 Initial open-source release
40 (* The queue of transaction numbers, stored in order of appearance,
41 helps in choosing the next prepare to do (the longest waiting).
42 TODO: it's imperative; perhaps do this functionally? *)
43 type tr_FIFO = (Tr.t * (Tr.t * bool -> unit)) Queue.t
44
45 let is_empty_FIFO queue = Queue.is_empty queue
46
47 let create_FIFO () = Queue.create ()
48
49 let add_FIFO trans k queue = Queue.add (trans, k) queue
50
51 let take_FIFO queue = Queue.take queue
52
53 type lock = (Tr.t * Hldb.t) option
54 (* It stores a transaction and the new db after applying it,
55 which will become official if the commit of the
56 transaction is requested and succeeds. Whichever part of the code
57 releases the lock is responsible for taking the oldest transaction
58 from the waiting FIFO and preparing it. *)
59
60 type t = { mutable trans_num : int
61 (* counter for fresh transaciton serial numbers *)
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
62 ; init_map : WIM.t
fccc6851 » MLstate
2011-06-21 Initial open-source release
63 (* map of the not commited and not rolled back transactions
64 initialised under given revisions; no empty lists allowed;
65 used only for optimization, to shorten db_to_merge *)
66 ; mutable db_ref : Hldb.t
67 (* the reference db passed to new transactions *)
68 ; mutable db_to_merge : QueryMap.t intmap
69 (* query maps of transactions, indexed by revisions at which
70 the transactions were commited, from the first revision
71 which can still cause a conflict (minimal revision of init_map)
72 to the current revision
73 TODO: later, use [GC.finalise f x] on the transactions
74 or weak references in init_map to prune db_to_merge
75 and init_map whenever we verify that
76 up to certain revision all transactions are not accessible
77 from OPA anymore (GC-cleaned). *)
78 ; with_dot : bool
79 ; is_weak : bool
80 ; is_readonly: bool
81 ; file_manager : IoManager.t
82 ; mutable session_lock : lock
83 ; waiting_FIFO : tr_FIFO
84 (* The queue stores the waiting transactions with their revisions,
85 as well as the continuations to execute asynchronously,
86 when prepare of the transactions is over
87 (usually the continuation will execute a commit operation
88 or send a confirmation to the client, which may then request
89 the commit operation). *)
90 ; mutable inital_revision : Revision.t
91 (* First revision of the db at the opening. Used to write or not last db state *)
92 }
93
94 (* exceptions *)
95 exception Open of (t option * string)
96 exception DiskError of string
97
98
99 let write_limit = 1000
100
101 (******************)
102 (* lecture disque *)
103 (******************)
104
105 let read_node_from_disk t uid =
106 IoManager.read_specific_node t.file_manager uid
107
108 let read_uid_rev ?rev t =
109 IoManager.read_uid_rev ?rev t.file_manager
110
111 (** The version number of the DB code is hardcoded here. Version is written
112 to the DB _config file. Other general summary information about
113 the DB may go into that file, too, in the future. If there is
114 no _config file, the version is assumed to be correct.
115 Warning: Whenever the DB format changes to incompatible one,
116 please bump the version number up. *)
117
118 let db_code_version_number = 25
119
120 let read_version t =
121 let fm = t.file_manager in
122 let vers = IoManager.read_version fm in
123 if vers <> db_code_version_number then
124 Migration.update vers db_code_version_number (IoManager.get_filemanager fm)
125
126 let write_version t =
127 IoManager.write_version t.file_manager db_code_version_number
128
129
130 let read_config t =
131 let conf = IoManager.read_config t.file_manager in
132 let vers = conf.DT.version in
133 if vers <> db_code_version_number then
134 Migration.update vers db_code_version_number (IoManager.get_filemanager t.file_manager);
135 conf.DT.snapshot_rev
136
137 let write_config t rev =
138 IoManager.write_config t.file_manager
139 { DT.
140 version = db_code_version_number ;
141 snapshot_rev = rev ;
142 }
143
144 (*******************)
145 (* ecriture disque *)
146 (*******************)
147
148 let write_last_db_state t =
149 let fm = t.file_manager in
150 let uidmap = Hldb.get_uid_map t.db_ref in
151 let index = Hldb.get_index t.db_ref in
152 IoManager.write_dbstate fm ~uidmap ~index ;
153 write_config t (Hldb.get_rev t.db_ref)
154
155 let write_uid_rev t =
156 let fm = t.file_manager in
157 let tcount = Hldb.get_tcount t.db_ref in
158 let next_uid = Hldb.get_next_uid t.db_ref in
159 let rev = Hldb.get_rev t.db_ref in
160 let uidrevfile = {
161 DT.
162 eid = tcount ;
163 uid = next_uid ;
164 rev
165 } in
166 IoManager.write_uid_rev fm uidrevfile
167
168 let write_trans t tr =
169 let fm = t.file_manager in
170 let transfile = Tr.append_disk tr in
171 IoManager.write_trans fm transfile
172
173 let write_nodes t =
174 let fm = t.file_manager in
175 let last_nodes = Hldb.get_last_nodes t.db_ref in
176 IoManager.write_nodes fm last_nodes
177
178 let write_timestamp t ts =
179 let fm = t.file_manager in
180 IoManager.write_timestamp fm ts
181
182 let write_flags t =
183 let fm = t.file_manager in
184 IoManager.write_flags fm
185
186 let disk_writing t ?trans rev =
187 if t.with_dot then Dot.generation t.db_ref t.file_manager;
188 if t.is_readonly then
189 Logger.error "Database opened only on read_only mode. Will not write the transaction"
190 else
191 try
192 #<If> Logger.log ~color:`green "DB : writing nodes" #<End>;
193 write_nodes t;
194 #<If> Logger.log ~color:`green "DB : writing the rest" #<End>;
195 write_timestamp t (Time.now());
196 Option.iter (fun tr -> write_trans t tr) trans;
197 write_uid_rev t;
198 write_flags t;
199 let vrev = Revision.value rev in
200 if (vrev mod write_limit = 0 && vrev > 0) then
201 (#<If> Logger.log ~color:`green "Write a database snapshot, revision %d" vrev #<End>;
202 write_last_db_state t)
203 with e -> (
204 let cause = Printexc.to_string e in
205 let bt = Printexc.get_backtrace() in
206 #<If>
207 Logger.error "DB : error during disk writing for revision\n%s\n%s\n%s"
208 (Revision.to_string rev) cause bt
209 #<End>;
210 raise (DiskError (Printf.sprintf "%s\n%s" cause bt)))
211
212
213 (************************)
214 (* timestamps managment *)
215 (************************)
216
217 let get_timestamp = Time.now
218
219 let get_timestamp_from_rev t rev =
220 #<If>
221 Logger.log ~color:`yellow
222 "DB : get timestamp for revision %s" (Revision.to_string rev)
223 #<End>;
92a3160c » Raja
2011-07-08 [fix] compilation: forgotten line
224 let dbrev = Hldb.get_rev (t.db_ref) in
36362ced » Raja
2011-07-08 [fix] db: catch timestamp read exception
225 try IoManager.read_timestamp t.file_manager (Revision.value rev)
226 with DT.CrashTimestamp ->
227 raise (DiskError (Printf.sprintf "Timestamp: try to read an uncommitted revision (%s vs %s)"
228 (Revision.to_string rev) (Revision.to_string dbrev)))
fccc6851 » MLstate
2011-06-21 Initial open-source release
229
230
231 (************************************)
232 (* ouverture / fermeture de session *)
233 (************************************)
234
235 let make_lock_file fm =
236 let file = IoManager.get_location fm in
237 if IoManager.lock_file fm then
238 #<If>
239 Logger.log ~color:`yellow "DB : create lock_file %s_lock" file
240 #<End>
241 else
242 (Logger.critical "The database '%s' is currently used by anoter application." file;
243 IoManager.close fm;
244 exit 1)
245
246 let position file =
247 if Filename.is_relative file
248 then Printf.sprintf "%s/" (Unix.getcwd ())
249 else ""
250
251 let init_db mode file =
252 let rep = Filename.dirname file in
253 let _ =
254 try
255 if not (File.check_create_path rep) then
256 raise (Open (None, (Printf.sprintf "%s: unable to create path" rep)))
257 with
258 | Unix.Unix_error (r, f, p) ->
259 let s = Printf.sprintf "%s %s => %s" f p (Unix.error_message r) in
260 raise (Open (None,s))
261 | e -> raise (Open (None, Printexc.to_string e)) in
262 let db = Hldb.make () in
263 { trans_num = 0
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
264 ; init_map = WIM.create 11
fccc6851 » MLstate
2011-06-21 Initial open-source release
265 ; db_ref = db
266 ; db_to_merge = IntMap.empty
267 ; with_dot = false
268 ; is_weak = false
269 ; is_readonly = false
270 ; file_manager = IoManager.create mode file
271 ; session_lock = None
272 ; waiting_FIFO = create_FIFO ()
273 ; inital_revision = Revision.make 0;
274 }
275
276 let make ?(readonly=false) ?dot ?weak file =
277 if readonly then
278 raise (Open (None, Printf.sprintf "Can not open on readonly a new database. check path '%s'" file));
279
280 let t = init_db `create file in
281 make_lock_file t.file_manager;
282 let _position = position file in
283 let _dot, with_dot = match dot with
284 | Some true -> "with", true
285 | Some false | None -> "without", false in
286
287 let _disk, weak, is_weak = match weak with
288 | Some true -> "reading on disk", Some (read_node_from_disk t), true
289 | Some false | None -> "ram only", None, false in
290 #<If>
291 Logger.log "Opening a new DB %s dot files, %s at %s%s%s by %s"
292 _dot _disk _position file (if readonly then ", on readonly," else "")
293 (Sys.executable_name)
294 #<End>;
295 let db = Hldb.make ?weak () in
296 {t with db_ref = db
297 ; is_weak = is_weak
298 ; with_dot = with_dot }
299
300 let close_db ?(donothing=false) t =
301 let file = IoManager.get_location t.file_manager in
302 let _position = position file in
37c04ece » Louis Gesbert
2011-06-28 [cleanup] Makefile,comments: tiny cleanup & fixes
303 Logger.info "Closing the database%s" (#<If:TESTING> "" #<Else> " at "^ file #<End>);
fccc6851 » MLstate
2011-06-21 Initial open-source release
304 #<If>
305 Logger.log ~color:`yellow "Please wait, closing DB at %s%s" _position file
306 #<End>;
307 let cur_rev = Hldb.get_rev t.db_ref in
308
309 #<If:DB3_NO_FINAL_SNAPSHOT>
310 ()
311 #<Else>
312 if donothing then ()
313 else
314 if Revision.equal t.inital_revision cur_rev
315 then (
316 #<If> Logger.log ~color:`yellow "No changes in the db : skip snapshot" #<End>;
317 (* write_config t cur_rev *) ()
318 )
319 else
320 write_last_db_state t
321 #<End>;
322
323 IoManager.close t.file_manager;
324
325 #<If>
326 Logger.log ~color:`yellow "DB '%s%s' closed" _position file
327 #<End>
328
329 let read_last_db_state t cur_rev tcount nuid =
330 let { DT.uidmap ; index } = IoManager.read_dbstate t.file_manager in
331 let nodemap = IoManager.read_nodes t.file_manager in
332 Hldb.restart ~index cur_rev tcount nuid uidmap nodemap
333
334
335 let replay_trans ?until t db =
336 let transs = IoManager.read_transs t.file_manager in
337 let continue : Revision.t -> bool=
338 match until with
339 | None -> (fun _ -> true)
340 | Some openat -> (fun r -> Revision.compare r openat = -1) in
341 let _, db =
342 List.fold_left
343 (fun (rev, db) trans ->
344 if continue rev then Tr.apply_disk trans db rev
345 else (rev, db))
346 ((Hldb.get_rev db), db) transs in
347 db
348
349
350 let check_coherence t vlastsn vrev =
351 if not (vlastsn <= vrev) then
352 (Logger.critical "Database error : Incoherente state.\nLast snapshot's revision (%d) is greater than last revision (%d)" vlastsn vrev;
353 IoManager.close t.file_manager;
354 exit 1)
355
356 let restart_db_from_last ?weak t lastsn uidrevfile =
357 let tcount = uidrevfile.DT.eid
358 and nuid = uidrevfile.DT.uid
359 and rev = uidrevfile.DT.rev in
360 let vrev = Revision.value rev in
361 let vlastsn = Revision.value lastsn in
362
363 check_coherence t vlastsn vrev;
364
365 t.inital_revision <- rev;
366
367 let db =
368 (* no taken snapshot *)
369 if vlastsn = 0 then
370 (let db = Hldb.make ?weak () in
371 let db = Hldb.clean_tmp_maps db in
372 replay_trans t db)
373 else if vlastsn = vrev then
374 (* we are on the last snapshot rev *)
375 read_last_db_state t rev tcount nuid
376 else (
377 (* we have to replay transactions to complete snapshot *)
378 let old_uidrevfile = read_uid_rev ~rev:lastsn t in
379 let old_tcount = old_uidrevfile.DT.eid
380 and old_nuid = old_uidrevfile.DT.uid
381 and old_cur_rev = old_uidrevfile.DT.rev in
382 let db = read_last_db_state t old_cur_rev old_tcount old_nuid in
383 replay_trans t db)
384 in db
385
386 let restart_db_from_rev open_at_rev t lastsn uidrevfile =
387
388 t.inital_revision <- open_at_rev;
389
390 let tcount = uidrevfile.DT.eid
391 and nuid = uidrevfile.DT.uid
392 and rev = uidrevfile.DT.rev in
393 let vrev = Revision.value rev in
394 let vlastsn = Revision.value lastsn in
395
396 check_coherence t vlastsn vrev;
397 (* Read the db state, and if we want to open before last taken snapshot, we restore previous state *)
398 let read_and_restore_db_state t rev eid uid =
399 let db = read_last_db_state t rev eid uid in
400 if not (Revision.equal rev open_at_rev) then
401 RevisionMachine.gotorevision t.file_manager db open_at_rev
402 else db in
403
404 (* replay transaction, until wanted revision *)
405 let replay_trans_and_seek t db =
406 let db = replay_trans ~until:open_at_rev t db in
407 RevisionMachine.overwrite_files t.file_manager db;
408 db in
409
410 let db =
411 (* no taken snapshot *)
412 if vlastsn = 0 then
413 (let db = Hldb.make () in
414 let db = Hldb.clean_tmp_maps db in
415 replay_trans_and_seek t db)
416 else if vlastsn = vrev then
417 (* we are on the last snapshot rev *)
418 read_and_restore_db_state t rev tcount nuid
419 else (
420 (* we have to replay transactions to complete snapshot *)
421 let old_uidrevfile = read_uid_rev ~rev:lastsn t in
422 let old_tcount = old_uidrevfile.DT.eid
423 and old_nuid = old_uidrevfile.DT.uid
424 and old_cur_rev = old_uidrevfile.DT.rev in
425 let db = read_and_restore_db_state t old_cur_rev old_tcount old_nuid in
426 (* if we want to open before last_snapshot, no need to replay transactions
427 * in the other case, we replay only transaction that we need *)
428 if Revision.compare lastsn open_at_rev = -1 then db
429 else replay_trans_and_seek t db
430 )
431 in db
432
433 let restart_db ?(readonly=false) ?dot ?weak ?restore ?openat_rev file =
434 (* just set some options *)
435 let restore = Option.is_some restore in
436
437 let mode = if readonly then `readonly else `append in
438 let t = init_db mode file in
439 (* the check is after opening all files because we need a new filemanager to get lock filename *)
440 if not readonly then
441 make_lock_file t.file_manager;
442
443 read_version t;
444 let lastsn = read_config t in
445
446 let uidrevfile, lastsn =
447 try (read_uid_rev t, lastsn)
448 with DT.CrashUidRev _ ->
449 (match RevisionMachine.restore_uid_file ~restore t.file_manager with
450 | None -> raise (Open (None,"Corrupted files"))
451 | Some uidrev ->
452 let sn = if Revision.compare lastsn uidrev.DT.rev = 1 then uidrev.DT.rev else lastsn in
453 uidrev,sn) in
454
455
456 let opt_weak = weak in
457 let _position = position file in
458 let _dot, with_dot = match dot with
459 | Some true -> "with", true
460 | Some false | None -> "without", false in
461 let _disk, weak, is_weak = match weak with
462 | Some true -> "reading on disk", Some (read_node_from_disk t), true
463 | Some false | None -> "ram only", None, false in
464
465 #<If>
466 Logger.log "Opening an existing DB %s dot files, %s at %s%s%s by %s"
467 _dot _disk _position file (if readonly then ", on readonly," else "")
468 (Sys.executable_name)
469 #<End>;
470 let t = {t with is_weak = is_weak
471 ; with_dot = with_dot }
472 in
473
474 let restart =
475 match openat_rev with
476 | Some openat_rev ->
477 let from =
478 if Option.default false opt_weak then
479 (Logger.warning "DB: the db is opened on weak mode, can't do the downgrade";
480 false)
481 else
482 if Revision.compare openat_rev uidrevfile.DT.rev <> -1 then
483 (Logger.warning "DB: Can not downgrade the db to an upper revision. Last revison is %s, you want to open at %s"
484 (Revision.to_string uidrevfile.DT.rev) (Revision.to_string openat_rev);
485 false)
486 else true in
487
488 if from then restart_db_from_rev openat_rev t
489 else restart_db_from_last ?weak t
490 | None ->
491 restart_db_from_last ?weak t
492 in
493
494 let db =
495 try restart lastsn uidrevfile
496 with DT.CrashUidRev _ | DT.CrashStateMap _ | DT.CrashNode _| DT.CrashTrans _ | DT.CrashStateIndex _ ->
497 (let rest = RevisionMachine.restore_db ~uidrev:uidrevfile ~restore t.file_manager in
498 match rest with
499 | Some db -> db
500 | None -> raise (Open (None, "Corrupted files")))
501 in
502
503 t.db_ref <- db;
504 IoManager.cleanup_hashtbls () ;
505 t
506
507
508 let open_db_aux ?(readonly=false) ?dot ?weak ?rev ?restore file =
509 let _starting_time = Unix.gettimeofday() in
510 let pretty_location = #<If:TESTING> "" #<Else> " at "^file #<End> in
511 if file = "" then raise (Open (None, "empty name"))
512 else
513 let is_new, session = match rev with
514 | Some r ->
515 if IoManager.is_uidfile_existing file
516 then (
517 Logger.info "Opening database%s (using revision %d)" pretty_location r;
518 false, restart_db ~readonly ?dot ?weak ?restore ~openat_rev:(Revision.make r) file
519 )
520 else raise (Open (None,(Printf.sprintf "%s : no such file or directory" file)))
521 | None ->
522 if IoManager.is_uidfile_existing file
523 then (
524 Logger.info "Opening database%s" pretty_location;
525 false, restart_db ~readonly ?dot ?weak ?restore file
526 )
527 else (
528 Logger.info "Initialising empty database%s" pretty_location;
529 true, make ~readonly ?dot ?weak file
530 )
531 in
532 let db = session.db_ref in
533 if is_new then (
534 let _ =
535 try
536 write_version session;
537 disk_writing session (Revision.make 0)
538 with DiskError s -> (
539 Logger.error "disk writing error : %s" s;
978b7c43 » akoprow
2011-07-09 [fix] typo: occurence->occurrence, occured->occurred
540 (* an error occurred during disk writing for the first revision.
fccc6851 » MLstate
2011-06-21 Initial open-source release
541 doesn't seems good for the further writings.
542 so the db is being closed.
543 *)
544 close_db session;
545 let s = "an error happened during disk writing. We advise that you choose another place for your db." in
546 raise (Open (Some session, s))
547 ) in
548 let db = Hldb.clean_tmp_maps db in
549 session.db_ref <- db
550 );
551 #<If>
552 Logger.log "time to open = %f" (Unix.gettimeofday() -. _starting_time)
553 #<End>;
554 session, is_new
555
556 let open_db ?(readonly=false) ?dot ?weak ?rev ?restore file =
557 try open_db_aux ~readonly ?dot ?weak ?rev ?restore file
558 with Open (db, s) ->
559 (Option.iter (fun db -> close_db ~donothing:true db) db;
560 Logger.critical "Error during database opening :\n%s" s;
561 exit 1)
562
563
564 let is_empty t = Hldb.is_empty t.db_ref
565
566 let get_rev t = Hldb.get_rev t.db_ref
567
568
569 (*******************)
570 (* les transactions*)
571 (*******************)
572
573 let is_closed_db t =
574 not(IoManager.is_open t.file_manager )
575
576 let new_trans ?read_only t =
577 assert (not (is_closed_db t));
578 let rightsreadonly = (Option.default_map false fst read_only) || t.is_readonly in
579 let tr_read_only = if rightsreadonly then Some(true, Option.default_map None snd read_only) else None in
580
581
582 let trans_num = (succ t.trans_num) mod max_int in
583 t.trans_num <- trans_num;
584 #<If>
585 Logger.log ~color:`white
586 "Initialisation of a new transaction%swith number #%d on a DB at revision %s"
587 (if rightsreadonly then " read only " else " ")
588 trans_num
589 (Revision.to_string (Hldb.get_rev t.db_ref))
590 #<End>;
591 let tr =
592 match tr_read_only with
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
593 | Some read_only -> Tr.init t.db_ref ~read_only trans_num
594 | None -> Tr.init t.db_ref trans_num
fccc6851 » MLstate
2011-06-21 Initial open-source release
595 in
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
596
fccc6851 » MLstate
2011-06-21 Initial open-source release
597 match read_only with
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
598 | Some (true, _) -> tr
599 | _ -> WIM.add t.init_map tr; tr
fccc6851 » MLstate
2011-06-21 Initial open-source release
600
601 let shrink_db_to_merge t =
602 if (IntMap.is_empty t.db_to_merge
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
603 || WIM.count t.init_map = 0)
fccc6851 » MLstate
2011-06-21 Initial open-source release
604 then
605 IntMap.empty
606 else
607 let (min, _) = IntMap.min t.db_to_merge in
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
608 let min_used =
609 (WIM.fold
610 (fun tr acc ->
611 if acc = -1 then
612 (Revision.value (Hldb.get_rev (Tr.get_db tr)))
613 else
614 (Pervasives.min acc (Revision.value (Hldb.get_rev (Tr.get_db tr)))))
615 t.init_map (-1)) in
616 let rm k _v acc = IntMap.remove k acc in
fccc6851 » MLstate
2011-06-21 Initial open-source release
617 IntMap.fold_range rm t.db_to_merge min min_used t.db_to_merge
618
619 let abort_of_unprepared t _trans =
620 assert (t.session_lock = None);
621 (* No transaction is prepared at this time, so the one from
622 argument must be unprepared, so do nothing. GC will take care
623 of cleaning it. *)
624 #<If>
625 Logger.log ~color:`red
626 "Abort of unprepared transaction or of the continuation of committed transaction #%d."
627 (Tr.get_num _trans)
628 #<End>;
629 (* Not removed from init_map, because at the higher level
630 it may be wiped up and rebuilt differently, so it still exists. *)
631 ()
632
633 let _prepare_commit db_ref db_to_merge cur_rev trans =
634 #<If>
635 Logger.log ~color:`white "Preparing commit of transaction #%d with revision %s on a DB at revision %s."
636 (Tr.get_num trans) (Revision.to_string cur_rev) (Revision.to_string (Hldb.get_rev db_ref))
637 #<End>;
638 (* Here we looking for conflicts by trying to merge with query maps
639 from all revisions from the first revision that we haven't taken
640 into account when starting (trans_vrev + 1) to the revision previous
641 to the one we will be commited under (cur_vrev - 1).
642 This is linear in the number of concurrently started transactions,
643 so the time to prepare n transactions is quadratic in n.
644 Conclusion: it's much cheaper to start transactions sequentially. *)
645 (* TODO: this is still wrong when the interviening transactions
646 change links and then conflicting writes are not registered.
647 Louis says we should unwind the links and keep only unwound
648 writes in the query maps. TODO: Check if we already do. *)
649 let cur_vrev = Revision.value cur_rev in
650 let trans_rev = Hldb.get_rev (Tr.get_db trans) in
651 let trans_vrev = Revision.value trans_rev in
652 let trqm = Tr.get_query_map trans in
653 let check _rev qmap () = QueryMap.mergeable_query_maps qmap trqm
654 in
655 IntMap.fold_range check db_to_merge (trans_vrev + 1) (cur_vrev - 1) ();
656 Tr.commit cur_rev trans db_ref
657
658 (* Never runs the continuation [k]. *)
659 let prepare_commit t trans k =
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
660 if not (WIM.mem t.init_map trans) then begin
fccc6851 » MLstate
2011-06-21 Initial open-source release
661 #<If>
662 Logger.log ~color:`magenta
347efaac » Raja
2011-07-04 [fix] release: compilation
663 "DB : transaction %d at revision %d has already been comitted or aborted. Cannot prepare it again."
664 (Tr.get_num trans) (Revision.value (Hldb.get_rev (Tr.get_db trans)))
fccc6851 » MLstate
2011-06-21 Initial open-source release
665 #<End>;
666 raise Hldb.Merge (* merge conflict of 0 transactions *)
667 end else begin
668 match t.session_lock with
669 | None ->
7d965b97 » Raja
2011-07-06 [fix] db3: abort of a transaction
670 let cur_rev = Revision.succ (Hldb.get_rev t.db_ref) in
fccc6851 » MLstate
2011-06-21 Initial open-source release
671 let db = _prepare_commit t.db_ref t.db_to_merge cur_rev trans in
672 t.session_lock <- Some (trans, db);
673 Some (trans, k)
674 | Some _ ->
675 #<If> Logger.info "Previous prepared transaction not committed yet. Stashed transaction #%d on the waiting FIFO." (Tr.get_num trans) #<End>;
676 (* Assumption: this won't raise exceptions. If the data structure
677 gets complicated and exceptions are possible, change
678 [abort_of_unprepared] in the next function, because here
679 the transaction is prepared (partially). *)
680 add_FIFO trans k t.waiting_FIFO;
681 None
682 end
683
684 (* Calls a continuation, but never catches its exceptions. *)
685 let rec try_prepare_commit t trans k =
686 try
687 prepare_commit t trans k
688 with
689 | Hldb.Merge
690 | Hldb.UnqualifiedPath | DiskError _ ->
691 (* The preparation may be half-done, so we rollback to revert it. *)
692 abort_of_unprepared t trans;
693 k (trans, false);
694 (* This trans is in conflict, so it won't get committed,
695 so the commit function won't pop from the FIFO, when it finishes.
696 So try another one from the waiting list, until one merges OK. *)
697 pop_trans_k t
698 | e ->
699 (* The preparation may be half-done, so we rollback to revert it
700 and reraise the exception in a saner internal state. *)
701 (* do not reraise the excpetion, coonsider that the transaction failed
702 * apply the continuation with [false], and continue popping *)
703 (Logger.error "Error During db transaction : %s\n%s" (Printexc.to_string e) (Printexc.get_backtrace ());
704 abort_of_unprepared t trans;
705 k (trans, false);
706 pop_trans_k t)
707
708 and pop_trans_k t =
709 if is_empty_FIFO t.waiting_FIFO then begin
710 #<If> Logger.log ~color:`magenta "Nothing popped from FIFO." #<End>;
711 None
712 end else begin
713 let (trans, k) = take_FIFO t.waiting_FIFO in
714 #<If>
715 Logger.log ~color:`magenta
716 "Commit of transaction #%d popped from FIFO; %d commits waiting."
717 (Tr.get_num trans) (Queue.length t.waiting_FIFO)
718 #<End>;
719 try_prepare_commit t trans k
720 end
721
722 (* Calls a continuation, but never catches its exceptions. *)
723 let try_trans_prepare t trans k =
724 match try_prepare_commit t trans k with
725 | None -> ()
726 | Some (trans2, k2) -> k2 (trans2, true)
727
728 (* Calls a continuation, but never catches its exceptions. *)
729 let pop_trans_prepare t =
730 match pop_trans_k t with
731 | None -> ()
732 | Some (trans, k) -> k (trans, true)
733
734 let abort_or_rollback t trans =
735 #<If>
736 Logger.log ~color:`red
737 "Rollback of prepared or abort of unprepared or of the continuation of committed transaction #%d."
738 (Tr.get_num trans)
739 #<End>;
740 match t.session_lock with
741 | None ->
742 abort_of_unprepared t trans
743 | Some (transl, _db) ->
744 if Tr.get_num transl <> Tr.get_num trans then begin
745 (* The transaction is not the one prepared. For now, to keep
746 rollbacks deterministic from the point of view of a single thread,
747 we do nothing, so the transaction will be prepaired in the future
748 and commited, if the commit request is, e.g., in the prepare
749 callback continuation. If needed, as an optimiztion,
750 the commit may be removed from the waiting list together with
751 the callback, but we are in trouble if the commit request was not
752 in the callback, but in another thread and so it will crash.
753 In other words, we for now we treat this as abort, not rollback. *)
754 #<If>
755 Logger.log ~color:`magenta
756 "Abort of unprepared transaction #%d (while another, prepared transaction waits for commit)."
757 (Tr.get_num trans)
758 #<End>;
759 (* Not removed from init_map, because at the higher level
760 it may be wiped up and rebuilt differently, so it still exists. *)
761 end else begin
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
762 WIM.remove t.init_map trans;
fccc6851 » MLstate
2011-06-21 Initial open-source release
763 t.db_to_merge <- shrink_db_to_merge t;
764 (* Release the lock. *)
765 t.session_lock <- None;
7d965b97 » Raja
2011-07-06 [fix] db3: abort of a transaction
766 t.db_ref <- Hldb.update_aborted t.db_ref _db;
fccc6851 » MLstate
2011-06-21 Initial open-source release
767 pop_trans_prepare t;
768 #<If>
769 Logger.log ~color:`magenta
770 "Rollback of prepared transaction #%d"
771 (Tr.get_num trans)
772 #<End>;
773 end
774
7d965b97 » Raja
2011-07-06 [fix] db3: abort of a transaction
775
fccc6851 » MLstate
2011-06-21 Initial open-source release
776 let really_commit t trans =
777 match t.session_lock with
778 | Some (transl, db) ->
779 let success =
780 try
781 assert (Tr.get_num transl = Tr.get_num trans);
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
782 WIM.remove t.init_map trans;
fccc6851 » MLstate
2011-06-21 Initial open-source release
783 t.db_ref <- db;
784 let cur_rev = Hldb.get_rev db in
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
785 if WIM.count t.init_map = 0 then
fccc6851 » MLstate
2011-06-21 Initial open-source release
786 (* The most common case. No messing around with query maps. *)
787 t.db_to_merge <- IntMap.empty
788 else begin
789 (* Here we add our original query map at the current rev
790 (cur_vrev), so the started, but not yet commited
791 transactions can merge with us.
792 We can't add our map at the rev we started the transaction at,
793 because some transactions started later, but not yet commited
794 would not detect this transaction as a potential conflict. *)
795 let tr_map = Tr.get_query_map trans in
796 let cur_vrev = Revision.value cur_rev in
797 let db_to_merge = IntMap.add cur_vrev tr_map t.db_to_merge in
798 t.db_to_merge <- db_to_merge;
799 t.db_to_merge <- shrink_db_to_merge t;
800 end;
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
801
fccc6851 » MLstate
2011-06-21 Initial open-source release
802 disk_writing t ~trans cur_rev;
803 t.db_ref <- Hldb.clean_tmp_maps db;
804 (* Release the lock. *)
805 t.session_lock <- None;
806 true
807 with
808 | Hldb.UnqualifiedPath | DiskError _ -> false
809 in
810 if success then begin
811 #<If> Logger.info "Finished a commit." #<End>
812 end else begin
813 #<If> Logger.info "Failed a commit." #<End>
814 end;
815 pop_trans_prepare t;
816 success
817 | None ->
818 Logger.critical "Inconsistent state: it should be locked before commit.";
819 assert false
820
821 (* reading from DB *)
822
823 let check_rev ?rev t tr =
824 match rev with
825 | Some rev -> rev
826 | None ->
827 match Tr.get_read_rev tr with
828 | Some rev -> rev
829 | None -> Hldb.get_rev t.db_ref
830
831 let get _t tr path =
832 Tr.get tr path
833
834 let get_children t trans ?rev range path =
835 let rev = check_rev ?rev t trans in
836 let l = Tr.get_children trans rev range path in
837 assert (l = List.sort compare l);
838 l
839
840 let stat trans path = Tr.stat trans path
841
842 let get_all_rev_of_path tr path =
843 let l = Tr.get_all_rev_of_path tr path in
c4d3564e » Raja
2011-07-06 [enhance] db3: use list instead of Map for revisions
844 let l = List.rev l in
845 assert (if l <> List.uniq (List.sort compare l) then (Printf.printf "pbl! %s vs %s\n%!" (List.print Revision.to_string l) (List.print Revision.to_string (List.uniq (List.sort compare l))); false) else true);
fccc6851 » MLstate
2011-06-21 Initial open-source release
846 l
847
848 let get_last_rev_of_path tr path = Tr.get_last_rev_of_path tr path
849
850 let full_search tr slist path = Tr.full_search tr slist path
851
852
853 (* writing to DB *)
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
854 let update_init_map t tr =
855 WIM.remove t.init_map tr;
856 WIM.add t.init_map tr;
857 tr
fccc6851 » MLstate
2011-06-21 Initial open-source release
858
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
859 let set t trans path data = update_init_map t (Tr.set trans path data)
fccc6851 » MLstate
2011-06-21 Initial open-source release
860
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
861 let remove t trans path = update_init_map t (Tr.remove trans path)
fccc6851 » MLstate
2011-06-21 Initial open-source release
862
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
863 let set_link t trans path link = update_init_map t (Tr.set_link trans path link)
fccc6851 » MLstate
2011-06-21 Initial open-source release
864
017973e1 » Raja
2011-07-01 [fix] db: memory leek on read transactions
865 let set_copy t trans path (target_path, target_rev) =
866 update_init_map t (Tr.set_copy trans path (target_path, target_rev))
Something went wrong with that request. Please try again.