Repositories / gitweb2.git
gitweb2.git
Clone (read-only): git clone http://git.guha-anderson.com/git/gitweb2.git
@@ -22,12 +22,12 @@ type repo_summary = { short_id : string; } -let default_host = "127.0.0.1" -let default_port = 8080 -let default_pygments_command = "pygmentize" -let max_scan_depth = 5 +let default_host : string = "127.0.0.1" +let default_port : int = 8080 +let default_pygments_command : string = "pygmentize" +let max_scan_depth : int = 5 -let html value = +let html (value : string) : string = let buffer = Buffer.create (String.length value) in String.iter (function @@ -40,19 +40,19 @@ let html value = value; Buffer.contents buffer -let url_encode value = Uri.pct_encode value -let url_decode value = Uri.pct_decode value +let url_encode (value : string) : string = Uri.pct_encode value +let url_decode (value : string) : string = Uri.pct_decode value -let join_path base child = +let join_path (base : string) (child : string) : string = match (base, child) with | "", child -> child | base, "" -> base | base, child when String.ends_with ~suffix:"/" base -> base ^ child | base, child -> base ^ "/" ^ child -let split_path path = String.split_on_char '/' path |> List.filter (( <> ) "") +let split_path (path : string) : string list = String.split_on_char '/' path |> List.filter (( <> ) "") -let command_exists command = +let command_exists (command : string) : bool = let executable = String.trim command |> String.split_on_char ' ' |> List.hd in if executable = "" then false else if String.contains executable '/' then Sys.file_exists executable @@ -63,7 +63,7 @@ let command_exists command = String.split_on_char ':' paths |> List.exists (fun dir -> Sys.file_exists (join_path dir executable)) -let read_all channel = +let read_all (channel : in_channel) : string = let buffer = Buffer.create 4096 in let bytes = Bytes.create 4096 in let rec loop () = @@ -75,7 +75,7 @@ let read_all channel = in loop () -let read_command_output ?input command = +let read_command_output ?input (command : string) : string option = let stdout, stdin, stderr = Unix.open_process_full command (Unix.environment ()) in Option.iter (output_string stdin) input; close_out stdin; @@ -86,9 +86,11 @@ let read_command_output ?input command = | Unix.WEXITED 0 -> Some (String.map (function '\r' -> '\n' | c -> c) out) | _ -> None -let shell_quote = Filename.quote +let shell_quote : string -> string = Filename.quote -let file_render ?(pygments_command = default_pygments_command) ~file_path text = +(* Pygments is optional. Rendering falls back to escaped text so repository + browsing still works on machines without the highlighter installed. *) +let file_render ?(pygments_command : string = default_pygments_command) ~(file_path : string) (text : string) : string = let plain () = "<pre><code>" ^ html text ^ "</code></pre>" in if not (command_exists pygments_command) then plain () else @@ -106,9 +108,9 @@ let file_render ?(pygments_command = default_pygments_command) ~file_path text = | Some highlighted when String.trim highlighted <> "" -> "<div class=\"highlight\">" ^ highlighted ^ "</div>" | _ -> plain () -let is_readme name = name = "README.md" || name = "README.txt" || name = "README" +let is_readme (name : string) : bool = name = "README.md" || name = "README.txt" || name = "README" -let page title body = +let page (title : string) (body : string) : string = "<!doctype html>\n<html lang=\"en\">\n<head>\n<meta charset=\"utf-8\">\n\ <meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n<title>" ^ html title @@ -141,7 +143,7 @@ let page title body = </style>\n</head>\n<body><main>" ^ body ^ "</main></body>\n</html>" -let normalize_root root = +let normalize_root (root : string) : string = let expanded = if root = "~" then Sys.getenv_opt "HOME" |> Option.value ~default:root else if String.starts_with ~prefix:"~/" root then @@ -152,15 +154,17 @@ let normalize_root root = in try Unix.realpath expanded |> String.trim with _ -> String.trim expanded -let is_git_repo path = +let is_git_repo (path : string) : bool = Sys.file_exists (join_path path ".git") || (Sys.file_exists (join_path path "HEAD") && Sys.file_exists (join_path path "objects") && Sys.file_exists (join_path path "refs")) -let is_openable_git_repo path = +let is_openable_git_repo (path : string) : bool = try Ocaml_git.with_repo path (fun _ -> true) with _ -> false -let discover_repos root = +(* Repository scanning intentionally stops descending once a repository is + found, matching git hosting behavior for nested working trees. *) +let discover_repos (root : string) : repo_info list = let root = normalize_root root in let found = ref [] in let rec scan path relative depth = @@ -180,13 +184,14 @@ let discover_repos root = scan root "" 0; List.sort (fun a b -> String.compare a.name b.name) !found -let local_branches repo = Ocaml_git.branches repo |> List.filter (fun (b : Ocaml_git.branch) -> b.kind = Ocaml_git.Local) +let local_branches (repo : Ocaml_git.t) : Ocaml_git.branch list = + Ocaml_git.branches repo |> List.filter (fun (b : Ocaml_git.branch) -> b.kind = Ocaml_git.Local) -let repo_url repo branch path = +let repo_url (repo : repo_info) (branch : string) (path : string) : string = let prefix = "/repo/" ^ url_encode repo.key ^ "/" ^ url_encode branch in if path = "" then prefix else prefix ^ "/" ^ (split_path path |> List.map url_encode |> String.concat "/") -let repo_summary repo = +let repo_summary (repo : repo_info) : repo_summary = try Ocaml_git.with_repo repo.path @@ fun git -> let branches = local_branches git in @@ -206,10 +211,10 @@ let repo_summary repo = } with _ -> { branch = "main"; summary = "Unavailable"; short_id = "" } -let entries_for_display entries = +let entries_for_display (entries : Ocaml_git.tree_entry list) : Ocaml_git.tree_entry list = List.sort (fun (a : Ocaml_git.tree_entry) b -> String.compare (String.lowercase_ascii a.name) (String.lowercase_ascii b.name)) entries -let rec repo_header repo branch path branches selected = +let repo_header (repo : repo_info) (branch : string) (path : string) (branches : Ocaml_git.branch list) (selected : string) : string = let buffer = Buffer.create 512 in Buffer.add_string buffer ("<section class=\"repo-head\"><p><a href=\"/\">Repositories</a> / " ^ html repo.name ^ "</p>"); Buffer.add_string buffer ("<h1>" ^ html (if path = "" then repo.name else path) ^ "</h1>"); @@ -229,7 +234,8 @@ let rec repo_header repo branch path branches selected = Buffer.add_string buffer "</div></section>"; Buffer.contents buffer -let tree_view ~pygments_command repo git branch path branches = +let tree_view ~(pygments_command : string) (repo : repo_info) (git : Ocaml_git.t) (branch : string) (path : string) + (branches : Ocaml_git.branch list) : string = let commit = Ocaml_git.branch_commit git branch in let listing = Ocaml_git.tree ~commit ~path git () in let buffer = Buffer.create 4096 in @@ -264,7 +270,8 @@ let tree_view ~pygments_command repo git branch path branches = else ()); Buffer.contents buffer -let blob_view ~pygments_command repo blob branch path branches = +let blob_view ~(pygments_command : string) (repo : repo_info) (blob : Ocaml_git.blob) (branch : string) (path : string) + (branches : Ocaml_git.branch list) : string = let buffer = Buffer.create 4096 in Buffer.add_string buffer (repo_header repo branch path branches "code"); Buffer.add_string buffer "<div class=\"panel file\">"; @@ -276,7 +283,7 @@ let blob_view ~pygments_command repo blob branch path branches = Buffer.add_string buffer "</div>"; Buffer.contents buffer -let commits_page repo branch = +let commits_page (repo : repo_info) (branch : string) : string = Ocaml_git.with_repo repo.path @@ fun git -> let buffer = Buffer.create 4096 in Buffer.add_string buffer (repo_header repo branch "" (local_branches git) "history"); @@ -291,7 +298,7 @@ let commits_page repo branch = Buffer.add_string buffer "</ol>"; page (branch ^ " history") (Buffer.contents buffer) -let repo_page ~pygments_command repo branch path = +let repo_page ~(pygments_command : string) (repo : repo_info) (branch : string) (path : string) : string = Ocaml_git.with_repo repo.path @@ fun git -> let branches = local_branches git in let commit = Ocaml_git.branch_commit git branch in @@ -303,9 +310,11 @@ let repo_page ~pygments_command repo branch path = in page repo.name content -let not_found message = { status = 404; body = page "Not found" ("<p class=\"notice\">" ^ message ^ "</p>") } +let not_found (message : string) : response = { status = 404; body = page "Not found" ("<p class=\"notice\">" ^ message ^ "</p>") } -let route ?(pygments_command = default_pygments_command) ~root raw_path = +(* Route handling is kept pure so tests can cover all page decisions without + opening sockets; [start] is only responsible for adapting this to HTTP. *) +let route ?(pygments_command : string = default_pygments_command) ~(root : string) (raw_path : string) : response = let repos = discover_repos root in let repo_by_key key = List.find_opt (fun repo -> repo.key = key) repos in let parts = split_path raw_path in @@ -353,7 +362,7 @@ let route ?(pygments_command = default_pygments_command) ~root raw_path = | Ocaml_git.Git_error message -> { status = 404; body = page "Not found" ("<p class=\"notice\">" ^ html message ^ "</p>") } | exn -> { status = 500; body = page "Server error" ("<p class=\"notice\">" ^ html (Printexc.to_string exn) ^ "</p>") } -let start config = +let start (config : config) : unit = Eio_main.run @@ fun env -> Eio.Switch.run @@ fun sw -> let net = Eio.Stdenv.net env in @@ -379,9 +388,9 @@ let start config = in Cohttp_eio.Server.run socket server ~on_error:(fun exn -> prerr_endline (Printexc.to_string exn)) -let usage = "usage: gitweb2 <repo-root> [--host 127.0.0.1] [--port 8080] [--pygments pygmentize]" +let usage : string = "usage: gitweb2 <repo-root> [--host 127.0.0.1] [--port 8080] [--pygments pygmentize]" -let parse_args argv = +let parse_args (argv : string array) : (config, string) result = let args = Array.to_list argv |> List.tl in match args with | [] | ("-h" | "--help") :: _ -> Error usage @@ -398,7 +407,7 @@ let parse_args argv = in loop default_host default_port default_pygments_command rest -let run argv = +let run (argv : string array) : unit = match parse_args argv with | Ok config -> start config | Error message ->
@@ -1 +1 @@ -let () = Gitweb2.run Sys.argv +let () : unit = Gitweb2.run Sys.argv
@@ -1,13 +1,13 @@ -let work_root = ".build/test-work" -let repo_root = work_root ^ "/repo" -let repo_name = "repo" +let work_root : string = ".build/test-work" +let repo_root : string = work_root ^ "/repo" +let repo_name : string = "repo" -let sh command = +let sh (command : string) : unit = match Sys.command command with | 0 -> () | code -> Alcotest.failf "command failed with %d: %s" code command -let reset_repo () = +let reset_repo () : unit = sh ("rm -rf " ^ work_root ^ " && mkdir -p " ^ repo_root); sh ("git -C " ^ repo_root ^ " init -b main >/dev/null 2>&1"); sh ("git -C " ^ repo_root ^ " config user.name 'Fixture Author'"); @@ -17,16 +17,16 @@ let reset_repo () = sh ("printf 'pluginManagement { }\\n' > " ^ repo_root ^ "/settings.gradle.kts"); sh ("git -C " ^ repo_root ^ " add . && git -C " ^ repo_root ^ " commit -m 'Initial fixture commit' >/dev/null 2>&1") -let contains haystack needle = +let contains (haystack : string) (needle : string) : bool = let hlen = String.length haystack and nlen = String.length needle in let rec loop index = index + nlen <= hlen && (String.sub haystack index nlen = needle || loop (index + 1)) in nlen = 0 || loop 0 -let assert_contains label body needle = Alcotest.(check bool) label true (contains body needle) +let assert_contains (label : string) (body : string) (needle : string) : unit = Alcotest.(check bool) label true (contains body needle) -let directory_entries_stay_alphabetical () = +let directory_entries_stay_alphabetical () : unit = reset_repo (); let response = Gitweb2.route ~root:work_root ("/repo/" ^ repo_name) in Alcotest.(check int) "status" 200 response.status; @@ -49,7 +49,7 @@ let directory_entries_stay_alphabetical () = Alcotest.(check bool) "readme after build" true (readme_index > build_index); Alcotest.(check bool) "readme before settings" true (readme_index < settings_index) -let directories_render_their_readme_below_the_listing () = +let directories_render_their_readme_below_the_listing () : unit = reset_repo (); let response = Gitweb2.route ~pygments_command:"uv run --with pygments pygmentize" ~root:work_root ("/repo/" ^ repo_name) in Alcotest.(check int) "status" 200 response.status; @@ -70,11 +70,11 @@ let directories_render_their_readme_below_the_listing () = assert_contains "name" response.body "gitweb2"; assert_contains "readme text" response.body "read-only web viewer" -let pygments_fallback () = +let pygments_fallback () : unit = let html = Gitweb2.file_render ~pygments_command:"__missing_pygmentize__" ~file_path:"README.md" "<plain>" in Alcotest.(check string) "fallback" "<pre><code><plain></code></pre>" html -let () = +let () : unit = Alcotest.run "gitweb2" [ ( "routing",