From fc978f949a970221302009ca4288e9fa6a9e0656 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 5 Sep 2022 16:38:16 +0100 Subject: [PATCH 1/8] Filter out jobs in progress when pruning Db_store --- lib/db_store.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/db_store.ml b/lib/db_store.ml index 472ab90c..e02009cf 100644 --- a/lib/db_store.ml +++ b/lib/db_store.ml @@ -144,6 +144,7 @@ module Make (Raw : S.STORE) = struct let prune_batch ?(log=ignore) t ~before limit = let items = Dao.lru t.dao ~before limit in + let items = List.filter (fun id -> not (Builds.mem id t.in_progress)) items in let n = List.length items in Log.info (fun f -> f "Pruning %d items (of %d requested)" n limit); items |> Lwt_list.iter_s (fun id -> From 98ad8050d9c7478affb3627ce8b7ae02f352cbff Mon Sep 17 00:00:00 2001 From: Kate Date: Tue, 6 Sep 2022 15:37:26 +0100 Subject: [PATCH 2/8] tmp --- lib/db_store.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lib/db_store.ml b/lib/db_store.ml index e02009cf..a947a12f 100644 --- a/lib/db_store.ml +++ b/lib/db_store.ml @@ -140,7 +140,11 @@ module Make (Raw : S.STORE) = struct Raw.delete t.raw id >|= fun () -> Dao.delete t.dao id in - aux id + if Builds.mem id t.in_progress then begin + Log.warn (fun f -> f "Trying to delete ID %S but it is still in progress!" id); + Lwt.return_unit (* Ignore the deletion if the job is still in progress *) + end else + aux id let prune_batch ?(log=ignore) t ~before limit = let items = Dao.lru t.dao ~before limit in From 9e2c2eb01f1e29816416022b474b16d0c0728978 Mon Sep 17 00:00:00 2001 From: Kate Date: Wed, 14 Sep 2022 19:49:12 +0100 Subject: [PATCH 3/8] [TMP] test --- lib/dao.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/dao.ml b/lib/dao.ml index 41e914f0..b01fdcf8 100644 --- a/lib/dao.ml +++ b/lib/dao.ml @@ -74,7 +74,8 @@ let children t id = |> Result.ok | x -> Fmt.failwith "Invalid row: %a" Db.dump_row x -let delete t id = +let delete _t _id = +(* with_transaction t (fun () -> match Db.query_one t.parent Sqlite3.Data.[ TEXT id ] with | [ TEXT parent ] -> @@ -84,6 +85,8 @@ let delete t id = Db.exec t.delete Sqlite3.Data.[ TEXT id ] | x -> Fmt.failwith "Invalid row: %a" Db.dump_row x ) +*) + () let lru t ~before n = Db.query t.lru Sqlite3.Data.[ TEXT (format_timestamp before); INT (Int64.of_int n) ] From c44be5089c873afbcbc2352b6e6f28c93feab0d2 Mon Sep 17 00:00:00 2001 From: Kate Date: Thu, 15 Sep 2022 13:41:47 +0100 Subject: [PATCH 4/8] !fixup --- lib/dao.ml | 6 ++---- lib/db_store.ml | 4 ++-- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/lib/dao.ml b/lib/dao.ml index b01fdcf8..4fd19b61 100644 --- a/lib/dao.ml +++ b/lib/dao.ml @@ -74,8 +74,8 @@ let children t id = |> Result.ok | x -> Fmt.failwith "Invalid row: %a" Db.dump_row x -let delete _t _id = -(* +let delete t id = + () |> Lwt_preemptive.detach @@ fun () -> with_transaction t (fun () -> match Db.query_one t.parent Sqlite3.Data.[ TEXT id ] with | [ TEXT parent ] -> @@ -85,8 +85,6 @@ let delete _t _id = Db.exec t.delete Sqlite3.Data.[ TEXT id ] | x -> Fmt.failwith "Invalid row: %a" Db.dump_row x ) -*) - () let lru t ~before n = Db.query t.lru Sqlite3.Data.[ TEXT (format_timestamp before); INT (Int64.of_int n) ] diff --git a/lib/db_store.ml b/lib/db_store.ml index a947a12f..d9dd7c95 100644 --- a/lib/db_store.ml +++ b/lib/db_store.ml @@ -137,7 +137,7 @@ module Make (Raw : S.STORE) = struct | Ok deps -> Lwt_list.iter_s aux deps >>= fun () -> log id; - Raw.delete t.raw id >|= fun () -> + Raw.delete t.raw id >>= fun () -> Dao.delete t.dao id in if Builds.mem id t.in_progress then begin @@ -153,7 +153,7 @@ module Make (Raw : S.STORE) = struct Log.info (fun f -> f "Pruning %d items (of %d requested)" n limit); items |> Lwt_list.iter_s (fun id -> log id; - Raw.delete t.raw id >|= fun () -> + Raw.delete t.raw id >>= fun () -> Dao.delete t.dao id ) >>= fun () -> From 6384cc8de5909c0fe9578057997cf345cb72d589 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 19 Sep 2022 12:18:03 +0100 Subject: [PATCH 5/8] more lwt in dao --- lib/dao.ml | 4 ++++ lib/db_store.ml | 8 ++++---- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/lib/dao.ml b/lib/dao.ml index 4fd19b61..a872f2ee 100644 --- a/lib/dao.ml +++ b/lib/dao.ml @@ -50,6 +50,7 @@ let with_transaction t fn = | exception ex -> Db.exec t.rollback []; raise ex let add ?parent ~id ~now t = + () |> Lwt_preemptive.detach @@ fun () -> let now = format_timestamp now in match parent with | None -> Db.exec t.add Sqlite3.Data.[ TEXT id; TEXT now; TEXT now; NULL ]; @@ -60,10 +61,12 @@ let add ?parent ~id ~now t = ) let set_used ~id ~now t = + () |> Lwt_preemptive.detach @@ fun () -> let now = format_timestamp now in Db.exec t.set_used Sqlite3.Data.[ TEXT now; TEXT id ] let children t id = + () |> Lwt_preemptive.detach @@ fun () -> match Db.query_one t.exists Sqlite3.Data.[ TEXT id ] with | [ INT 0L ] -> Error `No_such_id | [ INT 1L ] -> @@ -87,6 +90,7 @@ let delete t id = ) let lru t ~before n = + () |> Lwt_preemptive.detach @@ fun () -> Db.query t.lru Sqlite3.Data.[ TEXT (format_timestamp before); INT (Int64.of_int n) ] |> List.map @@ function | Sqlite3.Data.[ TEXT id ] -> id diff --git a/lib/db_store.ml b/lib/db_store.ml index d9dd7c95..9cbe81dc 100644 --- a/lib/db_store.ml +++ b/lib/db_store.ml @@ -48,7 +48,7 @@ module Make (Raw : S.STORE) = struct match Raw.result t.raw id with | Some dir -> let now = Unix.(gmtime (gettimeofday ())) in - Dao.set_used t.dao ~id ~now; + Dao.set_used t.dao ~id ~now >>= fun () -> let log_file = dir / "log" in begin if Sys.file_exists log_file then Build_log.of_saved log_file @@ -66,7 +66,7 @@ module Make (Raw : S.STORE) = struct ) >>!= fun () -> let now = Unix.(gmtime (gettimeofday () )) in - Dao.add t.dao ?parent:base ~id ~now; + Dao.add t.dao ?parent:base ~id ~now >>= fun () -> Lwt_result.return (`Saved, id) let log_ty client_log ~id = function @@ -129,7 +129,7 @@ module Make (Raw : S.STORE) = struct let delete ?(log=ignore) t id = let rec aux id = - match Dao.children t.dao id with + Dao.children t.dao id >>= function | Error `No_such_id -> log id; Log.warn (fun f -> f "ID %S not in database!" id); @@ -147,7 +147,7 @@ module Make (Raw : S.STORE) = struct aux id let prune_batch ?(log=ignore) t ~before limit = - let items = Dao.lru t.dao ~before limit in + Dao.lru t.dao ~before limit >>= fun items -> let items = List.filter (fun id -> not (Builds.mem id t.in_progress)) items in let n = List.length items in Log.info (fun f -> f "Pruning %d items (of %d requested)" n limit); From 74bf70c1897e1345928d60495b262e766d682178 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 19 Sep 2022 12:24:30 +0100 Subject: [PATCH 6/8] Init lwt_preemptive with only 1 thread --- lib/dao.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/dao.ml b/lib/dao.ml index a872f2ee..90de0b52 100644 --- a/lib/dao.ml +++ b/lib/dao.ml @@ -43,6 +43,8 @@ let create db = let parent = Sqlite3.prepare db {| SELECT parent FROM builds WHERE id = ? |} in { db; begin_transaction; commit; rollback; add; set_used; update_rc; exists; children; delete; lru; parent } +let () = Lwt_preemptive.init 1 1 ignore + let with_transaction t fn = Db.exec t.begin_transaction []; match fn () with From 763ad934a616409faa27eb913126155ca50e3df0 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 19 Sep 2022 13:48:10 +0100 Subject: [PATCH 7/8] mutex --- lib/dao.ml | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/lib/dao.ml b/lib/dao.ml index 90de0b52..2a4e514a 100644 --- a/lib/dao.ml +++ b/lib/dao.ml @@ -13,6 +13,16 @@ type t = { parent : Sqlite3.stmt; } +let m = Mutex.create () + +let thread_detach f = + Lwt_preemptive.detach (fun x -> + Mutex.lock m; + let v = f x in + Mutex.unlock m; + v + ) () + let format_timestamp time = let { Unix.tm_year; tm_mon; tm_mday; tm_hour; tm_min; tm_sec; _ } = time in Fmt.str "%04d-%02d-%02d %02d:%02d:%02d" (tm_year + 1900) (tm_mon + 1) tm_mday tm_hour tm_min tm_sec @@ -43,8 +53,6 @@ let create db = let parent = Sqlite3.prepare db {| SELECT parent FROM builds WHERE id = ? |} in { db; begin_transaction; commit; rollback; add; set_used; update_rc; exists; children; delete; lru; parent } -let () = Lwt_preemptive.init 1 1 ignore - let with_transaction t fn = Db.exec t.begin_transaction []; match fn () with @@ -52,7 +60,7 @@ let with_transaction t fn = | exception ex -> Db.exec t.rollback []; raise ex let add ?parent ~id ~now t = - () |> Lwt_preemptive.detach @@ fun () -> + thread_detach @@ fun () -> let now = format_timestamp now in match parent with | None -> Db.exec t.add Sqlite3.Data.[ TEXT id; TEXT now; TEXT now; NULL ]; @@ -63,12 +71,12 @@ let add ?parent ~id ~now t = ) let set_used ~id ~now t = - () |> Lwt_preemptive.detach @@ fun () -> + thread_detach @@ fun () -> let now = format_timestamp now in Db.exec t.set_used Sqlite3.Data.[ TEXT now; TEXT id ] let children t id = - () |> Lwt_preemptive.detach @@ fun () -> + thread_detach @@ fun () -> match Db.query_one t.exists Sqlite3.Data.[ TEXT id ] with | [ INT 0L ] -> Error `No_such_id | [ INT 1L ] -> @@ -80,7 +88,7 @@ let children t id = | x -> Fmt.failwith "Invalid row: %a" Db.dump_row x let delete t id = - () |> Lwt_preemptive.detach @@ fun () -> + thread_detach @@ fun () -> with_transaction t (fun () -> match Db.query_one t.parent Sqlite3.Data.[ TEXT id ] with | [ TEXT parent ] -> @@ -92,7 +100,7 @@ let delete t id = ) let lru t ~before n = - () |> Lwt_preemptive.detach @@ fun () -> + thread_detach @@ fun () -> Db.query t.lru Sqlite3.Data.[ TEXT (format_timestamp before); INT (Int64.of_int n) ] |> List.map @@ function | Sqlite3.Data.[ TEXT id ] -> id From a0b6c96ffe205d1868da4bd32bf5790d46fcee07 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 19 Sep 2022 13:50:48 +0100 Subject: [PATCH 8/8] !fixup --- lib/dao.ml | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lib/dao.ml b/lib/dao.ml index 2a4e514a..9ffbbd6e 100644 --- a/lib/dao.ml +++ b/lib/dao.ml @@ -16,11 +16,10 @@ type t = { let m = Mutex.create () let thread_detach f = - Lwt_preemptive.detach (fun x -> + Lwt_preemptive.detach (fun () -> Mutex.lock m; - let v = f x in - Mutex.unlock m; - v + Fun.protect f + ~finally:(fun () -> Mutex.unlock m) ) () let format_timestamp time =