Compare commits
6 commits
71a5b0da96
...
47b1759d0f
Author | SHA1 | Date | |
---|---|---|---|
47b1759d0f | |||
6d50b4bff4 | |||
0f68776819 | |||
598f8230bd | |||
ca0214c606 | |||
07831d7de3 |
20 changed files with 123 additions and 136 deletions
|
@ -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 Cstruct.t * Cstruct.t * pbkdf2_sha256_params ]
|
[ `Pbkdf2_sha256 of string * string * pbkdf2_sha256_params ]
|
||||||
|
|
||||||
type scrypt = [ `Scrypt of Cstruct.t * Cstruct.t * scrypt_params ]
|
type scrypt = [ `Scrypt of string * string * 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:(Cstruct.of_string password)
|
Pbkdf.pbkdf2 ~prf:`SHA256 ~count ~dk_len:32l ~salt ~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_kdf.scrypt_kdf ~n ~r ~p ~dk_len:32l ~salt ~password:(Cstruct.of_string password)
|
Scrypt.scrypt ~n ~r ~p ~dk_len:32l ~salt ~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) ->
|
||||||
Cstruct.equal
|
String.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) ->
|
||||||
Cstruct.equal
|
String.equal
|
||||||
(scrypt ~params ~salt ~password)
|
(scrypt ~params ~salt ~password)
|
||||||
password_hash
|
password_hash
|
||||||
|
|
|
@ -1,3 +1,3 @@
|
||||||
(library
|
(library
|
||||||
(name builder_web_auth)
|
(name builder_web_auth)
|
||||||
(libraries pbkdf scrypt-kdf mirage-crypto-rng))
|
(libraries kdf.pbkdf kdf.scrypt mirage-crypto-rng))
|
||||||
|
|
|
@ -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 ->* Builder_db.Rep.cstruct @@
|
Builder_db.Rep.id `build ->* Caqti_type.octets @@
|
||||||
{| 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 (`Hex sha256) = Hex.of_cstruct sha256 in
|
let sha256 = Ohex.encode 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 (Cstruct.empty, Cstruct.empty, Builder_web_auth.scrypt_params ()) in
|
let password_hash = `Scrypt ("", "", 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 ->* Builder_db.Rep.cstruct @@
|
Caqti_type.unit ->* Caqti_type.octets @@
|
||||||
"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 =
|
||||||
Builder_db.Rep.cstruct ->*
|
Caqti_type.octets ->*
|
||||||
Caqti_type.t3 Builder_db.Rep.cstruct Builder_db.Rep.uuid Caqti_type.string @@
|
Caqti_type.t3 Caqti_type.octets 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 Cstruct.equal h h' then
|
if String.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 Cstruct.hexdump_pp input_id
|
jobname Ohex.pp input_id
|
||||||
Cstruct.hexdump_pp h Cstruct.hexdump_pp h'
|
Ohex.pp h Ohex.pp h'
|
||||||
Uuidm.pp uuid Uuidm.pp uuid'))
|
Uuidm.pp uuid Uuidm.pp uuid'))
|
||||||
tl
|
tl
|
||||||
| [] -> ())
|
| [] -> ())
|
||||||
|
@ -336,10 +336,9 @@ 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 * Cstruct.t * int64, [ `One | `Zero | `Many ]) Caqti_request.t =
|
let build_artifacts : (unit, string * Uuidm.t * Fpath.t * string * 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
|
Caqti_type.(t5 string Builder_db.Rep.uuid Builder_db.Rep.fpath octets int64)
|
||||||
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
|
||||||
|
@ -397,12 +396,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' = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
|
let sha256' = Digestif.SHA256.(to_raw_string (digest_string data)) in
|
||||||
if not (Cstruct.equal sha256 sha256') then
|
if not (String.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
|
||||||
Hex.pp (Hex.of_cstruct sha256)
|
Ohex.pp sha256
|
||||||
Hex.pp (Hex.of_cstruct sha256'))) ;
|
Ohex.pp sha256')) ;
|
||||||
Ok ()
|
Ok ()
|
||||||
else
|
else
|
||||||
Ok ()
|
Ok ()
|
||||||
|
@ -545,8 +544,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 : Cstruct.t option;
|
hash_opam_switch : string option;
|
||||||
hash_debug_bin : Cstruct.t option;
|
hash_debug_bin : string option;
|
||||||
}
|
}
|
||||||
|
|
||||||
let repr =
|
let repr =
|
||||||
|
@ -560,8 +559,8 @@ module Verify_cache_dir = struct
|
||||||
t4
|
t4
|
||||||
Builder_db.Rep.uuid
|
Builder_db.Rep.uuid
|
||||||
string
|
string
|
||||||
(option Builder_db.Rep.cstruct)
|
(option octets)
|
||||||
(option Builder_db.Rep.cstruct))
|
(option octets))
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -587,7 +586,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 `Hex viz_input_hash = Hex.of_cstruct hash in
|
let viz_input_hash = Ohex.encode hash in
|
||||||
let* viz_path =
|
let* viz_path =
|
||||||
Viz_aux.choose_versioned_viz_path
|
Viz_aux.choose_versioned_viz_path
|
||||||
~cachedir
|
~cachedir
|
||||||
|
@ -667,7 +666,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 `Hex input_hash = Hex.of_cstruct input_hash in
|
let input_hash = Ohex.encode input_hash in
|
||||||
let viz_path = Viz_aux.viz_path
|
let viz_path = Viz_aux.viz_path
|
||||||
~cachedir
|
~cachedir
|
||||||
~viz_typ
|
~viz_typ
|
||||||
|
@ -741,8 +740,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, cs) ->
|
| Ok (a, rest) ->
|
||||||
if Cstruct.length cs = 0
|
if String.length rest = 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)
|
||||||
|
@ -808,8 +807,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 cs = Builder.Asn.exec_to_cs exec in
|
let data = Builder.Asn.exec_to_str exec in
|
||||||
Bos.OS.File.write (Fpath.v dest) (Cstruct.to_string cs)
|
Bos.OS.File.write (Fpath.v dest) data
|
||||||
in
|
in
|
||||||
or_die 1 r
|
or_die 1 r
|
||||||
|
|
||||||
|
|
|
@ -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" Cstruct.hexdump_pp (Cstruct.of_bytes buf)) ; *)
|
(* Logs.debug (fun m -> m "writing %a" (Ohex.pp_hexdump ()) (Bytes.unsafe_to_string buf)) ; *)
|
||||||
w 0 (Bytes.length buf)
|
w 0 (Bytes.length buf)
|
||||||
|
|
||||||
let process =
|
let process =
|
||||||
|
|
|
@ -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
|
||||||
Builder_db.Rep.cstruct
|
Caqti_type.octets
|
||||||
Builder_db.Rep.cstruct
|
Caqti_type.octets
|
||||||
Builder_db.Rep.cstruct @@
|
Caqti_type.octets @@
|
||||||
{| 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 Builder_db.Rep.cstruct ->. Caqti_type.unit @@
|
Caqti_type.t2 Builder_db.Rep.untyped_id Caqti_type.octets ->. 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 = Mirage_crypto.Hash.SHA256.digest (Cstruct.concat [ opam_sha ; env_sha ; pkg_sha ]) in
|
let input_id = Digestif.SHA256.(to_raw_string (digestv_string [ 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) ()
|
||||||
|
|
|
@ -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 * Cstruct.t) * (int64 * [`build] Builder_db.Rep.id), unit, [ `Zero]) Caqti_request.t =
|
let add_artifact : ((Fpath.t * Fpath.t * string) * (int64 * [`build] Builder_db.Rep.id), unit, [ `Zero]) Caqti_request.t =
|
||||||
Caqti_type.(t2 (t3 Builder_db.Rep.fpath Builder_db.Rep.fpath Builder_db.Rep.cstruct)
|
Caqti_type.(t2 (t3 Builder_db.Rep.fpath Builder_db.Rep.fpath Caqti_type.octets)
|
||||||
(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,7 +48,8 @@ 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) and sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
|
let size = Int64.of_int (String.length data)
|
||||||
|
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,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, cs) ->
|
| Ok (a, rest) ->
|
||||||
if Cstruct.length cs = 0
|
if String.length rest = 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) Builder_db.Rep.cstruct string) @@
|
(t2 string Builder_db.Rep.uuid) octets 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 ])) Builder_db.Rep.cstruct string) ->.
|
Caqti_type.(t3 (Builder_db.Rep.id (`build : [ `build ])) octets 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"
|
||||||
|
|
||||||
|
|
|
@ -17,18 +17,16 @@ build: [
|
||||||
depends: [
|
depends: [
|
||||||
"ocaml" {>= "4.13.0"}
|
"ocaml" {>= "4.13.0"}
|
||||||
"dune" {>= "2.7.0"}
|
"dune" {>= "2.7.0"}
|
||||||
"builder" {>= "0.2.0"}
|
"builder" {>= "0.4.0"}
|
||||||
"dream" {>= "1.0.0~alpha4"}
|
"dream" {>= "1.0.0~alpha7"}
|
||||||
"cstruct" {>= "6.0.0"}
|
|
||||||
"bos"
|
"bos"
|
||||||
"hex"
|
"ohex" {>= "0.2.0"}
|
||||||
"lwt" {>= "5.7.0"}
|
"lwt" {>= "5.7.0"}
|
||||||
"caqti" {>= "2.1.1"}
|
"caqti" {>= "2.1.2"}
|
||||||
"caqti-lwt"
|
"caqti-lwt"
|
||||||
"caqti-driver-sqlite3"
|
"caqti-driver-sqlite3"
|
||||||
"pbkdf"
|
|
||||||
"mirage-crypto-rng" {>= "0.11.0"}
|
"mirage-crypto-rng" {>= "0.11.0"}
|
||||||
"scrypt-kdf"
|
"kdf"
|
||||||
"opam-core"
|
"opam-core"
|
||||||
"opam-format" {>= "2.1.0"}
|
"opam-format" {>= "2.1.0"}
|
||||||
"metrics" {>= "0.3.0"}
|
"metrics" {>= "0.3.0"}
|
||||||
|
@ -39,8 +37,7 @@ depends: [
|
||||||
"tyxml" {>= "4.3.0"}
|
"tyxml" {>= "4.3.0"}
|
||||||
"ptime"
|
"ptime"
|
||||||
"duration"
|
"duration"
|
||||||
"mirage-crypto"
|
"asn1-combinators" {>= "0.3.0"}
|
||||||
"asn1-combinators"
|
|
||||||
"logs"
|
"logs"
|
||||||
"cmdliner" {>= "1.1.0"}
|
"cmdliner" {>= "1.1.0"}
|
||||||
"uri"
|
"uri"
|
||||||
|
@ -51,6 +48,7 @@ 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}
|
||||||
|
|
|
@ -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 : Cstruct.t;
|
sha256 : string;
|
||||||
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 =
|
||||||
cstruct ->! Caqti_type.bool @@
|
Caqti_type.octets ->! 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 : Cstruct.t option;
|
input_id : string 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 (using Cstruct.to_string string)) t.input_id
|
Fmt.(Dump.option 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 Rep.cstruct)
|
(option octets)
|
||||||
(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)) ->* Rep.cstruct @@
|
Caqti_type.(t2 (id `job) (option string)) ->* Caqti_type.octets @@
|
||||||
{| 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 ->* Rep.cstruct @@
|
id `build ->* Caqti_type.octets @@
|
||||||
{| 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 ->* Rep.cstruct @@
|
id `build ->* Caqti_type.octets @@
|
||||||
{| 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 =
|
||||||
Rep.cstruct ->! t @@
|
Caqti_type.octets ->! 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 =
|
||||||
Rep.cstruct ->! t @@
|
Caqti_type.octets ->! 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 =
|
||||||
Rep.cstruct ->! Caqti_type.t2 t file_opt @@
|
Caqti_type.octets ->! 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 =
|
||||||
Rep.cstruct ->? Caqti_type.t2 Caqti_type.string t @@
|
Caqti_type.octets ->? 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,
|
||||||
|
|
|
@ -3,7 +3,7 @@ module Rep : sig
|
||||||
type 'a id
|
type 'a id
|
||||||
type file = {
|
type file = {
|
||||||
filepath : Fpath.t;
|
filepath : Fpath.t;
|
||||||
sha256 : Cstruct.t;
|
sha256 : string;
|
||||||
size : int;
|
size : int;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -13,7 +13,6 @@ 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
|
||||||
|
@ -22,7 +21,7 @@ type 'a id = 'a Rep.id
|
||||||
|
|
||||||
type file = Rep.file = {
|
type file = Rep.file = {
|
||||||
filepath : Fpath.t;
|
filepath : Fpath.t;
|
||||||
sha256 : Cstruct.t;
|
sha256 : string;
|
||||||
size : int;
|
size : int;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -85,7 +84,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 : (Cstruct.t, bool, [ `One ]) Caqti_request.t
|
val exists : (string, 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 :
|
||||||
|
@ -105,7 +104,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 : Cstruct.t option;
|
input_id : string option;
|
||||||
user_id : [`user] id;
|
user_id : [`user] id;
|
||||||
job_id : [`job] id;
|
job_id : [`job] id;
|
||||||
}
|
}
|
||||||
|
@ -120,7 +119,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, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
|
([`job] id * string option, string, [ `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
|
||||||
|
@ -144,20 +143,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, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
|
([`build] id, string, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||||
val get_different_input_same_output_input_ids :
|
val get_different_input_same_output_input_ids :
|
||||||
([`build] id, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t
|
([`build] id, string, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||||
val get_one_by_input_id :
|
val get_one_by_input_id :
|
||||||
(Cstruct.t, t, [ `One ]) Caqti_request.t
|
(string, 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 :
|
||||||
(Cstruct.t, t, [ `One]) Caqti_request.t
|
(string, t, [ `One]) Caqti_request.t
|
||||||
val get_with_main_binary_by_hash :
|
val get_with_main_binary_by_hash :
|
||||||
(Cstruct.t, t * file option, [ `One]) Caqti_request.t
|
(string, t * file option, [ `One]) Caqti_request.t
|
||||||
val get_with_jobname_by_hash :
|
val get_with_jobname_by_hash :
|
||||||
(Cstruct.t, string * t, [ `One | `Zero]) Caqti_request.t
|
(string, 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
3
db/dune
|
@ -1,4 +1,3 @@
|
||||||
(library
|
(library
|
||||||
(name builder_db)
|
(name builder_db)
|
||||||
(libraries builder caqti caqti-driver-sqlite3 asn1-combinators mirage-crypto
|
(libraries builder caqti caqti-driver-sqlite3 asn1-combinators builder_web_auth))
|
||||||
builder_web_auth))
|
|
||||||
|
|
|
@ -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, cs) ->
|
| Ok (a, rest) ->
|
||||||
if Cstruct.length cs = 0
|
if String.length rest = 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_cs, console_to_cs = projections_of console
|
let console_of_str, console_to_str = 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 : Cstruct.t;
|
sha256 : string;
|
||||||
size : int;
|
size : int;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -56,20 +56,15 @@ 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 cstruct int)
|
Caqti_type.custom ~encode ~decode Caqti_type.(t3 fpath octets int)
|
||||||
|
|
||||||
let file_opt =
|
let file_opt =
|
||||||
let rep = Caqti_type.(t3 (option fpath) (option cstruct) (option int)) in
|
let rep = Caqti_type.(t3 (option fpath) (option octets) (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)
|
||||||
|
@ -112,12 +107,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_cs console) in
|
let encode console = Ok (Asn.console_to_str console) in
|
||||||
let decode data = Asn.console_of_cs data in
|
let decode data = Asn.console_of_str data in
|
||||||
Caqti_type.custom ~encode ~decode cstruct
|
Caqti_type.(custom ~encode ~decode octets)
|
||||||
|
|
||||||
let user_info =
|
let user_info =
|
||||||
let rep = Caqti_type.(t7 string cstruct cstruct int int int bool) in
|
let rep = Caqti_type.(t7 string octets octets 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
|
||||||
|
|
|
@ -199,10 +199,6 @@ 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) ->
|
||||||
|
@ -220,7 +216,7 @@ 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
|
||||||
|> hex
|
|> Ohex.encode
|
||||||
|> Lwt_result.return
|
|> Lwt_result.return
|
||||||
end
|
end
|
||||||
| `Dependencies ->
|
| `Dependencies ->
|
||||||
|
@ -232,7 +228,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
|
||||||
|> hex
|
|> Ohex.encode
|
||||||
|> 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 =
|
||||||
|
@ -428,7 +424,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 (Cstruct.to_string file.Builder_db.sha256) in
|
let etag = Base64.encode_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
|
||||||
|
@ -498,7 +494,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_cs (Cstruct.of_string body) |> Lwt.return
|
Builder.Asn.exec_of_str 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");
|
||||||
|
@ -530,7 +526,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 Hex.to_cstruct (`Hex hash_hex) |> Lwt_result.return
|
begin try Ohex.decode 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
4
lib/dune
|
@ -1,5 +1,5 @@
|
||||||
(library
|
(library
|
||||||
(name builder_web)
|
(name builder_web)
|
||||||
(libraries builder builder_db dream tyxml bos duration hex caqti-lwt
|
(libraries builder builder_db dream tyxml bos duration ohex 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))
|
decompress.gz uri digestif))
|
||||||
|
|
13
lib/model.ml
13
lib/model.ml
|
@ -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 (`Hex sha256) = Hex.of_cstruct artifact.Builder_db.sha256 in
|
let sha256 = Ohex.encode 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 (`Hex sha256) = Hex.of_cstruct file.Builder_db.sha256 in
|
let sha256 = Ohex.encode 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 (`Hex sha256) = Hex.of_cstruct artifact.Builder_db.sha256 in
|
let sha256 = Ohex.encode 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,7 +306,8 @@ 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 (Mirage_crypto.Hash.SHA256.digest (Cstruct.concat [a;b;c]))
|
| Some a, Some b, Some 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 =
|
||||||
|
@ -377,7 +378,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 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data)
|
let sha256 = Digestif.SHA256.(to_raw_string (digest_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)
|
||||||
|
@ -483,7 +484,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 `Hex sha256 = Hex.of_cstruct main_binary.sha256
|
and sha256 = Ohex.encode 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 =
|
||||||
|
|
|
@ -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 : Cstruct.t -> Caqti_lwt.connection ->
|
val build_hash : string -> 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 ->
|
||||||
|
|
|
@ -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" Hex.pp (Hex.of_cstruct sha256)];
|
H.code [txtf "SHA256:%a" Ohex.pp 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 (`Hex sha256_hex) = Hex.of_cstruct file.sha256 in
|
let sha256_hex = Ohex.encode 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
|
||||||
|
|
|
@ -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))
|
(libraries ptime.clock.os builder_db caqti.blocking alcotest mirage-crypto-rng.unix ohex))
|
||||||
|
|
||||||
(test
|
(test
|
||||||
(name markdown_to_html)
|
(name markdown_to_html)
|
||||||
|
|
|
@ -165,10 +165,9 @@ 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 `Hex sha_str =
|
let sha_str =
|
||||||
Cstruct.of_string "foo"
|
Digestif.SHA256.(to_raw_string (digest_string "foo"))
|
||||||
|> Mirage_crypto.Hash.SHA256.digest
|
|> Ohex.encode
|
||||||
|> Hex.of_cstruct
|
|
||||||
in
|
in
|
||||||
Fmt.str "/hash?sha256=%s" sha_str
|
Fmt.str "/hash?sha256=%s" sha_str
|
||||||
end;
|
end;
|
||||||
|
|
|
@ -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') ->
|
||||||
Cstruct.equal hash hash' &&
|
String.equal hash hash' &&
|
||||||
Cstruct.equal salt salt' &&
|
String.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
|
||||||
Cstruct.hexdump_pp hash Cstruct.hexdump_pp salt
|
Ohex.pp hash Ohex.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 &&
|
||||||
Cstruct.equal x.sha256 y.sha256 &&
|
String.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 Cstruct.hexdump_pp sha256 size
|
Fpath.pp filepath Ohex.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 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
|
let sha256 = Digestif.SHA256.(to_raw_string (digest_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 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
|
let sha256 = Digestif.SHA256.(to_raw_string (digest_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"
|
||||||
|
|
Loading…
Reference in a new issue