[OCaml] Mobile-friendly clone of cgit.
fix Cap the filtered commit walk
A filter that matches few commits walked the entire history on every request. The walk now reads at most 5000 commits and reports whether it stopped early. The commit list shows a notice when older matches may exist beyond the cap.
Changed files
lib/handlers.ml
@@ -201,7 +201,7 @@
201
201
(* Fetch one beyond orphan threshold to detect whether more exist *)
202
202
let fetch_count = offset + page_size + 11 in
203
203
let predicate = commit_matches ?filter_type ?author ?committer in
204
Removed:
let* all_commits =
204
Added:
let* all_commits, truncated =
205
205
Resolvers.Commit.recent_matching repository fetch_count predicate
206
206
in
207
207
let total = List.length all_commits in
@@ -218,8 +218,8 @@
218
218
let page_commits = List_ext.take effective_size after_offset in
219
219
let has_next = remaining > effective_size in
220
220
let has_prev = page_number > 1 in
221
Removed:
Views.Repo.commits ?filter_type ?author ?committer ~page_number ~has_prev
222
Removed:
~has_next context page_commits
221
Added:
Views.Repo.commits ?filter_type ?author ?committer ~truncated ~page_number
222
Added:
~has_prev ~has_next context page_commits
223
223
224
224
let commits_branch config repository context branch =
225
225
let page_size = config.Config.commits_max_displayed in
lib/resolvers.ml
@@ -369,19 +369,29 @@
369
369
let* hash = resolve_head_hash repository in
370
370
of_hash repository hash
371
371
372
Removed:
let recent_matching_from repository hash count predicate =
372
Added:
(* A filtered walk with a rare predicate would otherwise traverse the whole
373
Added:
history on every request. The cap bounds that work; callers learn through
374
Added:
the second component of the result that older matches may exist beyond
375
Added:
it. *)
376
Added:
let default_max_examined = 5_000
377
Added:
378
Added:
let recent_matching_from ?(max_examined = default_max_examined) repository
379
Added:
hash count predicate =
373
380
(* BFS traversal following all parents, ordered by author date descending.
374
381
The queue is kept sorted via List.merge on insertion. This is O(n) per
375
382
insert, but the queue length is bounded by the branch factor × count,
376
383
which is small in practice (most commits have 1-2 parents). *)
377
384
let module S = Set.Make (String) in
378
Removed:
let rec walk collected seen queue remaining =
379
Removed:
if remaining <= 0 then Lwt_result.return (List.rev collected)
385
Added:
let rec walk collected seen queue remaining examined =
386
Added:
if remaining <= 0 then Lwt_result.return (List.rev collected, false)
387
Added:
else if examined >= max_examined then
388
Added:
(* Unexplored parents remain: the history was not exhausted. *)
389
Added:
Lwt_result.return (List.rev collected, queue <> [])
380
390
else
381
391
match queue with
382
Removed:
| [] -> Lwt_result.return (List.rev collected)
392
Added:
| [] -> Lwt_result.return (List.rev collected, false)
383
393
| (_, h) :: rest ->
384
Removed:
if S.mem h seen then walk collected seen rest remaining
394
Added:
if S.mem h seen then walk collected seen rest remaining examined
385
395
else
386
396
let seen = S.add h seen in
387
397
let* commit = of_id repository h in
@@ -403,21 +413,22 @@
403
413
if predicate commit then (commit :: collected, remaining - 1)
404
414
else (collected, remaining)
405
415
in
406
Removed:
walk collected seen queue remaining
416
Added:
walk collected seen queue remaining (examined + 1)
407
417
in
408
Removed:
walk [] S.empty [ ((Int64.max_int, None), hash) ] count
418
Added:
walk [] S.empty [ ((Int64.max_int, None), hash) ] count 0
409
419
410
420
let recent_from repository hash count =
411
Removed:
recent_matching_from repository hash count (Fun.const true)
421
Added:
Lwt_result.map fst
422
Added:
(recent_matching_from repository hash count (Fun.const true))
412
423
413
Removed:
let recent_matching repository count predicate =
424
Added:
let recent_matching ?max_examined repository count predicate =
414
425
let* head_hash = resolve_head_hash repository in
415
Removed:
recent_matching_from repository
426
Added:
recent_matching_from ?max_examined repository
416
427
(Store.Hash.to_hex head_hash)
417
428
count predicate
418
429
419
430
let recent repository count =
420
Removed:
recent_matching repository count (Fun.const true)
431
Added:
Lwt_result.map fst (recent_matching repository count (Fun.const true))
421
432
end
422
433
423
434
module Reference = struct
lib/resolvers.mli
@@ -71,7 +71,16 @@
71
71
val recent_from : repository -> string -> int -> (t list, error) Lwt_result.t
72
72
73
73
val recent_matching :
74
Removed:
repository -> int -> (t -> bool) -> (t list, error) Lwt_result.t
74
Added:
?max_examined:int ->
75
Added:
repository ->
76
Added:
int ->
77
Added:
(t -> bool) ->
78
Added:
(t list * bool, error) Lwt_result.t
79
Added:
(** Walk history from HEAD, collecting up to [count] commits that satisfy the
80
Added:
predicate. The walk reads at most [max_examined] commits (default 5000),
81
Added:
so a rare predicate cannot traverse an entire large history per request.
82
Added:
The boolean is [true] when the walk stopped at that cap with history left
83
Added:
unexplored — older matches may then exist beyond the result. *)
75
84
76
85
val recent : repository -> int -> (t list, error) Lwt_result.t
77
86
end
lib/views.mli
@@ -41,6 +41,7 @@
41
41
?filter_type:string ->
42
42
?author:string ->
43
43
?committer:string ->
44
Added:
?truncated:bool ->
44
45
page_number:int ->
45
46
has_prev:bool ->
46
47
has_next:bool ->
lib/views/repo.ml
@@ -157,8 +157,8 @@
157
157
in
158
158
render_page context ~active:Summary ~toolbar:[] [ readme_panel ]
159
159
160
Removed:
let commits ?filter_type ?author ?committer ~page_number ~has_prev ~has_next
161
Removed:
context commits =
160
Added:
let commits ?filter_type ?author ?committer ?(truncated = false) ~page_number
161
Added:
~has_prev ~has_next context commits =
162
162
(* Each active filter offers a control that clears just itself, leaving the
163
163
others applied. *)
164
164
let active_filters =
@@ -227,6 +227,11 @@
227
227
~hide_pill:(Option.is_some filter_type)
228
228
?filter_type ?author ?committer context.repo)
229
229
commits;
230
Added:
(if truncated then
231
Added:
Ui.paragraph_text ~class_:"commit-list-note"
232
Added:
"The search stopped before it reached the oldest history. Older \
233
Added:
matching commits are not shown."
234
Added:
else Ui.nothing);
230
235
]
231
236
232
237
let files context trail (entries : Resolvers.Tree.tree_node list) =
lib/views/repo.mli
@@ -35,13 +35,16 @@
35
35
?filter_type:string ->
36
36
?author:string ->
37
37
?committer:string ->
38
Added:
?truncated:bool ->
38
39
page_number:int ->
39
40
has_prev:bool ->
40
41
has_next:bool ->
41
42
context ->
42
43
Resolvers.Commit.t list ->
43
44
Dream.response Dream.promise
44
Removed:
(** The paginated commit list, with optional type/author/committer filters. *)
45
Added:
(** The paginated commit list, with optional type/author/committer filters.
46
Added:
[truncated] adds a notice that the history walk stopped before the oldest
47
Added:
commits, so older matches may be missing. *)
45
48
46
49
val files :
47
50
context ->
test/test_commit_walk.ml
@@ -0,0 +1,77 @@
1
Added:
(** The examination cap on filtered history walks: that a walk stopped by the
2
Added:
cap reports truncation, and an exhausted history does not. *)
3
Added:
4
Added:
open Test_helpers
5
Added:
6
Added:
let with_history_repository test =
7
Added:
with_temp_directory "ogit-walk" (fun root ->
8
Added:
let name = "project" in
9
Added:
let path = Filename.concat root name in
10
Added:
Unix.mkdir path 0o755;
11
Added:
ignore (git [ "-C"; path; "init"; "-q"; "-b"; "main" ]);
12
Added:
ignore (git [ "-C"; path; "config"; "user.name"; "Test" ]);
13
Added:
ignore (git [ "-C"; path; "config"; "user.email"; "t@t.invalid" ]);
14
Added:
for index = 1 to 8 do
15
Added:
Out_channel.with_open_text (Filename.concat path "f.txt") (fun ch ->
16
Added:
Printf.fprintf ch "revision %d\n" index);
17
Added:
ignore (git [ "-C"; path; "add"; "." ]);
18
Added:
ignore
19
Added:
(git [ "-C"; path; "commit"; "-q"; "-m"; Printf.sprintf "c%d" index ])
20
Added:
done;
21
Added:
let config = Ogit.Config.{ default with git_project_root = root } in
22
Added:
let repository =
23
Added:
match Lwt_main.run (Ogit.Resolvers.open_repository config name) with
24
Added:
| Ok r -> r
25
Added:
| Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e
26
Added:
in
27
Added:
Fun.protect
28
Added:
~finally:(fun () ->
29
Added:
Lwt_main.run (Ogit.Resolvers.close_repository repository))
30
Added:
(fun () -> test repository))
31
Added:
32
Added:
let recent_matching ?max_examined repository count predicate =
33
Added:
match
34
Added:
Lwt_main.run
35
Added:
(Ogit.Resolvers.Commit.recent_matching ?max_examined repository count
36
Added:
predicate)
37
Added:
with
38
Added:
| Ok result -> result
39
Added:
| Error e -> Alcotest.failf "%a" Ogit.Resolvers.pp_error e
40
Added:
41
Added:
let never_matches _ = false
42
Added:
43
Added:
let test_cap_reports_truncation () =
44
Added:
with_history_repository (fun repository ->
45
Added:
let commits, truncated =
46
Added:
recent_matching ~max_examined:3 repository 10 never_matches
47
Added:
in
48
Added:
Alcotest.(check int) "no matches" 0 (List.length commits);
49
Added:
Alcotest.(check bool) "truncated" true truncated)
50
Added:
51
Added:
let test_exhausted_history_is_complete () =
52
Added:
with_history_repository (fun repository ->
53
Added:
let commits, truncated =
54
Added:
recent_matching ~max_examined:100 repository 10 never_matches
55
Added:
in
56
Added:
Alcotest.(check int) "no matches" 0 (List.length commits);
57
Added:
Alcotest.(check bool) "not truncated" false truncated)
58
Added:
59
Added:
let test_cap_keeps_collected_matches () =
60
Added:
with_history_repository (fun repository ->
61
Added:
(* Every commit matches; the cap stops the walk after three of eight. *)
62
Added:
let commits, truncated =
63
Added:
recent_matching ~max_examined:3 repository 10 (fun _ -> true)
64
Added:
in
65
Added:
Alcotest.(check int) "three collected" 3 (List.length commits);
66
Added:
Alcotest.(check bool) "truncated" true truncated)
67
Added:
68
Added:
let suite =
69
Added:
( "commit walk",
70
Added:
[
71
Added:
Alcotest.test_case "cap reports truncation" `Slow
72
Added:
test_cap_reports_truncation;
73
Added:
Alcotest.test_case "exhausted history is complete" `Slow
74
Added:
test_exhausted_history_is_complete;
75
Added:
Alcotest.test_case "cap keeps collected matches" `Slow
76
Added:
test_cap_keeps_collected_matches;
77
Added:
] )
test/test_ogit.ml
@@ -8,6 +8,7 @@
8
8
Test_config.suite;
9
9
Test_discovery.suite;
10
10
Test_tree_paths.suite;
11
Added:
Test_commit_walk.suite;
11
12
Test_router.suite;
12
13
Test_dispatch.suite;
13
14
Test_list_ext.suite;