robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compare commits

base: robur:47b1759d0f3ef0ab0ba4cce4ead80dd10d71cef4
Branches Tags
robur:main
robur:size-time-graphs
robur:20221220_perftest_hook_and_plot-generation
robur:conan
robur:20220803_adding_platform_filter_to_job_page
robur:20220628_removing_dream-path_calls
robur:access-list
robur:login
robur:v0.2.0
robur:v0.1.0
..
compare: robur:71a5b0da96d4d0170b92fac5da11a70ba244e76b
Branches Tags
robur:main
robur:size-time-graphs
robur:20221220_perftest_hook_and_plot-generation
robur:conan
robur:20220803_adding_platform_filter_to_job_page
robur:20220628_removing_dream-path_calls
robur:access-list
robur:login
robur:v0.2.0
robur:v0.1.0

No commits in common. "47b1759d0f3ef0ab0ba4cce4ead80dd10d71cef4" and "71a5b0da96d4d0170b92fac5da11a70ba244e76b" have entirely different histories.
47b1759d0f ... 71a5b0da96

20 changed files with 136 additions and 123 deletions
Show stats Expand all files Collapse all files

12
auth/builder_web_auth.ml
View file

@ -12,9 +12,9 @@ let scrypt_params ?(scrypt_n = 16384) ?(scrypt_r = 8) ?(scrypt_p = 1) () =
{ scrypt_n; scrypt_r; scrypt_p } { scrypt_n; scrypt_r; scrypt_p }
type pbkdf2_sha256 = type pbkdf2_sha256 =
[ `Pbkdf2_sha256 of string * string * pbkdf2_sha256_params ] [ `Pbkdf2_sha256 of Cstruct.t * Cstruct.t * pbkdf2_sha256_params ]
type scrypt = [ `Scrypt of string * string * scrypt_params ] type scrypt = [ `Scrypt of Cstruct.t * Cstruct.t * scrypt_params ]
type password_hash = [ pbkdf2_sha256 | scrypt ] type password_hash = [ pbkdf2_sha256 | scrypt ]
@ -25,10 +25,10 @@ type 'a user_info = {
} }
let pbkdf2_sha256 ~params:{ pbkdf2_sha256_iter = count } ~salt ~password = let pbkdf2_sha256 ~params:{ pbkdf2_sha256_iter = count } ~salt ~password =
Pbkdf.pbkdf2 ~prf:`SHA256 ~count ~dk_len:32l ~salt ~password Pbkdf.pbkdf2 ~prf:`SHA256 ~count ~dk_len:32l ~salt ~password:(Cstruct.of_string password)
let scrypt ~params:{ scrypt_n = n; scrypt_r = r; scrypt_p = p } ~salt ~password = let scrypt ~params:{ scrypt_n = n; scrypt_r = r; scrypt_p = p } ~salt ~password =
Scrypt.scrypt ~n ~r ~p ~dk_len:32l ~salt ~password Scrypt_kdf.scrypt_kdf ~n ~r ~p ~dk_len:32l ~salt ~password:(Cstruct.of_string password)
let hash ?(scrypt_params=scrypt_params ()) let hash ?(scrypt_params=scrypt_params ())
~username ~password ~restricted () = ~username ~password ~restricted () =
@ -43,10 +43,10 @@ let hash ?(scrypt_params=scrypt_params ())
let verify_password password user_info = let verify_password password user_info =
match user_info.password_hash with match user_info.password_hash with
| `Pbkdf2_sha256 (password_hash, salt, params) -> | `Pbkdf2_sha256 (password_hash, salt, params) ->
String.equal Cstruct.equal
(pbkdf2_sha256 ~params ~salt ~password) (pbkdf2_sha256 ~params ~salt ~password)
password_hash password_hash
| `Scrypt (password_hash, salt, params) -> | `Scrypt (password_hash, salt, params) ->
String.equal Cstruct.equal
(scrypt ~params ~salt ~password) (scrypt ~params ~salt ~password)
password_hash password_hash

2
auth/dune
View file

@ -1,3 +1,3 @@
(library (library
(name builder_web_auth) (name builder_web_auth)
(libraries kdf.pbkdf kdf.scrypt mirage-crypto-rng)) (libraries pbkdf scrypt-kdf mirage-crypto-rng))

51
bin/builder_db_app.ml
View file

