Detect datadir by platform

This commit is contained in:
Reynir Björnsson 2021-11-12 14:01:40 +01:00 committed by Robur
parent e15bd00fe5
commit 977678b325
4 changed files with 50 additions and 11 deletions

View file

@ -4,10 +4,10 @@ let ( let+ ) x f = Result.map f x
let or_die exit_code = function let or_die exit_code = function
| Ok r -> r | Ok r -> r
| Error (`Msg msg) -> | Error (`Msg msg) ->
Format.eprintf "Error: %s" msg; Format.eprintf "Error: %s\n" msg;
exit exit_code exit exit_code
| Error (#Caqti_error.t as e) -> | Error (#Caqti_error.t as e) ->
Format.eprintf "Database error: %a" Caqti_error.pp e; Format.eprintf "Database error: %a\n" Caqti_error.pp e;
exit exit_code exit exit_code
let foreign_keys = let foreign_keys =
@ -320,22 +320,35 @@ let help man_format cmds = function
then `Help (man_format, Some cmd) then `Help (man_format, Some cmd)
else `Error (true, "Unknown command: " ^ cmd) else `Error (true, "Unknown command: " ^ cmd)
let uname =
let cmd = Bos.Cmd.(v "uname" % "-s") in
lazy (match Bos.OS.Cmd.(run_out cmd |> out_string |> success) with
| Ok s when s = "FreeBSD" -> `FreeBSD
| Ok s when s = "Linux" -> `Linux
| Ok s -> invalid_arg (Printf.sprintf "OS %s not supported\n" s)
| Error (`Msg m) -> invalid_arg m)
let default_datadir =
match Lazy.force uname with
| `FreeBSD -> "/var/db/builder-web"
| `Linux -> "/var/lib/builder-web"
let dbpath = let dbpath =
let doc = "sqlite3 database path" in let doc = "sqlite3 database path" in
Cmdliner.Arg.(value & Cmdliner.Arg.(value &
opt non_dir_file "/var/db/builder-web/builder.sqlite3" & opt non_dir_file (default_datadir ^ "/builder.sqlite3") &
info ~doc ["dbpath"]) info ~doc ["dbpath"])
let dbpath_new = let dbpath_new =
let doc = "sqlite3 database path" in let doc = "sqlite3 database path" in
Cmdliner.Arg.(value & Cmdliner.Arg.(value &
opt string "/var/db/builder-web/builder.sqlite3" & opt string (default_datadir ^ "/builder.sqlite3") &
info ~doc ["dbpath"]) info ~doc ["dbpath"])
let datadir = let datadir =
let doc = "data directory" in let doc = "data directory" in
Cmdliner.Arg.(value & Cmdliner.Arg.(value &
opt dir "/var/db/builder-web/" & opt dir default_datadir &
info ~doc ["datadir"]) info ~doc ["datadir"])
let jobname = let jobname =

View file

@ -120,9 +120,22 @@ let ip_port : (Ipaddr.V4.t * int) Arg.converter =
in in
parse, fun ppf (ip, port) -> Format.fprintf ppf "%a:%d" Ipaddr.V4.pp ip port parse, fun ppf (ip, port) -> Format.fprintf ppf "%a:%d" Ipaddr.V4.pp ip port
let uname =
let cmd = Bos.Cmd.(v "uname" % "-s") in
lazy (match Bos.OS.Cmd.(run_out cmd |> out_string |> success) with
| Ok s when s = "FreeBSD" -> `FreeBSD
| Ok s when s = "Linux" -> `Linux
| Ok s -> invalid_arg (Printf.sprintf "OS %s not supported" s)
| Error (`Msg m) -> invalid_arg m)
let default_datadir =
match Lazy.force uname with
| `FreeBSD -> "/var/db/builder-web"
| `Linux -> "/var/lib/builder-web"
let datadir = let datadir =
let doc = "data directory" in let doc = "data directory" in
Arg.(value & opt dir "/var/db/builder-web/" & info [ "d"; "datadir" ] ~doc) Arg.(value & opt dir default_datadir & info [ "d"; "datadir" ] ~doc)
let port = let port =
let doc = "port" in let doc = "port" in

View file

@ -24,7 +24,7 @@ let pp_error ppf = function
let or_die exit_code = function let or_die exit_code = function
| Ok r -> r | Ok r -> r
| Error e -> | Error e ->
Format.eprintf "Database error: %a" pp_error e; Format.eprintf "Database error: %a\n" pp_error e;
exit exit_code exit exit_code
let do_database_action action () datadir = let do_database_action action () datadir =
@ -59,10 +59,23 @@ let help man_format migrations = function
then `Help (man_format, Some migration) then `Help (man_format, Some migration)
else `Error (true, "Unknown migration: " ^ migration) else `Error (true, "Unknown migration: " ^ migration)
let uname =
let cmd = Bos.Cmd.(v "uname" % "-s") in
lazy (match Bos.OS.Cmd.(run_out cmd |> out_string |> success) with
| Ok s when s = "FreeBSD" -> `FreeBSD
| Ok s when s = "Linux" -> `Linux
| Ok s -> invalid_arg (Printf.sprintf "OS %s not supported" s)
| Error (`Msg m) -> invalid_arg m)
let default_datadir =
match Lazy.force uname with
| `FreeBSD -> "/var/db/builder-web"
| `Linux -> "/var/lib/builder-web"
let datadir = let datadir =
let doc = "data directory containing builder.sqlite3 and data files" in let doc = "data directory containing builder.sqlite3 and data files" in
Cmdliner.Arg.(value & Cmdliner.Arg.(value &
opt dir "/var/db/builder-web/" & opt dir default_datadir &
info ~doc ["datadir"]) info ~doc ["datadir"])
let setup_log = let setup_log =

View file

@ -10,13 +10,13 @@ let broken_builds =
WHERE a.build = b.id and a.filepath = b.main_binary) = 0 WHERE a.build = b.id and a.filepath = b.main_binary) = 0
|} |}
let fixup _datadir (module Db : Caqti_blocking.CONNECTION) = let fixup datadir (module Db : Caqti_blocking.CONNECTION) =
let open Grej.Infix in let open Grej.Infix in
Grej.check_version ~user_version:3L (module Db) >>= fun () -> Grej.check_version ~user_version:3L (module Db) >>= fun () ->
Db.rev_collect_list broken_builds () >>= fun broken_builds -> Db.rev_collect_list broken_builds () >>= fun broken_builds ->
Grej.list_iter_result Grej.list_iter_result
(fun ((build, uuid, job_name) : [`build] Rep.id * Uuidm.t * string) -> (fun ((build, uuid, job_name) : [`build] Rep.id * Uuidm.t * string) ->
Format.printf "Removing job %a.\nPlease clean up data files in /var/db/builder-web/%s/%a\n" Format.printf "Removing job %a.\nPlease clean up data files in %a/%s/%a\n"
Uuidm.pp uuid job_name Uuidm.pp uuid; Uuidm.pp uuid Fpath.pp datadir job_name Uuidm.pp uuid;
Db.exec Builder_db.Build.remove build) Db.exec Builder_db.Build.remove build)
broken_builds broken_builds