[OCaml] Mobile-friendly clone of cgit.
Merge fix-major-bugs.
Changed files
dune-project
@@ -20,7 +20,10 @@
20
20
ocaml
21
21
dune
22
22
dream
23
Removed:
git)
23
Added:
dream-html
24
Added:
git
25
Added:
git-unix
26
Added:
toml)
24
27
(tags
25
28
(git "web interface")))
26
29
lib/config.ml
@@ -18,9 +18,13 @@
18
18
}
19
19
20
20
let locate_config_file () =
21
Removed:
match List.find_map Sys.getenv_opt [ "OGIT_CONFIG"; "XDG_CONFIG_HOME" ] with
21
Added:
match Sys.getenv_opt "OGIT_CONFIG" with
22
22
| Some file -> file
23
Removed:
| None -> "/etc/ogit/config.toml"
23
Added:
| None -> (
24
Added:
match Sys.getenv_opt "XDG_CONFIG_HOME" with
25
Added:
| Some config_home ->
26
Added:
Filename.concat (Filename.concat config_home "ogit") "config.toml"
27
Added:
| None -> "/etc/ogit/config.toml")
24
28
25
29
let config_file = locate_config_file ()
26
30
@@ -63,7 +67,7 @@
63
67
let* git_project_root = find_string "git_project_root" in
64
68
let* user = find_string "user" in
65
69
let* default_branch = find_string "default_branch" in
66
Removed:
let* commits_max_displayed = find_int "max_commits_displayed" in
70
Added:
let* commits_max_displayed = find_int "commits_max_displayed" in
67
71
Ok { git_project_root; user; default_branch; commits_max_displayed }
68
72
with _ ->
69
73
prerr_endline "[config.ml] Falling back to default config.";
lib/handlers.ml
@@ -12,7 +12,7 @@
12
12
13
13
let summary req =
14
14
let repo = Dream.param req "repo" in
15
Removed:
let* branches = Resolvers.Reference.all repo in
15
Added:
let* branches = Resolvers.Reference.branches repo in
16
16
let* commits = Resolvers.Commit.recent repo 10 in
17
17
Views.Repo.summary repo branches commits
18
18
lib/resolvers.ml
@@ -4,15 +4,51 @@
4
4
open Lwt_result.Syntax
5
5
open Config
6
6
7
Added:
let is_hex_digit = function
8
Added:
| '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
9
Added:
| _ -> false
10
Added:
11
Added:
let is_valid_hash_hex hash =
12
Added:
String.length hash = Store.Hash.length * 2 && String.for_all is_hex_digit hash
13
Added:
14
Added:
let hash_of_hex hash =
15
Added:
if is_valid_hash_hex hash then Lwt_result.return (Store.Hash.of_hex hash)
16
Added:
else Lwt_result.fail (`Msg ("invalid object id " ^ hash))
17
Added:
18
Added:
let is_valid_repo_name repo =
19
Added:
let invalid_char = function '/' | '\\' | '\x00' -> true | _ -> false in
20
Added:
repo <> "" && repo <> "." && repo <> ".."
21
Added:
&& (not (String.starts_with ~prefix:"." repo))
22
Added:
&& not (String.exists invalid_char repo)
23
Added:
24
Added:
let validate_repo_name repo =
25
Added:
if is_valid_repo_name repo then Lwt_result.return repo
26
Added:
else Lwt_result.fail (`Msg ("invalid repository name " ^ repo))
27
Added:
7
28
let full_path path = Filename.concat config.git_project_root path
8
29
9
30
let store repo =
31
Added:
let* repo = validate_repo_name repo in
10
32
let path = full_path repo |> Fpath.v in
11
33
Store.v ~dotgit:path path
12
34
35
Added:
let default_repo_description = "Unnamed repository"
36
Added:
37
Added:
let read_description_file description_path =
38
Added:
try
39
Added:
match
40
Added:
In_channel.with_open_text description_path In_channel.input_all
41
Added:
|> String.trim
42
Added:
with
43
Added:
| "" -> default_repo_description
44
Added:
| description -> description
45
Added:
with Sys_error _ -> default_repo_description
46
Added:
13
47
let repo_description repo =
14
Removed:
let description_path = Filename.concat (full_path repo) "description" in
15
Removed:
In_channel.with_open_text description_path In_channel.input_all
48
Added:
if is_valid_repo_name repo then
49
Added:
let description_path = Filename.concat (full_path repo) "description" in
50
Added:
read_description_file description_path
51
Added:
else default_repo_description
16
52
17
53
let short_hash hash = String.sub hash 0 8
18
54
@@ -37,7 +73,7 @@
37
73
38
74
let of_id repo id =
39
75
let* store = store repo in
40
Removed:
let hash = Store.Hash.of_hex id in
76
Added:
let* hash = hash_of_hex id in
41
77
Lwt_result.bind (Store.read store hash) @@ function
42
78
| Git.Value.Commit commit -> Lwt_result.return (to_t commit)
43
79
| _ -> Lwt_result.fail @@ `Msg ("no commit matches id " ^ id)
@@ -64,9 +100,21 @@
64
100
module Reference = struct
65
101
type t = { name : string; hash : string }
66
102
103
Added:
let drop_prefix ~prefix name =
104
Added:
if String.starts_with ~prefix name then
105
Added:
Some
106
Added:
(String.sub name (String.length prefix)
107
Added:
(String.length name - String.length prefix))
108
Added:
else None
109
Added:
110
Added:
let branch_name name = drop_prefix ~prefix:"refs/heads/" name
111
Added:
let tag_name name = drop_prefix ~prefix:"refs/tags/" name
112
Added:
67
113
let to_t (reference, hash) =
68
114
{ name = Git.Reference.to_string reference; hash = Store.Hash.to_hex hash }
69
115
116
Added:
let to_t_with_name name (_, hash) = { name; hash = Store.Hash.to_hex hash }
117
Added:
70
118
let all repo =
71
119
let* store = store repo in
72
120
let open Lwt.Syntax in
@@ -75,22 +123,33 @@
75
123
Lwt_result.return references
76
124
77
125
let branches repo =
78
Removed:
let* references = all repo in
79
Removed:
let is_branch reference =
80
Removed:
not (String.starts_with ~prefix:"v" reference.name)
126
Added:
let* store = store repo in
127
Added:
let open Lwt.Syntax in
128
Added:
let* references = Store.Ref.list store in
129
Added:
let branches =
130
Added:
references
131
Added:
|> List.filter_map (fun ((reference, _) as raw) ->
132
Added:
Git.Reference.to_string reference |> branch_name
133
Added:
|> Option.map (fun name -> to_t_with_name name raw))
81
134
in
82
Removed:
Lwt_result.return @@ List.filter is_branch references
135
Added:
Lwt_result.return branches
83
136
84
137
let tags repo =
85
Removed:
let* references = all repo in
86
Removed:
let is_tag reference = String.starts_with ~prefix:"v" reference.name in
87
Removed:
Lwt_result.return @@ List.filter is_tag references
138
Added:
let* store = store repo in
139
Added:
let open Lwt.Syntax in
140
Added:
let* references = Store.Ref.list store in
141
Added:
let tags =
142
Added:
references
143
Added:
|> List.filter_map (fun ((reference, _) as raw) ->
144
Added:
Git.Reference.to_string reference |> tag_name
145
Added:
|> Option.map (fun name -> to_t_with_name name raw))
146
Added:
in
147
Added:
Lwt_result.return tags
88
148
89
149
let of_id repo id =
90
150
let* branches = branches repo in
91
151
let branch =
92
Removed:
branches
93
Removed:
|> List.find_opt (fun branch -> Filename.basename branch.name = id)
152
Added:
branches |> List.find_opt (fun branch -> branch.name = id)
94
153
in
95
154
match branch with
96
155
| Some branch -> Lwt_result.return branch
@@ -129,7 +188,7 @@
129
188
130
189
let of_id repo id =
131
190
let* store = store repo in
132
Removed:
let hash = Store.Hash.of_hex id in
191
Added:
let* hash = hash_of_hex id in
133
192
Lwt_result.bind (Store.read store hash) @@ function
134
193
| Git.Value.Tree tree -> Lwt_result.return (to_t tree)
135
194
| _ -> Lwt_result.fail @@ `Msg ("no tree matches id " ^ id)
@@ -151,7 +210,7 @@
151
210
152
211
let of_id repo id =
153
212
let* store = store repo in
154
Removed:
let hash = Store.Hash.of_hex id in
213
Added:
let* hash = hash_of_hex id in
155
214
Lwt_result.bind (Store.read store hash) @@ function
156
215
| Git.Value.Blob blob -> Lwt_result.return (to_t blob)
157
216
| _ -> Lwt_result.fail @@ `Msg ("no blob matches id " ^ id)
@@ -159,7 +218,7 @@
159
218
160
219
let blob_or_tree repo id =
161
220
let* store = store repo in
162
Removed:
let hash = Store.Hash.of_hex id in
221
Added:
let* hash = hash_of_hex id in
163
222
Lwt_result.bind (Store.read store hash) @@ function
164
223
| Git.Value.Tree tree -> Lwt_result.return @@ `Tree (Tree.to_t tree)
165
224
| Git.Value.Blob blob -> Lwt_result.return @@ `Blob (Blob.to_t blob)
@@ -176,7 +235,7 @@
176
235
| None -> Lwt_result.return None
177
236
| Some readme -> (
178
237
let* store = store repo in
179
Removed:
let hash = Store.Hash.of_hex readme.hash in
238
Added:
let* hash = hash_of_hex readme.hash in
180
239
Lwt_result.bind (Store.read store hash) @@ function
181
240
| Git.Value.Blob blob -> Lwt_result.return @@ Some (Blob.to_t blob)
182
241
| _ -> Lwt_result.fail @@ `Msg ("couldn't read file " ^ readme.name))
lib/views.ml
@@ -75,29 +75,54 @@
75
75
HTML.html [] [ head page_title; body body_data ]
76
76
end
77
77
78
Added:
let error_page message =
79
Added:
let open HTML in
80
Added:
respond
81
Added:
@@ html []
82
Added:
[
83
Added:
Page.head "Fatal Error";
84
Added:
body []
85
Added:
[
86
Added:
h1 [] [ txt "Fatal Error" ];
87
Added:
div
88
Added:
[ id "main" ]
89
Added:
[
90
Added:
p [] [ b [] [ txt "%s" message ] ];
91
Added:
p []
92
Added:
[
93
Added:
txt
94
Added:
"Your best course of action is to press the 'back' \
95
Added:
button in your browser.";
96
Added:
];
97
Added:
];
98
Added:
];
99
Added:
]
100
Added:
78
101
let root () =
79
Removed:
let all_repositories =
80
Removed:
(* Ignore hidden directories. *)
81
Removed:
let repos =
82
Removed:
Sys.readdir config.git_project_root
83
Removed:
|> Array.to_list
84
Removed:
|> List.filter (fun name -> not (name.[0] = '.'))
85
Removed:
|> List.sort String.compare
102
Added:
try
103
Added:
let all_repositories =
104
Added:
(* Ignore hidden directories. *)
105
Added:
let repos =
106
Added:
Sys.readdir config.git_project_root
107
Added:
|> Array.to_list
108
Added:
|> List.filter (fun name -> not (name.[0] = '.'))
109
Added:
|> List.sort String.compare
110
Added:
in
111
Added:
let li_of_repo repo =
112
Added:
HTML.li [] [ Routes.link_to (Routes.Repo repo) (txt "%s" repo) ]
113
Added:
in
114
Added:
HTML.(div [ id "repositories" ] [ ul [] @@ List.map li_of_repo repos ])
86
115
in
87
Removed:
let li_of_repo repo =
88
Removed:
HTML.li [] [ Routes.link_to (Routes.Repo repo) (txt "%s" repo) ]
89
Removed:
in
90
Removed:
HTML.(div [ id "repositories" ] [ ul [] @@ List.map li_of_repo repos ])
91
Removed:
in
92
Removed:
respond
93
Removed:
@@ Page.render
94
Removed:
{
95
Removed:
title = "Ogit";
96
Removed:
repo = None;
97
Removed:
subtitle = "Repositories for " ^ config.user;
98
Removed:
active = Summary;
99
Removed:
content = [ all_repositories ];
100
Removed:
}
116
Added:
respond
117
Added:
@@ Page.render
118
Added:
{
119
Added:
title = "Ogit";
120
Added:
repo = None;
121
Added:
subtitle = "Repositories for " ^ config.user;
122
Added:
active = Summary;
123
Added:
content = [ all_repositories ];
124
Added:
}
125
Added:
with Sys_error message -> error_page message
101
126
102
127
module Repo = struct
103
128
let page_title repo =
@@ -249,26 +274,3 @@
249
274
content;
250
275
}
251
276
end
252
Removed:
253
Removed:
let error_page message =
254
Removed:
let open HTML in
255
Removed:
respond
256
Removed:
@@ html []
257
Removed:
[
258
Removed:
Page.head "Fatal Error";
259
Removed:
body []
260
Removed:
[
261
Removed:
h1 [] [ txt "Fatal Error" ];
262
Removed:
div
263
Removed:
[ id "main" ]
264
Removed:
[
265
Removed:
p [] [ b [] [ txt "%s" message ] ];
266
Removed:
p []
267
Removed:
[
268
Removed:
txt
269
Removed:
"Your best course of action is to press the 'back' \
270
Removed:
button in your browser.";
271
Removed:
];
272
Removed:
];
273
Removed:
];
274
Removed:
]
ogit.opam
@@ -11,7 +11,10 @@
11
11
"ocaml"
12
12
"dune" {>= "3.16"}
13
13
"dream"
14
Added:
"dream-html"
14
15
"git"
16
Added:
"git-unix"
17
Added:
"toml"
15
18
"odoc" {with-doc}
16
19
]
17
20
build: [
test/dune
@@ -1,2 +1,3 @@
1
1
(test
2
Removed:
(name test_ogit))
2
Added:
(name test_ogit)
3
Added:
(libraries ogit unix))
test/test_ogit.ml
@@ -0,0 +1,68 @@
1
Added:
let test_config_round_trip () =
2
Added:
let file = Filename.temp_file "ogit" ".toml" in
3
Added:
let config =
4
Added:
Ogit.Config.
5
Added:
{
6
Added:
user = "alice";
7
Added:
default_branch = "main";
8
Added:
git_project_root = "/srv/git";
9
Added:
commits_max_displayed = 25;
10
Added:
}
11
Added:
in
12
Added:
Ogit.Config.write_file ~file (Ogit.Config.to_table config);
13
Added:
match Ogit.Config.read_file ~file () with
14
Added:
| Ok config' -> assert (config' = config)
15
Added:
| Error message -> failwith message
16
Added:
17
Added:
let test_config_location () =
18
Added:
if Sys.getenv_opt "OGIT_CONFIG" = None then (
19
Added:
Unix.putenv "XDG_CONFIG_HOME" "/tmp/xdg-config";
20
Added:
assert (
21
Added:
Ogit.Config.locate_config_file ()
22
Added:
= Filename.concat (Filename.concat "/tmp/xdg-config" "ogit")
23
Added:
"config.toml"));
24
Added:
Unix.putenv "OGIT_CONFIG" "/tmp/custom-ogit.toml";
25
Added:
assert (Ogit.Config.locate_config_file () = "/tmp/custom-ogit.toml")
26
Added:
27
Added:
let test_description_reader () =
28
Added:
let file = Filename.temp_file "ogit-description" ".txt" in
29
Added:
Sys.remove file;
30
Added:
assert (
31
Added:
Ogit.Resolvers.read_description_file file
32
Added:
= Ogit.Resolvers.default_repo_description);
33
Added:
Out_channel.with_open_text file (fun oc -> output_string oc "\n");
34
Added:
assert (
35
Added:
Ogit.Resolvers.read_description_file file
36
Added:
= Ogit.Resolvers.default_repo_description);
37
Added:
Out_channel.with_open_text file (fun oc ->
38
Added:
output_string oc "A useful repository\n");
39
Added:
assert (Ogit.Resolvers.read_description_file file = "A useful repository")
40
Added:
41
Added:
let () =
42
Added:
assert (Ogit.Resolvers.is_valid_repo_name "project.git");
43
Added:
assert (Ogit.Resolvers.is_valid_repo_name "project");
44
Added:
assert (not (Ogit.Resolvers.is_valid_repo_name ""));
45
Added:
assert (not (Ogit.Resolvers.is_valid_repo_name ".hidden"));
46
Added:
assert (not (Ogit.Resolvers.is_valid_repo_name "."));
47
Added:
assert (not (Ogit.Resolvers.is_valid_repo_name ".."));
48
Added:
assert (not (Ogit.Resolvers.is_valid_repo_name "../outside"));
49
Added:
assert (not (Ogit.Resolvers.is_valid_repo_name "nested/repo"));
50
Added:
assert (not (Ogit.Resolvers.is_valid_repo_name "nested\\repo"));
51
Added:
assert (not (Ogit.Resolvers.is_valid_repo_name "bad\x00repo"));
52
Added:
assert (Ogit.Resolvers.is_valid_hash_hex (String.make 40 'a'));
53
Added:
assert (Ogit.Resolvers.is_valid_hash_hex (String.make 40 'A'));
54
Added:
assert (not (Ogit.Resolvers.is_valid_hash_hex (String.make 39 'a')));
55
Added:
assert (not (Ogit.Resolvers.is_valid_hash_hex (String.make 41 'a')));
56
Added:
assert (not (Ogit.Resolvers.is_valid_hash_hex (String.make 39 'a' ^ "x")));
57
Added:
assert (
58
Added:
Ogit.Resolvers.Reference.branch_name "refs/heads/main" = Some "main");
59
Added:
assert (
60
Added:
Ogit.Resolvers.Reference.branch_name "refs/heads/feature/topic"
61
Added:
= Some "feature/topic");
62
Added:
assert (Ogit.Resolvers.Reference.branch_name "HEAD" = None);
63
Added:
assert (
64
Added:
Ogit.Resolvers.Reference.tag_name "refs/tags/v1.0.0" = Some "v1.0.0");
65
Added:
assert (Ogit.Resolvers.Reference.tag_name "refs/heads/v1.0.0" = None);
66
Added:
test_config_round_trip ();
67
Added:
test_config_location ();
68
Added:
test_description_reader ()