@ -17,7 +17,7 @@ let defer_foreign_keys =
"PRAGMA defer_foreign_keys = ON" "PRAGMA defer_foreign_keys = ON"
let build_artifacts_to_orphan = let build_artifacts_to_orphan =
Builder_db.Rep.id `build ->* Caqti_type.octets @@ Builder_db.Rep.id `build ->* Builder_db.Rep.cstruct @@
{| SELECT a.sha256 FROM build_artifact a {| SELECT a.sha256 FROM build_artifact a
WHERE a.build = ? AND WHERE a.build = ? AND
(SELECT COUNT(*) FROM build_artifact a2 (SELECT COUNT(*) FROM build_artifact a2
@ -45,7 +45,7 @@ let migrate () dbpath =
let artifacts_dir datadir = Fpath.(datadir / "_artifacts") let artifacts_dir datadir = Fpath.(datadir / "_artifacts")
let artifact_path sha256 = let artifact_path sha256 =
let sha256 = Ohex.encode sha256 in let (`Hex sha256) = Hex.of_cstruct sha256 in
(* NOTE: [sha256] is 64 characters when it's a hex sha256 checksum *) (* NOTE: [sha256] is 64 characters when it's a hex sha256 checksum *)
(* NOTE: We add the prefix to reduce the number of files in a directory - a (* NOTE: We add the prefix to reduce the number of files in a directory - a
workaround for inferior filesystems. We can easily revert this by changing workaround for inferior filesystems. We can easily revert this by changing
@ -108,7 +108,7 @@ let user_disable () dbpath username =
match user with match user with
| None -> Error (`Msg "user not found") | None -> Error (`Msg "user not found")
| Some (_, user_info) -> | Some (_, user_info) ->
let password_hash = `Scrypt ("", "", Builder_web_auth.scrypt_params ()) in let password_hash = `Scrypt (Cstruct.empty, Cstruct.empty, Builder_web_auth.scrypt_params ()) in
let user_info = { user_info with password_hash ; restricted = true } in let user_info = { user_info with password_hash ; restricted = true } in
Db.exec Builder_db.User.update_user user_info Db.exec Builder_db.User.update_user user_info
in in
@ -296,12 +296,12 @@ let vacuum () datadir platform_opt jobnames predicate =
or_die 1 r or_die 1 r
let input_ids = let input_ids =
Caqti_type.unit ->* Caqti_type.octets @@ Caqti_type.unit ->* Builder_db.Rep.cstruct @@
"SELECT DISTINCT input_id FROM build WHERE input_id IS NOT NULL" "SELECT DISTINCT input_id FROM build WHERE input_id IS NOT NULL"
let main_artifact_hash = let main_artifact_hash =
Caqti_type.octets ->* Builder_db.Rep.cstruct ->*
Caqti_type.t3 Caqti_type.octets Builder_db.Rep.uuid Caqti_type.string @@ Caqti_type.t3 Builder_db.Rep.cstruct Builder_db.Rep.uuid Caqti_type.string @@
{| {|
SELECT a.sha256, b.uuid, j.name FROM build_artifact a, build b, job j SELECT a.sha256, b.uuid, j.name FROM build_artifact a, build b, job j
WHERE b.input_id = ? AND a.id = b.main_binary AND b.job = j.id WHERE b.input_id = ? AND a.id = b.main_binary AND b.job = j.id
@ -319,12 +319,12 @@ let verify_input_id () dbpath =
match hashes with match hashes with
| (h, uuid, jobname) :: tl -> | (h, uuid, jobname) :: tl ->
List.iter (fun (h', uuid', _) -> List.iter (fun (h', uuid', _) ->
if String.equal h h' then if Cstruct.equal h h' then
() ()
else else
Logs.warn (fun m -> m "job %s input id %a with two different hashes (%a, %a), build %a and %a" Logs.warn (fun m -> m "job %s input id %a with two different hashes (%a, %a), build %a and %a"
jobname Ohex.pp input_id jobname Cstruct.hexdump_pp input_id
Ohex.pp h Ohex.pp h' Cstruct.hexdump_pp h Cstruct.hexdump_pp h'
Uuidm.pp uuid Uuidm.pp uuid')) Uuidm.pp uuid Uuidm.pp uuid'))
tl tl
| [] -> ()) | [] -> ())
@ -336,9 +336,10 @@ let num_build_artifacts =
Caqti_type.unit ->! Caqti_type.int @@ Caqti_type.unit ->! Caqti_type.int @@
"SELECT count(*) FROM build_artifact" "SELECT count(*) FROM build_artifact"
let build_artifacts : (unit, string * Uuidm.t * Fpath.t * string * int64, [ `One | `Zero | `Many ]) Caqti_request.t = let build_artifacts : (unit, string * Uuidm.t * Fpath.t * Cstruct.t * int64, [ `One | `Zero | `Many ]) Caqti_request.t =
Caqti_type.unit ->* Caqti_type.unit ->*
Caqti_type.(t5 string Builder_db.Rep.uuid Builder_db.Rep.fpath octets int64) Caqti_type.(t5 string Builder_db.Rep.uuid Builder_db.Rep.fpath
Builder_db.Rep.cstruct int64)
@@ @@
{| SELECT job.name, b.uuid, a.filepath, a.sha256, a.size {| SELECT job.name, b.uuid, a.filepath, a.sha256, a.size
FROM build_artifact a, build b, job FROM build_artifact a, build b, job
@ -396,12 +397,12 @@ let verify_data_dir () datadir =
files_tracked := FpathSet.add (artifact_path sha256) !files_tracked; files_tracked := FpathSet.add (artifact_path sha256) !files_tracked;
let s = Int64.of_int (String.length data) in let s = Int64.of_int (String.length data) in
if s <> size then Logs.err (fun m -> m "File %a has different size (in DB %Lu on disk %Lu)" Fpath.pp abs_path size s); if s <> size then Logs.err (fun m -> m "File %a has different size (in DB %Lu on disk %Lu)" Fpath.pp abs_path size s);
let sha256' = Digestif.SHA256.(to_raw_string (digest_string data)) in let sha256' = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
if not (String.equal sha256 sha256') then if not (Cstruct.equal sha256 sha256') then
Logs.err (fun m -> m "File %a has different hash (in DB %a on disk %a)" Logs.err (fun m -> m "File %a has different hash (in DB %a on disk %a)"
Fpath.pp abs_path Fpath.pp abs_path
Ohex.pp sha256 Hex.pp (Hex.of_cstruct sha256)
Ohex.pp sha256')) ; Hex.pp (Hex.of_cstruct sha256'))) ;
Ok () Ok ()
else else
Ok () Ok ()
@ -544,8 +545,8 @@ module Verify_cache_dir = struct
type t = { type t = {
uuid : Uuidm.t; uuid : Uuidm.t;
job_name : string; job_name : string;
hash_opam_switch : string option; hash_opam_switch : Cstruct.t option;
hash_debug_bin : string option; hash_debug_bin : Cstruct.t option;
} }
let repr = let repr =
@ -559,8 +560,8 @@ module Verify_cache_dir = struct
t4 t4
Builder_db.Rep.uuid Builder_db.Rep.uuid
string string
(option octets) (option Builder_db.Rep.cstruct)
(option octets)) (option Builder_db.Rep.cstruct))
end end
@ -586,7 +587,7 @@ module Verify_cache_dir = struct
let* latest_version = let* latest_version =
Viz_aux.get_viz_version_from_dirs ~cachedir ~viz_typ Viz_aux.get_viz_version_from_dirs ~cachedir ~viz_typ
in in
let viz_input_hash = Ohex.encode hash in let `Hex viz_input_hash = Hex.of_cstruct hash in
let* viz_path = let* viz_path =
Viz_aux.choose_versioned_viz_path Viz_aux.choose_versioned_viz_path
~cachedir ~cachedir
@ -666,7 +667,7 @@ module Verify_cache_dir = struct
match extract_hash ~viz_typ build with match extract_hash ~viz_typ build with
| None -> () | None -> ()
| Some input_hash -> | Some input_hash ->
let input_hash = Ohex.encode input_hash in let `Hex input_hash = Hex.of_cstruct input_hash in
let viz_path = Viz_aux.viz_path let viz_path = Viz_aux.viz_path
~cachedir ~cachedir
~viz_typ ~viz_typ
@ -740,8 +741,8 @@ end
module Asn = struct module Asn = struct
let decode_strict codec cs = let decode_strict codec cs =
match Asn.decode codec cs with match Asn.decode codec cs with
| Ok (a, rest) -> | Ok (a, cs) ->
if String.length rest = 0 if Cstruct.length cs = 0
then Ok a then Ok a
else Error "trailing bytes" else Error "trailing bytes"
| Error (`Parse msg) -> Error ("parse error: " ^ msg) | Error (`Parse msg) -> Error ("parse error: " ^ msg)
@ -807,8 +808,8 @@ let extract_full () datadir dest uuid =
artifacts artifacts
in in
let exec = (job, uuid, out, start, finish, result, data) in let exec = (job, uuid, out, start, finish, result, data) in
let data = Builder.Asn.exec_to_str exec in let cs = Builder.Asn.exec_to_cs exec in
Bos.OS.File.write (Fpath.v dest) data Bos.OS.File.write (Fpath.v dest) (Cstruct.to_string cs)
in in
or_die 1 r or_die 1 r

2
bin/builder_web_app.ml
View file

@ -30,7 +30,7 @@ let write_raw s buf =
safe_close s >|= fun () -> safe_close s >|= fun () ->
Error `Exception) Error `Exception)
in in
(* Logs.debug (fun m -> m "writing %a" (Ohex.pp_hexdump ()) (Bytes.unsafe_to_string buf)) ; *) (* Logs.debug (fun m -> m "writing %a" Cstruct.hexdump_pp (Cstruct.of_bytes buf)) ; *)
w 0 (Bytes.length buf) w 0 (Bytes.length buf)
let process = let process =

10
bin/migrations/m20210706.ml
View file

@ -57,9 +57,9 @@ let builds =
Caqti_type.unit ->* Caqti_type.unit ->*
Caqti_type.t4 Caqti_type.t4
Builder_db.Rep.untyped_id Builder_db.Rep.untyped_id
Caqti_type.octets Builder_db.Rep.cstruct
Caqti_type.octets Builder_db.Rep.cstruct
Caqti_type.octets @@ Builder_db.Rep.cstruct @@
{| SELECT b.id, opam.sha256, env.sha256, system.sha256 {| SELECT b.id, opam.sha256, env.sha256, system.sha256
FROM build b, build_artifact opam, build_artifact env, build_artifact system FROM build b, build_artifact opam, build_artifact env, build_artifact system
WHERE opam.filepath = 'opam-switch' AND env.filepath = 'build-environment' WHERE opam.filepath = 'opam-switch' AND env.filepath = 'build-environment'
@ -68,7 +68,7 @@ let builds =
|} |}
let set_input_id = let set_input_id =
Caqti_type.t2 Builder_db.Rep.untyped_id Caqti_type.octets ->. Caqti_type.unit @@ Caqti_type.t2 Builder_db.Rep.untyped_id Builder_db.Rep.cstruct ->. Caqti_type.unit @@
"UPDATE build SET input_id = $2 WHERE id = $1" "UPDATE build SET input_id = $2 WHERE id = $1"
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) = let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
@ -76,7 +76,7 @@ let migrate _datadir (module Db : Caqti_blocking.CONNECTION) =
Db.exec add_input_id_to_build () >>= fun () -> Db.exec add_input_id_to_build () >>= fun () ->
Db.collect_list builds () >>= fun builds -> Db.collect_list builds () >>= fun builds ->
Grej.list_iter_result (fun (id, opam_sha, env_sha, pkg_sha) -> Grej.list_iter_result (fun (id, opam_sha, env_sha, pkg_sha) ->
let input_id = Digestif.SHA256.(to_raw_string (digestv_string [ opam_sha ; env_sha ; pkg_sha ])) in let input_id = Mirage_crypto.Hash.SHA256.digest (Cstruct.concat [ opam_sha ; env_sha ; pkg_sha ]) in
Db.exec set_input_id (id, input_id)) Db.exec set_input_id (id, input_id))
builds >>= fun () -> builds >>= fun () ->
Db.exec (Grej.set_version new_version) () Db.exec (Grej.set_version new_version) ()

7
bin/migrations/m20210707c.ml
View file

@ -16,8 +16,8 @@ let update_paths : ([`build_artifact] Builder_db.Rep.id * Fpath.t * Fpath.t, uni
Caqti_type.unit @@ Caqti_type.unit @@
"UPDATE build_artifact SET localpath = $2, filepath = $3 WHERE id = $1" "UPDATE build_artifact SET localpath = $2, filepath = $3 WHERE id = $1"
let add_artifact : ((Fpath.t * Fpath.t * string) * (int64 * [`build] Builder_db.Rep.id), unit, [ `Zero]) Caqti_request.t = let add_artifact : ((Fpath.t * Fpath.t * Cstruct.t) * (int64 * [`build] Builder_db.Rep.id), unit, [ `Zero]) Caqti_request.t =
Caqti_type.(t2 (t3 Builder_db.Rep.fpath Builder_db.Rep.fpath Caqti_type.octets) Caqti_type.(t2 (t3 Builder_db.Rep.fpath Builder_db.Rep.fpath Builder_db.Rep.cstruct)
(t2 Caqti_type.int64 (Builder_db.Rep.id `build))) ->. (t2 Caqti_type.int64 (Builder_db.Rep.id `build))) ->.
Caqti_type.unit @@ Caqti_type.unit @@
"INSERT INTO build_artifact (filepath, localpath, sha256, size, build) VALUES (?, ?, ?, ?, ?)" "INSERT INTO build_artifact (filepath, localpath, sha256, size, build) VALUES (?, ?, ?, ?, ?)"
@ -48,8 +48,7 @@ let fixup datadir (module Db : Caqti_blocking.CONNECTION) =
in in
assert (r = 0); assert (r = 0);
Bos.OS.File.read (Fpath.append datadir artifact_lpath) >>= fun data -> Bos.OS.File.read (Fpath.append datadir artifact_lpath) >>= fun data ->
let size = Int64.of_int (String.length data) let size = Int64.of_int (String.length data) and sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
and sha256 = Digestif.SHA256.(to_raw_string (digest_string data)) in
Db.exec update_paths (artifact_id, new_artifact_lpath, path artifact_fpath) >>= fun () -> Db.exec update_paths (artifact_id, new_artifact_lpath, path artifact_fpath) >>= fun () ->
Db.exec add_artifact ((artifact_fpath, artifact_lpath, sha256), (size, build_id)) >>= fun () -> Db.exec add_artifact ((artifact_fpath, artifact_lpath, sha256), (size, build_id)) >>= fun () ->
Db.find Builder_db.last_insert_rowid () >>= fun new_build_artifact_id -> Db.find Builder_db.last_insert_rowid () >>= fun new_build_artifact_id ->

8
bin/migrations/m20210712c.ml
View file

@ -8,8 +8,8 @@ open Grej.Infix
module Asn = struct module Asn = struct
let decode_strict codec cs = let decode_strict codec cs =
match Asn.decode codec cs with match Asn.decode codec cs with
| Ok (a, rest) -> | Ok (a, cs) ->
if String.length rest = 0 if Cstruct.length cs = 0
then Ok a then Ok a
else Error "trailing bytes" else Error "trailing bytes"
| Error (`Parse msg) -> Error ("parse error: " ^ msg) | Error (`Parse msg) -> Error ("parse error: " ^ msg)
@ -96,7 +96,7 @@ let copy_from_new_build =
let old_build_console_script = let old_build_console_script =
Caqti_type.unit ->* Caqti_type.unit ->*
Caqti_type.(t4 (Builder_db.Rep.id (`build : [ `build ])) Caqti_type.(t4 (Builder_db.Rep.id (`build : [ `build ]))
(t2 string Builder_db.Rep.uuid) octets string) @@ (t2 string Builder_db.Rep.uuid) Builder_db.Rep.cstruct string) @@
"SELECT b.id, job.name, b.uuid, b.console, b.script FROM build b, job WHERE b.job = job.id" "SELECT b.id, job.name, b.uuid, b.console, b.script FROM build b, job WHERE b.job = job.id"
let update_new_build_console_script = let update_new_build_console_script =
@ -112,7 +112,7 @@ let new_build_console_script =
"SELECT id, console, script FROM build" "SELECT id, console, script FROM build"
let update_old_build_console_script = let update_old_build_console_script =
Caqti_type.(t3 (Builder_db.Rep.id (`build : [ `build ])) octets string) ->. Caqti_type.(t3 (Builder_db.Rep.id (`build : [ `build ])) Builder_db.Rep.cstruct string) ->.
Caqti_type.unit @@ Caqti_type.unit @@
"UPDATE new_build SET console = $2, script = $3 WHERE id = $1" "UPDATE new_build SET console = $2, script = $3 WHERE id = $1"

16
builder-web.opam
View file

@ -17,16 +17,18 @@ build: [
depends: [ depends: [
"ocaml" {>= "4.13.0"} "ocaml" {>= "4.13.0"}
"dune" {>= "2.7.0"} "dune" {>= "2.7.0"}
"builder" {>= "0.4.0"} "builder" {>= "0.2.0"}
"dream" {>= "1.0.0~alpha7"} "dream" {>= "1.0.0~alpha4"}
"cstruct" {>= "6.0.0"}
"bos" "bos"
"ohex" {>= "0.2.0"} "hex"
"lwt" {>= "5.7.0"} "lwt" {>= "5.7.0"}
"caqti" {>= "2.1.2"} "caqti" {>= "2.1.1"}
"caqti-lwt" "caqti-lwt"
"caqti-driver-sqlite3" "caqti-driver-sqlite3"
"pbkdf"
"mirage-crypto-rng" {>= "0.11.0"} "mirage-crypto-rng" {>= "0.11.0"}
"kdf" "scrypt-kdf"
"opam-core" "opam-core"
"opam-format" {>= "2.1.0"} "opam-format" {>= "2.1.0"}
"metrics" {>= "0.3.0"} "metrics" {>= "0.3.0"}
@ -37,7 +39,8 @@ depends: [
"tyxml" {>= "4.3.0"} "tyxml" {>= "4.3.0"}
"ptime" "ptime"
"duration" "duration"
"asn1-combinators" {>= "0.3.0"} "mirage-crypto"
"asn1-combinators"
"logs" "logs"
"cmdliner" {>= "1.1.0"} "cmdliner" {>= "1.1.0"}
"uri" "uri"
@ -48,7 +51,6 @@ depends: [
"owee" "owee"
"solo5-elftool" {>= "0.3.0"} "solo5-elftool" {>= "0.3.0"}
"decompress" {>= "1.5.0"} "decompress" {>= "1.5.0"}
"digestif" {>= "1.2.0"}
"alcotest" {>= "1.2.0" & with-test} "alcotest" {>= "1.2.0" & with-test}
"ppx_deriving" {with-test} "ppx_deriving" {with-test}
"ppx_deriving_yojson" {with-test} "ppx_deriving_yojson" {with-test}

24
db/builder_db.ml
View file

@ -12,7 +12,7 @@ type 'a id = 'a Rep.id
type file = Rep.file = { type file = Rep.file = {
filepath : Fpath.t; filepath : Fpath.t;
sha256 : string; sha256 : Cstruct.t;
size : int; size : int;
} }
@ -172,7 +172,7 @@ module Build_artifact = struct
"SELECT id, filepath, sha256, size FROM build_artifact WHERE build = ?" "SELECT id, filepath, sha256, size FROM build_artifact WHERE build = ?"
let exists = let exists =
Caqti_type.octets ->! Caqti_type.bool @@ cstruct ->! Caqti_type.bool @@
"SELECT EXISTS(SELECT 1 FROM build_artifact WHERE sha256 = ?)" "SELECT EXISTS(SELECT 1 FROM build_artifact WHERE sha256 = ?)"
let add = let add =
@ -199,7 +199,7 @@ module Build = struct
script : Fpath.t; script : Fpath.t;
platform : string; platform : string;
main_binary : [`build_artifact] id option; main_binary : [`build_artifact] id option;
input_id : string option; input_id : Cstruct.t option;
user_id : [`user] id; user_id : [`user] id;
job_id : [`job] id; job_id : [`job] id;
} }
@ -224,7 +224,7 @@ module Build = struct
Fpath.pp t.script Fpath.pp t.script
t.platform t.platform
Fmt.(Dump.option int64) t.main_binary Fmt.(Dump.option int64) t.main_binary
Fmt.(Dump.option string) t.input_id Fmt.(Dump.option (using Cstruct.to_string string)) t.input_id
t.user_id t.user_id
t.job_id t.job_id
@ -240,7 +240,7 @@ module Build = struct
fpath fpath
string string
(option (Rep.id `build_artifact)) (option (Rep.id `build_artifact))
(option octets) (option Rep.cstruct)
(id `user) (id `user)
(id `job)) (id `job))
in in
@ -314,7 +314,7 @@ module Build = struct
|} |}
let get_all_artifact_sha = let get_all_artifact_sha =
Caqti_type.(t2 (id `job) (option string)) ->* Caqti_type.octets @@ Caqti_type.(t2 (id `job) (option string)) ->* Rep.cstruct @@
{| SELECT DISTINCT a.sha256 {| SELECT DISTINCT a.sha256
FROM build_artifact a, build b FROM build_artifact a, build b
WHERE b.job = $1 AND b.main_binary = a.id WHERE b.job = $1 AND b.main_binary = a.id
@ -446,7 +446,7 @@ module Build = struct
|} |}
let get_same_input_different_output_hashes = let get_same_input_different_output_hashes =
id `build ->* Caqti_type.octets @@ id `build ->* Rep.cstruct @@
{| SELECT DISTINCT a.sha256 {| SELECT DISTINCT a.sha256
FROM build b0, build_artifact a0, build b, build_artifact a FROM build b0, build_artifact a0, build b, build_artifact a
WHERE b0.id = ? AND a0.id = b0.main_binary AND a0.sha256 <> a.sha256 WHERE b0.id = ? AND a0.id = b0.main_binary AND a0.sha256 <> a.sha256
@ -455,7 +455,7 @@ module Build = struct
|} |}
let get_different_input_same_output_input_ids = let get_different_input_same_output_input_ids =
id `build ->* Caqti_type.octets @@ id `build ->* Rep.cstruct @@
{| SELECT DISTINCT b.input_id {| SELECT DISTINCT b.input_id
FROM build b0, build_artifact a0, build b, build_artifact a FROM build b0, build_artifact a0, build b, build_artifact a
WHERE b0.id = ? AND a0.id = b0.main_binary AND a0.sha256 = a.sha256 WHERE b0.id = ? AND a0.id = b0.main_binary AND a0.sha256 = a.sha256
@ -463,7 +463,7 @@ module Build = struct
|} |}
let get_one_by_input_id = let get_one_by_input_id =
Caqti_type.octets ->! t @@ Rep.cstruct ->! t @@
{| SELECT uuid, start_d, start_ps, finish_d, finish_ps, {| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
result_code, result_msg, console, script, result_code, result_msg, console, script,
platform, main_binary, input_id, user, job platform, main_binary, input_id, user, job
@ -487,7 +487,7 @@ module Build = struct
|} |}
let get_by_hash = let get_by_hash =
Caqti_type.octets ->! t @@ Rep.cstruct ->! t @@
{| SELECT {| SELECT
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_code, b.result_msg, b.console, b.script, b.result_code, b.result_msg, b.console, b.script,
@ -500,7 +500,7 @@ module Build = struct
|} |}
let get_with_main_binary_by_hash = let get_with_main_binary_by_hash =
Caqti_type.octets ->! Caqti_type.t2 t file_opt @@ Rep.cstruct ->! Caqti_type.t2 t file_opt @@
{| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, {| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_code, b.result_msg, b.console, b.script, b.result_code, b.result_msg, b.console, b.script,
b.platform, b.main_binary, b.input_id, b.user, b.job, b.platform, b.main_binary, b.input_id, b.user, b.job,
@ -513,7 +513,7 @@ module Build = struct
|} |}
let get_with_jobname_by_hash = let get_with_jobname_by_hash =
Caqti_type.octets ->? Caqti_type.t2 Caqti_type.string t @@ Rep.cstruct ->? Caqti_type.t2 Caqti_type.string t @@
{| SELECT job.name, {| SELECT job.name,
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_code, b.result_msg, b.result_code, b.result_msg,

23
db/builder_db.mli
View file

@ -3,7 +3,7 @@ module Rep : sig
type 'a id type 'a id
type file = { type file = {
filepath : Fpath.t; filepath : Fpath.t;
sha256 : string; sha256 : Cstruct.t;
size : int; size : int;
} }
@ -13,6 +13,7 @@ module Rep : sig
val uuid : Uuidm.t Caqti_type.t val uuid : Uuidm.t Caqti_type.t
val ptime : Ptime.t Caqti_type.t val ptime : Ptime.t Caqti_type.t
val fpath : Fpath.t Caqti_type.t val fpath : Fpath.t Caqti_type.t
val cstruct : Cstruct.t Caqti_type.t
val file : file Caqti_type.t val file : file Caqti_type.t
val execution_result : Builder.execution_result Caqti_type.t val execution_result : Builder.execution_result Caqti_type.t
val console : (int * string) list Caqti_type.t val console : (int * string) list Caqti_type.t
@ -21,7 +22,7 @@ type 'a id = 'a Rep.id
type file = Rep.file = { type file = Rep.file = {
filepath : Fpath.t; filepath : Fpath.t;
sha256 : string; sha256 : Cstruct.t;
size : int; size : int;
} }
@ -84,7 +85,7 @@ module Build_artifact : sig
Caqti_request.t Caqti_request.t
val get_all_by_build : val get_all_by_build :
([`build] id, [`build_artifact] id * file, [ `Many | `One | `Zero ]) Caqti_request.t ([`build] id, [`build_artifact] id * file, [ `Many | `One | `Zero ]) Caqti_request.t
val exists : (string, bool, [ `One ]) Caqti_request.t val exists : (Cstruct.t, bool, [ `One ]) Caqti_request.t
val add : val add :
(file * [`build] id, unit, [ `Zero ]) Caqti_request.t (file * [`build] id, unit, [ `Zero ]) Caqti_request.t
val remove_by_build : val remove_by_build :
@ -104,7 +105,7 @@ sig
script : Fpath.t; script : Fpath.t;
platform : string; platform : string;
main_binary : [`build_artifact] id option; main_binary : [`build_artifact] id option;
input_id : string option; input_id : Cstruct.t option;
user_id : [`user] id; user_id : [`user] id;
job_id : [`job] id; job_id : [`job] id;
} }
@ -119,7 +120,7 @@ sig
val get_all_failed : val get_all_failed :
(int * int * string option, string * t, [ `Many | `One | `Zero ]) Caqti_request.t (int * int * string option, string * t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_all_artifact_sha : val get_all_artifact_sha :
([`job] id * string option, string, [ `Many | `One | `Zero ]) Caqti_request.t ([`job] id * string option, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_latest_successful_with_binary : val get_latest_successful_with_binary :
([`job] id * string, [`build] id * t * file, [ `One | `Zero ]) ([`job] id * string, [`build] id * t * file, [ `One | `Zero ])
Caqti_request.t Caqti_request.t
@ -143,20 +144,20 @@ sig
val get_same_input_same_output_builds : val get_same_input_same_output_builds :
([`build] id, t, [ `Many | `One | `Zero ]) Caqti_request.t ([`build] id, t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_same_input_different_output_hashes : val get_same_input_different_output_hashes :
([`build] id, string, [ `Many | `One | `Zero ]) Caqti_request.t ([`build] id, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_different_input_same_output_input_ids : val get_different_input_same_output_input_ids :
([`build] id, string, [ `Many | `One | `Zero ]) Caqti_request.t ([`build] id, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_one_by_input_id : val get_one_by_input_id :
(string, t, [ `One ]) Caqti_request.t (Cstruct.t, t, [ `One ]) Caqti_request.t
val get_platforms_for_job : val get_platforms_for_job :
([`job] id, string, [ `Many | `One | `Zero ]) Caqti_request.t ([`job] id, string, [ `Many | `One | `Zero ]) Caqti_request.t
val add : (t, unit, [ `Zero ]) Caqti_request.t val add : (t, unit, [ `Zero ]) Caqti_request.t
val get_by_hash : val get_by_hash :
(string, t, [ `One]) Caqti_request.t (Cstruct.t, t, [ `One]) Caqti_request.t
val get_with_main_binary_by_hash : val get_with_main_binary_by_hash :
(string, t * file option, [ `One]) Caqti_request.t (Cstruct.t, t * file option, [ `One]) Caqti_request.t
val get_with_jobname_by_hash : val get_with_jobname_by_hash :
(string, string * t, [ `One | `Zero]) Caqti_request.t (Cstruct.t, string * t, [ `One | `Zero]) Caqti_request.t
val set_main_binary : ([`build] id * [`build_artifact] id, unit, [ `Zero ]) Caqti_request.t val set_main_binary : ([`build] id * [`build_artifact] id, unit, [ `Zero ]) Caqti_request.t
val remove : ([`build] id, unit, [ `Zero]) Caqti_request.t val remove : ([`build] id, unit, [ `Zero]) Caqti_request.t
end end

3
db/dune
View file

@ -1,3 +1,4 @@
(library (library
(name builder_db) (name builder_db)
(libraries builder caqti caqti-driver-sqlite3 asn1-combinators builder_web_auth)) (libraries builder caqti caqti-driver-sqlite3 asn1-combinators mirage-crypto
builder_web_auth))

25
db/representation.ml
View file

@ -1,8 +1,8 @@
module Asn = struct module Asn = struct
let decode_strict codec cs = let decode_strict codec cs =
match Asn.decode codec cs with match Asn.decode codec cs with
| Ok (a, rest) -> | Ok (a, cs) ->
if String.length rest = 0 if Cstruct.length cs = 0
then Ok a then Ok a
else Error "trailing bytes" else Error "trailing bytes"
| Error (`Parse msg) -> Error ("parse error: " ^ msg) | Error (`Parse msg) -> Error ("parse error: " ^ msg)
@ -17,7 +17,7 @@ module Asn = struct
(required ~label:"delta" int) (required ~label:"delta" int)
(required ~label:"data" utf8_string))) (required ~label:"data" utf8_string)))
let console_of_str, console_to_str = projections_of console let console_of_cs, console_to_cs = projections_of console
end end
type untyped_id = int64 type untyped_id = int64
@ -30,7 +30,7 @@ let id_to_int64 (id : 'a id) : int64 = id
type file = { type file = {
filepath : Fpath.t; filepath : Fpath.t;
sha256 : string; sha256 : Cstruct.t;
size : int; size : int;
} }
@ -56,15 +56,20 @@ let fpath =
|> Result.map_error (fun (`Msg s) -> s) in |> Result.map_error (fun (`Msg s) -> s) in
Caqti_type.custom ~encode ~decode Caqti_type.string Caqti_type.custom ~encode ~decode Caqti_type.string
let cstruct =
let encode t = Ok (Cstruct.to_string t) in
let decode s = Ok (Cstruct.of_string s) in
Caqti_type.custom ~encode ~decode Caqti_type.octets
let file = let file =
let encode { filepath; sha256; size } = let encode { filepath; sha256; size } =
Ok (filepath, sha256, size) in Ok (filepath, sha256, size) in
let decode (filepath, sha256, size) = let decode (filepath, sha256, size) =
Ok { filepath; sha256; size } in Ok { filepath; sha256; size } in
Caqti_type.custom ~encode ~decode Caqti_type.(t3 fpath octets int) Caqti_type.custom ~encode ~decode Caqti_type.(t3 fpath cstruct int)
let file_opt = let file_opt =
let rep = Caqti_type.(t3 (option fpath) (option octets) (option int)) in let rep = Caqti_type.(t3 (option fpath) (option cstruct) (option int)) in
let encode = function let encode = function
| Some { filepath; sha256; size } -> | Some { filepath; sha256; size } ->
Ok (Some filepath, Some sha256, Some size) Ok (Some filepath, Some sha256, Some size)
@ -107,12 +112,12 @@ let execution_result =
Caqti_type.custom ~encode ~decode rep Caqti_type.custom ~encode ~decode rep
let console = let console =
let encode console = Ok (Asn.console_to_str console) in let encode console = Ok (Asn.console_to_cs console) in
let decode data = Asn.console_of_str data in let decode data = Asn.console_of_cs data in
Caqti_type.(custom ~encode ~decode octets) Caqti_type.custom ~encode ~decode cstruct
let user_info = let user_info =
let rep = Caqti_type.(t7 string octets octets int int int bool) in let rep = Caqti_type.(t7 string cstruct cstruct int int int bool) in
let encode { Builder_web_auth.username; let encode { Builder_web_auth.username;
password_hash = `Scrypt (password_hash, password_salt, { password_hash = `Scrypt (password_hash, password_salt, {
Builder_web_auth.scrypt_n; scrypt_r; scrypt_p Builder_web_auth.scrypt_n; scrypt_r; scrypt_p

30
lib/builder_web.ml
View file

@ -134,14 +134,14 @@ module Viz_aux = struct
viz_dir ~cachedir ~viz_typ ~version viz_dir ~cachedir ~viz_typ ~version
/ input_hash + "html" / input_hash + "html"
) )
let choose_versioned_viz_path let choose_versioned_viz_path
~cachedir ~cachedir
~viz_typ ~viz_typ
~viz_input_hash ~viz_input_hash
~current_version = ~current_version =
let ( >>= ) = Result.bind in let ( >>= ) = Result.bind in
let rec aux current_version = let rec aux current_version =
let path = let path =
viz_path ~cachedir viz_path ~cachedir
~viz_typ ~viz_typ
@ -153,7 +153,7 @@ module Viz_aux = struct
Error (`Msg (Fmt.str "viz '%s': There exist no version of the requested \ Error (`Msg (Fmt.str "viz '%s': There exist no version of the requested \
visualization" visualization"
(viz_type_to_string viz_typ))) (viz_type_to_string viz_typ)))
else else
aux @@ pred current_version aux @@ pred current_version
) )
in in
@ -162,7 +162,7 @@ module Viz_aux = struct
let get_viz_version_from_dirs ~cachedir ~viz_typ = let get_viz_version_from_dirs ~cachedir ~viz_typ =
let ( >>= ) = Result.bind in let ( >>= ) = Result.bind in
Bos.OS.Dir.contents cachedir >>= fun versioned_dirs -> Bos.OS.Dir.contents cachedir >>= fun versioned_dirs ->
let max_cached_version = let max_cached_version =
let viz_typ_str = viz_type_to_string viz_typ ^ "_" in let viz_typ_str = viz_type_to_string viz_typ ^ "_" in
versioned_dirs versioned_dirs
|> List.filter_map (fun versioned_dir -> |> List.filter_map (fun versioned_dir ->
@ -171,7 +171,7 @@ module Viz_aux = struct
Logs.warn (fun m -> m "%s" err); Logs.warn (fun m -> m "%s" err);
None None
| Ok false -> None | Ok false -> None
| Ok true -> | Ok true ->
let dir_str = Fpath.filename versioned_dir in let dir_str = Fpath.filename versioned_dir in
if not (String.starts_with ~prefix:viz_typ_str dir_str) then if not (String.starts_with ~prefix:viz_typ_str dir_str) then
None None
@ -199,6 +199,10 @@ module Viz_aux = struct
let hash_viz_input ~uuid typ db = let hash_viz_input ~uuid typ db =
let open Builder_db in let open Builder_db in
let hex cstruct =
let `Hex hex_str = Hex.of_cstruct cstruct in
hex_str
in
main_binary_of_uuid uuid db >>= fun main_binary -> main_binary_of_uuid uuid db >>= fun main_binary ->
Model.build uuid db Model.build uuid db
|> if_error "Error getting build" >>= fun (build_id, _build) -> |> if_error "Error getting build" >>= fun (build_id, _build) ->
@ -206,7 +210,7 @@ module Viz_aux = struct
|> if_error "Error getting build artifacts" >>= fun artifacts -> |> if_error "Error getting build artifacts" >>= fun artifacts ->
match typ with match typ with
| `Treemap -> | `Treemap ->
let debug_binary = let debug_binary =
let bin = Fpath.base main_binary.filepath in let bin = Fpath.base main_binary.filepath in
List.find_opt List.find_opt
(fun p -> Fpath.(equal (bin + "debug") (base p.filepath))) (fun p -> Fpath.(equal (bin + "debug") (base p.filepath)))
@ -216,10 +220,10 @@ module Viz_aux = struct
Model.not_found debug_binary Model.not_found debug_binary
|> not_found_error >>= fun debug_binary -> |> not_found_error >>= fun debug_binary ->
debug_binary.sha256 debug_binary.sha256
|> Ohex.encode |> hex
|> Lwt_result.return |> Lwt_result.return
end end
| `Dependencies -> | `Dependencies ->
let opam_switch = let opam_switch =
List.find_opt List.find_opt
(fun p -> Fpath.(equal (v "opam-switch") (base p.filepath))) (fun p -> Fpath.(equal (v "opam-switch") (base p.filepath)))
@ -228,7 +232,7 @@ module Viz_aux = struct
Model.not_found opam_switch Model.not_found opam_switch
|> not_found_error >>= fun opam_switch -> |> not_found_error >>= fun opam_switch ->
opam_switch.sha256 opam_switch.sha256
|> Ohex.encode |> hex
|> Lwt_result.return |> Lwt_result.return
let try_load_cached_visualization ~cachedir ~uuid viz_typ db = let try_load_cached_visualization ~cachedir ~uuid viz_typ db =
@ -424,7 +428,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
|> if_error ~status:`Not_Found "File not found" >>= fun filepath -> |> if_error ~status:`Not_Found "File not found" >>= fun filepath ->
Dream.sql req (Model.build_artifact build filepath) Dream.sql req (Model.build_artifact build filepath)
|> if_error "Error getting build artifact" >>= fun file -> |> if_error "Error getting build artifact" >>= fun file ->
let etag = Base64.encode_string file.Builder_db.sha256 in let etag = Base64.encode_string (Cstruct.to_string file.Builder_db.sha256) in
match if_none_match with match if_none_match with
| Some etag' when etag = etag' -> | Some etag' when etag = etag' ->
Dream.empty `Not_Modified |> Lwt_result.ok Dream.empty `Not_Modified |> Lwt_result.ok
@ -494,7 +498,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
let upload req = let upload req =
let* body = Dream.body req in let* body = Dream.body req in
Builder.Asn.exec_of_str body |> Lwt.return Builder.Asn.exec_of_cs (Cstruct.of_string body) |> Lwt.return
|> if_error ~status:`Bad_Request "Bad request" |> if_error ~status:`Bad_Request "Bad request"
~log:(fun e -> ~log:(fun e ->
Log.warn (fun m -> m "Received bad builder ASN.1"); Log.warn (fun m -> m "Received bad builder ASN.1");
@ -526,7 +530,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
Dream.query req "sha256" |> Option.to_result ~none:(`Msg "Missing sha256 query parameter") Dream.query req "sha256" |> Option.to_result ~none:(`Msg "Missing sha256 query parameter")
|> Lwt.return |> Lwt.return
|> if_error ~status:`Bad_Request "Bad request" >>= fun hash_hex -> |> if_error ~status:`Bad_Request "Bad request" >>= fun hash_hex ->
begin try Ohex.decode hash_hex |> Lwt_result.return begin try Hex.to_cstruct (`Hex hash_hex) |> Lwt_result.return
with Invalid_argument e -> Lwt_result.fail (`Msg ("Bad hex: " ^ e)) with Invalid_argument e -> Lwt_result.fail (`Msg ("Bad hex: " ^ e))
end end
|> if_error ~status:`Bad_Request "Bad request" >>= fun hash -> |> if_error ~status:`Bad_Request "Bad request" >>= fun hash ->

4
lib/dune
View file

@ -1,5 +1,5 @@
(library (library
(name builder_web) (name builder_web)
(libraries builder builder_db dream tyxml bos duration ohex caqti-lwt (libraries builder builder_db dream tyxml bos duration hex caqti-lwt
opamdiff ptime.clock.os cmarkit tar tar.gz tar-unix owee solo5-elftool decompress.de opamdiff ptime.clock.os cmarkit tar tar.gz tar-unix owee solo5-elftool decompress.de
decompress.gz uri digestif)) decompress.gz uri))

13
lib/model.ml
View file

@ -20,7 +20,7 @@ let not_found = function
let staging datadir = Fpath.(datadir / "_staging") let staging datadir = Fpath.(datadir / "_staging")
let artifact_path artifact = let artifact_path artifact =
let sha256 = Ohex.encode artifact.Builder_db.sha256 in let (`Hex sha256) = Hex.of_cstruct artifact.Builder_db.sha256 in
(* NOTE: [sha256] is 64 characters when it's a hex sha256 checksum *) (* NOTE: [sha256] is 64 characters when it's a hex sha256 checksum *)
(* NOTE: We add the prefix to reduce the number of files in a directory - a (* NOTE: We add the prefix to reduce the number of files in a directory - a
workaround for inferior filesystems. We can easily revert this by changing workaround for inferior filesystems. We can easily revert this by changing
@ -221,7 +221,7 @@ let save_artifacts staging artifacts =
List.fold_left List.fold_left
(fun r (file, data) -> (fun r (file, data) ->
r >>= fun () -> r >>= fun () ->
let sha256 = Ohex.encode file.Builder_db.sha256 in let (`Hex sha256) = Hex.of_cstruct file.Builder_db.sha256 in
let destpath = Fpath.(staging / sha256) in let destpath = Fpath.(staging / sha256) in
save destpath data) save destpath data)
(Lwt_result.return ()) (Lwt_result.return ())
@ -232,7 +232,7 @@ let commit_files datadir staging_dir job_name uuid artifacts =
List.fold_left List.fold_left
(fun r artifact -> (fun r artifact ->
r >>= fun () -> r >>= fun () ->
let sha256 = Ohex.encode artifact.Builder_db.sha256 in let (`Hex sha256) = Hex.of_cstruct artifact.Builder_db.sha256 in
let src = Fpath.(staging_dir / sha256) in let src = Fpath.(staging_dir / sha256) in
let dest = Fpath.(datadir // artifact_path artifact) in let dest = Fpath.(datadir // artifact_path artifact) in
Lwt.return (Bos.OS.Dir.create (Fpath.parent dest)) >>= fun _created -> Lwt.return (Bos.OS.Dir.create (Fpath.parent dest)) >>= fun _created ->
@ -306,8 +306,7 @@ let compute_input_id artifacts =
get_hash (Fpath.v "build-environment"), get_hash (Fpath.v "build-environment"),
get_hash (Fpath.v "system-packages") get_hash (Fpath.v "system-packages")
with with
| Some a, Some b, Some c -> | Some a, Some b, Some c -> Some (Mirage_crypto.Hash.SHA256.digest (Cstruct.concat [a;b;c]))
Some Digestif.SHA256.(to_raw_string (digestv_string [a;b;c]))
| _ -> None | _ -> None
let save_console_and_script staging_dir job_name uuid console script = let save_console_and_script staging_dir job_name uuid console script =
@ -378,7 +377,7 @@ let add_build
if not_interesting filepath then if not_interesting filepath then
Lwt_result.return acc Lwt_result.return acc
else else
let sha256 = Digestif.SHA256.(to_raw_string (digest_string data)) let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data)
and size = String.length data in and size = String.length data in
Lwt_result.ok (Lwt.pause ()) >|= fun () -> Lwt_result.ok (Lwt.pause ()) >|= fun () ->
({ filepath; sha256; size }, data) :: acc) ({ filepath; sha256; size }, data) :: acc)
@ -484,7 +483,7 @@ let add_build
and uuid = Uuidm.to_string uuid and uuid = Uuidm.to_string uuid
and job = job.name and job = job.name
and platform = job.platform and platform = job.platform
and sha256 = Ohex.encode main_binary.sha256 and `Hex sha256 = Hex.of_cstruct main_binary.sha256
in in
let fp_str p = Fpath.(to_string (datadir // p)) in let fp_str p = Fpath.(to_string (datadir // p)) in
let args = let args =

2
lib/model.mli
View file

@ -33,7 +33,7 @@ val build : Uuidm.t -> Caqti_lwt.connection ->
val build_with_main_binary : [`job] Builder_db.id -> string -> Caqti_lwt.connection -> val build_with_main_binary : [`job] Builder_db.id -> string -> Caqti_lwt.connection ->
((Builder_db.Build.t * Builder_db.file) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t ((Builder_db.Build.t * Builder_db.file) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val build_hash : string -> Caqti_lwt.connection -> val build_hash : Cstruct.t -> Caqti_lwt.connection ->
((string * Builder_db.Build.t) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t ((string * Builder_db.Build.t) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val build_exists : Uuidm.t -> Caqti_lwt.connection -> val build_exists : Uuidm.t -> Caqti_lwt.connection ->

4
lib/views.ml
View file

@ -202,7 +202,7 @@ let artifact
else txtf "%a" Fpath.pp filepath else txtf "%a" Fpath.pp filepath
]; ];
H.txt " "; H.txt " ";
H.code [txtf "SHA256:%a" Ohex.pp sha256]; H.code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct sha256)];
txtf " (%a)" Fmt.byte_size size; txtf " (%a)" Fmt.byte_size size;
] ]
@ -491,7 +491,7 @@ module Job_build = struct
pp_devices block_devices pp_devices net_devices] pp_devices block_devices pp_devices net_devices]
in in
let aux (file:Builder_db.file) = let aux (file:Builder_db.file) =
let sha256_hex = Ohex.encode file.sha256 in let (`Hex sha256_hex) = Hex.of_cstruct file.sha256 in
[ [
H.dt [ H.dt [
H.a ~a:H.[a_href @@ Link.Job_build_artifact.make H.a ~a:H.[a_href @@ Link.Job_build_artifact.make

2
test/dune
View file

@ -1,7 +1,7 @@
(test (test
(name test_builder_db) (name test_builder_db)
(modules test_builder_db) (modules test_builder_db)
(libraries ptime.clock.os builder_db caqti.blocking alcotest mirage-crypto-rng.unix ohex)) (libraries ptime.clock.os builder_db caqti.blocking alcotest mirage-crypto-rng.unix))
(test (test
(name markdown_to_html) (name markdown_to_html)

7
test/router.ml
View file

@ -165,9 +165,10 @@ let () =
.. to find them I follewed the trails of 'Albatross_cli.http_host' .. to find them I follewed the trails of 'Albatross_cli.http_host'
*) *)
begin begin
let sha_str = let `Hex sha_str =
Digestif.SHA256.(to_raw_string (digest_string "foo")) Cstruct.of_string "foo"
|> Ohex.encode |> Mirage_crypto.Hash.SHA256.digest
|> Hex.of_cstruct
in in
Fmt.str "/hash?sha256=%s" sha_str Fmt.str "/hash?sha256=%s" sha_str
end; end;

14
test/test_builder_db.ml
View file

@ -25,8 +25,8 @@ module Testable = struct
x.restricted = y.restricted && x.restricted = y.restricted &&
match x.password_hash, y.password_hash with match x.password_hash, y.password_hash with
| `Scrypt (hash, salt, params), `Scrypt (hash', salt', params') -> | `Scrypt (hash, salt, params), `Scrypt (hash', salt', params') ->
String.equal hash hash' && Cstruct.equal hash hash' &&
String.equal salt salt' && Cstruct.equal salt salt' &&
params = params' params = params'
in in
let pp ppf { Builder_web_auth.username; password_hash; restricted } = let pp ppf { Builder_web_auth.username; password_hash; restricted } =
@ -34,7 +34,7 @@ module Testable = struct
| `Scrypt (hash, salt, { Builder_web_auth.scrypt_n; scrypt_r; scrypt_p }) -> | `Scrypt (hash, salt, { Builder_web_auth.scrypt_n; scrypt_r; scrypt_p }) ->
Format.fprintf ppf "user:%s;(%d,%d,%d);%B;%a;%a" username Format.fprintf ppf "user:%s;(%d,%d,%d);%B;%a;%a" username
scrypt_n scrypt_r scrypt_p restricted scrypt_n scrypt_r scrypt_p restricted
Ohex.pp hash Ohex.pp salt Cstruct.hexdump_pp hash Cstruct.hexdump_pp salt
in in
Alcotest.testable Alcotest.testable
pp pp
@ -43,7 +43,7 @@ module Testable = struct
let file = let file =
let equal (x : Builder_db.Rep.file) (y : Builder_db.Rep.file) = let equal (x : Builder_db.Rep.file) (y : Builder_db.Rep.file) =
Fpath.equal x.filepath y.filepath && Fpath.equal x.filepath y.filepath &&
String.equal x.sha256 y.sha256 && Cstruct.equal x.sha256 y.sha256 &&
x.size = y.size x.size = y.size
in in
let pp ppf { Builder_db.Rep.filepath; sha256; size } = let pp ppf { Builder_db.Rep.filepath; sha256; size } =
@ -51,7 +51,7 @@ module Testable = struct
sha256 = %a;@;<1 0>\ sha256 = %a;@;<1 0>\
size = %d;@;<1 0>\ size = %d;@;<1 0>\
@]@,}" @]@,}"
Fpath.pp filepath Ohex.pp sha256 size Fpath.pp filepath Cstruct.hexdump_pp sha256 size
in in
Alcotest.testable pp equal Alcotest.testable pp equal
@ -131,12 +131,12 @@ let result = Builder.Exited 0
let main_binary = let main_binary =
let filepath = Result.get_ok (Fpath.of_string "bin/hello.sh") in let filepath = Result.get_ok (Fpath.of_string "bin/hello.sh") in
let data = "#!/bin/sh\necho Hello, World\n" in let data = "#!/bin/sh\necho Hello, World\n" in
let sha256 = Digestif.SHA256.(to_raw_string (digest_string data)) in let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
let size = String.length data in let size = String.length data in
{ Builder_db.Rep.filepath; sha256; size } { Builder_db.Rep.filepath; sha256; size }
let main_binary2 = let main_binary2 =
let data = "#!/bin/sh\necho Hello, World 2\n" in let data = "#!/bin/sh\necho Hello, World 2\n" in
let sha256 = Digestif.SHA256.(to_raw_string (digest_string data)) in let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
let size = String.length data in let size = String.length data in
{ main_binary with sha256 ; size } { main_binary with sha256 ; size }
let platform = "exotic-os" let platform = "exotic-os"