remove usage of cstruct, require mirage-crypto 1.0.0 #1
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 }
|
||||
|
||||
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 ]
|
||||
|
||||
|
@ -25,10 +25,10 @@ type 'a user_info = {
|
|||
}
|
||||
|
||||
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 =
|
||||
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 ())
|
||||
~username ~password ~restricted () =
|
||||
|
@ -43,10 +43,10 @@ let hash ?(scrypt_params=scrypt_params ())
|
|||
let verify_password password user_info =
|
||||
match user_info.password_hash with
|
||||
| `Pbkdf2_sha256 (password_hash, salt, params) ->
|
||||
Cstruct.equal
|
||||
String.equal
|
||||
|
||||
(pbkdf2_sha256 ~params ~salt ~password)
|
||||
password_hash
|
||||
| `Scrypt (password_hash, salt, params) ->
|
||||
Cstruct.equal
|
||||
String.equal
|
||||
(scrypt ~params ~salt ~password)
|
||||
password_hash
|
||||
|
|
|
@ -1,3 +1,3 @@
|
|||
(library
|
||||
(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"
|
||||
|
||||
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
|
||||
WHERE a.build = ? AND
|
||||
(SELECT COUNT(*) FROM build_artifact a2
|
||||
|
@ -45,7 +45,7 @@ let migrate () dbpath =
|
|||
|
||||
let artifacts_dir datadir = Fpath.(datadir / "_artifacts")
|
||||
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: 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
|
||||
|
@ -108,7 +108,7 @@ let user_disable () dbpath username =
|
|||
match user with
|
||||
| None -> Error (`Msg "user not found")
|
||||
| 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
|
||||
Db.exec Builder_db.User.update_user user_info
|
||||
in
|
||||
|
@ -296,12 +296,12 @@ let vacuum () datadir platform_opt jobnames predicate =
|
|||
or_die 1 r
|
||||
|
||||
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"
|
||||
|
||||
let main_artifact_hash =
|
||||
Builder_db.Rep.cstruct ->*
|
||||
Caqti_type.t3 Builder_db.Rep.cstruct Builder_db.Rep.uuid Caqti_type.string @@
|
||||
Caqti_type.octets ->*
|
||||
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
|
||||
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
|
||||
| (h, uuid, jobname) :: tl ->
|
||||
List.iter (fun (h', uuid', _) ->
|
||||
if Cstruct.equal h h' then
|
||||
if String.equal h h' then
|
||||
()
|
||||
else
|
||||
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
|
||||
Cstruct.hexdump_pp h Cstruct.hexdump_pp h'
|
||||
jobname Ohex.pp input_id
|
||||
Ohex.pp h Ohex.pp h'
|
||||
Uuidm.pp uuid Uuidm.pp uuid'))
|
||||
tl
|
||||
| [] -> ())
|
||||
|
@ -336,10 +336,9 @@ let num_build_artifacts =
|
|||
Caqti_type.unit ->! Caqti_type.int @@
|
||||
"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.(t5 string Builder_db.Rep.uuid Builder_db.Rep.fpath
|
||||
Builder_db.Rep.cstruct int64)
|
||||
Caqti_type.(t5 string Builder_db.Rep.uuid Builder_db.Rep.fpath octets int64)
|
||||
@@
|
||||
{| SELECT job.name, b.uuid, a.filepath, a.sha256, a.size
|
||||
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;
|
||||
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);
|
||||
let sha256' = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
|
||||
if not (Cstruct.equal sha256 sha256') then
|
||||
let sha256' = Digestif.SHA256.(to_raw_string (digest_string data)) in
|
||||
if not (String.equal sha256 sha256') then
|
||||
Logs.err (fun m -> m "File %a has different hash (in DB %a on disk %a)"
|
||||
Fpath.pp abs_path
|
||||
Hex.pp (Hex.of_cstruct sha256)
|
||||
Hex.pp (Hex.of_cstruct sha256'))) ;
|
||||
Ohex.pp sha256
|
||||
Ohex.pp sha256')) ;
|
||||
Ok ()
|
||||
else
|
||||
Ok ()
|
||||
|
@ -545,8 +544,8 @@ module Verify_cache_dir = struct
|
|||
type t = {
|
||||
uuid : Uuidm.t;
|
||||
job_name : string;
|
||||
hash_opam_switch : Cstruct.t option;
|
||||
hash_debug_bin : Cstruct.t option;
|
||||
hash_opam_switch : string option;
|
||||
hash_debug_bin : string option;
|
||||
}
|
||||
|
||||
let repr =
|
||||
|
@ -560,8 +559,8 @@ module Verify_cache_dir = struct
|
|||
t4
|
||||
Builder_db.Rep.uuid
|
||||
string
|
||||
(option Builder_db.Rep.cstruct)
|
||||
(option Builder_db.Rep.cstruct))
|
||||
(option octets)
|
||||
(option octets))
|
||||
|
||||
end
|
||||
|
||||
|
@ -587,7 +586,7 @@ module Verify_cache_dir = struct
|
|||
let* latest_version =
|
||||
Viz_aux.get_viz_version_from_dirs ~cachedir ~viz_typ
|
||||
in
|
||||
let `Hex viz_input_hash = Hex.of_cstruct hash in
|
||||
let viz_input_hash = Ohex.encode hash in
|
||||
let* viz_path =
|
||||
Viz_aux.choose_versioned_viz_path
|
||||
~cachedir
|
||||
|
@ -667,7 +666,7 @@ module Verify_cache_dir = struct
|
|||
match extract_hash ~viz_typ build with
|
||||
| None -> ()
|
||||
| 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
|
||||
~cachedir
|
||||
~viz_typ
|
||||
|
@ -741,8 +740,8 @@ end
|
|||
module Asn = struct
|
||||
let decode_strict codec cs =
|
||||
match Asn.decode codec cs with
|
||||
| Ok (a, cs) ->
|
||||
if Cstruct.length cs = 0
|
||||
| Ok (a, rest) ->
|
||||
if String.length rest = 0
|
||||
then Ok a
|
||||
else Error "trailing bytes"
|
||||
| Error (`Parse msg) -> Error ("parse error: " ^ msg)
|
||||
|
@ -808,8 +807,8 @@ let extract_full () datadir dest uuid =
|
|||
artifacts
|
||||
in
|
||||
let exec = (job, uuid, out, start, finish, result, data) in
|
||||
let cs = Builder.Asn.exec_to_cs exec in
|
||||
Bos.OS.File.write (Fpath.v dest) (Cstruct.to_string cs)
|
||||
let data = Builder.Asn.exec_to_str exec in
|
||||
Bos.OS.File.write (Fpath.v dest) data
|
||||
in
|
||||
or_die 1 r
|
||||
|
||||
|
|
|
@ -30,7 +30,7 @@ let write_raw s buf =
|
|||
safe_close s >|= fun () ->
|
||||
Error `Exception)
|
||||
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)
|
||||
|
||||
let process =
|
||||
|
|
|
@ -57,9 +57,9 @@ let builds =
|
|||
Caqti_type.unit ->*
|
||||
Caqti_type.t4
|
||||
Builder_db.Rep.untyped_id
|
||||
Builder_db.Rep.cstruct
|
||||
Builder_db.Rep.cstruct
|
||||
Builder_db.Rep.cstruct @@
|
||||
Caqti_type.octets
|
||||
Caqti_type.octets
|
||||
Caqti_type.octets @@
|
||||
{| SELECT b.id, opam.sha256, env.sha256, system.sha256
|
||||
FROM build b, build_artifact opam, build_artifact env, build_artifact system
|
||||
WHERE opam.filepath = 'opam-switch' AND env.filepath = 'build-environment'
|
||||
|
@ -68,7 +68,7 @@ let builds =
|
|||
|}
|
||||
|
||||
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"
|
||||
|
||||
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.collect_list builds () >>= fun builds ->
|
||||
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
|
||||
hannes marked this conversation as resolved
reynir
commented
I like this! We now avoid allocating an intermediate string :D I like this! We now avoid allocating an intermediate string :D
|
||||
Db.exec set_input_id (id, input_id))
|
||||
builds >>= fun () ->
|
||||
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 @@
|
||||
"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 =
|
||||
Caqti_type.(t2 (t3 Builder_db.Rep.fpath Builder_db.Rep.fpath Builder_db.Rep.cstruct)
|
||||
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 Caqti_type.octets)
|
||||
(t2 Caqti_type.int64 (Builder_db.Rep.id `build))) ->.
|
||||
Caqti_type.unit @@
|
||||
"INSERT INTO build_artifact (filepath, localpath, sha256, size, build) VALUES (?, ?, ?, ?, ?)"
|
||||
|
@ -48,7 +48,8 @@ let fixup datadir (module Db : Caqti_blocking.CONNECTION) =
|
|||
in
|
||||
assert (r = 0);
|
||||
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 add_artifact ((artifact_fpath, artifact_lpath, sha256), (size, build_id)) >>= fun () ->
|
||||
Db.find Builder_db.last_insert_rowid () >>= fun new_build_artifact_id ->
|
||||
|
|
|
@ -8,8 +8,8 @@ open Grej.Infix
|
|||
module Asn = struct
|
||||
let decode_strict codec cs =
|
||||
match Asn.decode codec cs with
|
||||
| Ok (a, cs) ->
|
||||
if Cstruct.length cs = 0
|
||||
| Ok (a, rest) ->
|
||||
if String.length rest = 0
|
||||
then Ok a
|
||||
else Error "trailing bytes"
|
||||
| Error (`Parse msg) -> Error ("parse error: " ^ msg)
|
||||
|
@ -96,7 +96,7 @@ let copy_from_new_build =
|
|||
let old_build_console_script =
|
||||
Caqti_type.unit ->*
|
||||
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"
|
||||
|
||||
let update_new_build_console_script =
|
||||
|
@ -112,7 +112,7 @@ let new_build_console_script =
|
|||
"SELECT id, console, script FROM build"
|
||||
|
||||
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 @@
|
||||
"UPDATE new_build SET console = $2, script = $3 WHERE id = $1"
|
||||
|
||||
|
|
|
@ -17,18 +17,16 @@ build: [
|
|||
depends: [
|
||||
"ocaml" {>= "4.13.0"}
|
||||
"dune" {>= "2.7.0"}
|
||||
"builder" {>= "0.2.0"}
|
||||
"dream" {>= "1.0.0~alpha4"}
|
||||
"cstruct" {>= "6.0.0"}
|
||||
"builder" {>= "0.4.0"}
|
||||
"dream" {>= "1.0.0~alpha7"}
|
||||
"bos"
|
||||
"hex"
|
||||
"ohex" {>= "0.2.0"}
|
||||
"lwt" {>= "5.7.0"}
|
||||
"caqti" {>= "2.1.1"}
|
||||
"caqti" {>= "2.1.2"}
|
||||
hannes marked this conversation as resolved
Outdated
reynir
commented
This will need to be updated once we have a caqti release. This will need to be updated once we have a caqti release.
|
||||
"caqti-lwt"
|
||||
"caqti-driver-sqlite3"
|
||||
"pbkdf"
|
||||
"mirage-crypto-rng" {>= "0.11.0"}
|
||||
"scrypt-kdf"
|
||||
"kdf"
|
||||
"opam-core"
|
||||
"opam-format" {>= "2.1.0"}
|
||||
"metrics" {>= "0.3.0"}
|
||||
|
@ -39,8 +37,7 @@ depends: [
|
|||
"tyxml" {>= "4.3.0"}
|
||||
"ptime"
|
||||
"duration"
|
||||
"mirage-crypto"
|
||||
"asn1-combinators"
|
||||
"asn1-combinators" {>= "0.3.0"}
|
||||
"logs"
|
||||
"cmdliner" {>= "1.1.0"}
|
||||
"uri"
|
||||
|
@ -51,6 +48,7 @@ depends: [
|
|||
"owee"
|
||||
"solo5-elftool" {>= "0.3.0"}
|
||||
"decompress" {>= "1.5.0"}
|
||||
"digestif" {>= "1.2.0"}
|
||||
"alcotest" {>= "1.2.0" & with-test}
|
||||
"ppx_deriving" {with-test}
|
||||
"ppx_deriving_yojson" {with-test}
|
||||
|
|
|
@ -12,7 +12,7 @@ type 'a id = 'a Rep.id
|
|||
|
||||
type file = Rep.file = {
|
||||
filepath : Fpath.t;
|
||||
sha256 : Cstruct.t;
|
||||
sha256 : string;
|
||||
size : int;
|
||||
}
|
||||
|
||||
|
@ -172,7 +172,7 @@ module Build_artifact = struct
|
|||
"SELECT id, filepath, sha256, size FROM build_artifact WHERE build = ?"
|
||||
|
||||
let exists =
|
||||
cstruct ->! Caqti_type.bool @@
|
||||
Caqti_type.octets ->! Caqti_type.bool @@
|
||||
"SELECT EXISTS(SELECT 1 FROM build_artifact WHERE sha256 = ?)"
|
||||
|
||||
let add =
|
||||
|
@ -199,7 +199,7 @@ module Build = struct
|
|||
script : Fpath.t;
|
||||
platform : string;
|
||||
main_binary : [`build_artifact] id option;
|
||||
input_id : Cstruct.t option;
|
||||
input_id : string option;
|
||||
user_id : [`user] id;
|
||||
job_id : [`job] id;
|
||||
}
|
||||
|
@ -224,7 +224,7 @@ module Build = struct
|
|||
Fpath.pp t.script
|
||||
t.platform
|
||||
Fmt.(Dump.option int64) t.main_binary
|
||||
Fmt.(Dump.option (using Cstruct.to_string string)) t.input_id
|
||||
hannes marked this conversation as resolved
Outdated
reynir
commented
Reading the documentation for Reading the documentation for `Fmt.using` I'm confused what it does. But the new code looks good to me.
|
||||
Fmt.(Dump.option string) t.input_id
|
||||
t.user_id
|
||||
t.job_id
|
||||
|
||||
|
@ -240,7 +240,7 @@ module Build = struct
|
|||
fpath
|
||||
string
|
||||
(option (Rep.id `build_artifact))
|
||||
(option Rep.cstruct)
|
||||
(option octets)
|
||||
(id `user)
|
||||
(id `job))
|
||||
in
|
||||
|
@ -314,7 +314,7 @@ module Build = struct
|
|||
|}
|
||||
|
||||
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
|
||||
FROM build_artifact a, build b
|
||||
WHERE b.job = $1 AND b.main_binary = a.id
|
||||
|
@ -446,7 +446,7 @@ module Build = struct
|
|||
|}
|
||||
|
||||
let get_same_input_different_output_hashes =
|
||||
id `build ->* Rep.cstruct @@
|
||||
id `build ->* Caqti_type.octets @@
|
||||
{| SELECT DISTINCT a.sha256
|
||||
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
|
||||
|
@ -455,7 +455,7 @@ module Build = struct
|
|||
|}
|
||||
|
||||
let get_different_input_same_output_input_ids =
|
||||
id `build ->* Rep.cstruct @@
|
||||
id `build ->* Caqti_type.octets @@
|
||||
{| SELECT DISTINCT b.input_id
|
||||
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
|
||||
|
@ -463,7 +463,7 @@ module Build = struct
|
|||
|}
|
||||
|
||||
let get_one_by_input_id =
|
||||
Rep.cstruct ->! t @@
|
||||
Caqti_type.octets ->! t @@
|
||||
{| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
|
||||
result_code, result_msg, console, script,
|
||||
platform, main_binary, input_id, user, job
|
||||
|
@ -487,7 +487,7 @@ module Build = struct
|
|||
|}
|
||||
|
||||
let get_by_hash =
|
||||
Rep.cstruct ->! t @@
|
||||
Caqti_type.octets ->! t @@
|
||||
{| 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,
|
||||
|
@ -500,7 +500,7 @@ module Build = struct
|
|||
|}
|
||||
|
||||
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,
|
||||
b.result_code, b.result_msg, b.console, b.script,
|
||||
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 =
|
||||
Rep.cstruct ->? Caqti_type.t2 Caqti_type.string t @@
|
||||
Caqti_type.octets ->? Caqti_type.t2 Caqti_type.string t @@
|
||||
{| SELECT job.name,
|
||||
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
|
||||
b.result_code, b.result_msg,
|
||||
|
|
|
@ -3,7 +3,7 @@ module Rep : sig
|
|||
type 'a id
|
||||
type file = {
|
||||
filepath : Fpath.t;
|
||||
sha256 : Cstruct.t;
|
||||
sha256 : string;
|
||||
size : int;
|
||||
}
|
||||
|
||||
|
@ -13,7 +13,6 @@ module Rep : sig
|
|||
val uuid : Uuidm.t Caqti_type.t
|
||||
val ptime : Ptime.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 execution_result : Builder.execution_result 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 = {
|
||||
filepath : Fpath.t;
|
||||
sha256 : Cstruct.t;
|
||||
sha256 : string;
|
||||
size : int;
|
||||
}
|
||||
|
||||
|
@ -85,7 +84,7 @@ module Build_artifact : sig
|
|||
Caqti_request.t
|
||||
val get_all_by_build :
|
||||
([`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 :
|
||||
(file * [`build] id, unit, [ `Zero ]) Caqti_request.t
|
||||
val remove_by_build :
|
||||
|
@ -105,7 +104,7 @@ sig
|
|||
script : Fpath.t;
|
||||
platform : string;
|
||||
main_binary : [`build_artifact] id option;
|
||||
input_id : Cstruct.t option;
|
||||
input_id : string option;
|
||||
user_id : [`user] id;
|
||||
job_id : [`job] id;
|
||||
}
|
||||
|
@ -120,7 +119,7 @@ sig
|
|||
val get_all_failed :
|
||||
(int * int * string option, string * t, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
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 :
|
||||
([`job] id * string, [`build] id * t * file, [ `One | `Zero ])
|
||||
Caqti_request.t
|
||||
|
@ -144,20 +143,20 @@ sig
|
|||
val get_same_input_same_output_builds :
|
||||
([`build] id, t, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
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 :
|
||||
([`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 :
|
||||
(Cstruct.t, t, [ `One ]) Caqti_request.t
|
||||
(string, t, [ `One ]) Caqti_request.t
|
||||
val get_platforms_for_job :
|
||||
([`job] id, string, [ `Many | `One | `Zero ]) Caqti_request.t
|
||||
val add : (t, unit, [ `Zero ]) Caqti_request.t
|
||||
val get_by_hash :
|
||||
(Cstruct.t, t, [ `One]) Caqti_request.t
|
||||
(string, t, [ `One]) Caqti_request.t
|
||||
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 :
|
||||
(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 remove : ([`build] id, unit, [ `Zero]) Caqti_request.t
|
||||
end
|
||||
|
|
3
db/dune
3
db/dune
|
@ -1,4 +1,3 @@
|
|||
(library
|
||||
(name builder_db)
|
||||
(libraries builder caqti caqti-driver-sqlite3 asn1-combinators mirage-crypto
|
||||
builder_web_auth))
|
||||
(libraries builder caqti caqti-driver-sqlite3 asn1-combinators builder_web_auth))
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
module Asn = struct
|
||||
let decode_strict codec cs =
|
||||
match Asn.decode codec cs with
|
||||
| Ok (a, cs) ->
|
||||
if Cstruct.length cs = 0
|
||||
| Ok (a, rest) ->
|
||||
if String.length rest = 0
|
||||
then Ok a
|
||||
else Error "trailing bytes"
|
||||
| Error (`Parse msg) -> Error ("parse error: " ^ msg)
|
||||
|
@ -17,7 +17,7 @@ module Asn = struct
|
|||
(required ~label:"delta" int)
|
||||
(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
|
||||
|
||||
type untyped_id = int64
|
||||
|
@ -30,7 +30,7 @@ let id_to_int64 (id : 'a id) : int64 = id
|
|||
|
||||
type file = {
|
||||
filepath : Fpath.t;
|
||||
sha256 : Cstruct.t;
|
||||
sha256 : string;
|
||||
size : int;
|
||||
}
|
||||
|
||||
|
@ -56,20 +56,15 @@ let fpath =
|
|||
|> Result.map_error (fun (`Msg s) -> s) in
|
||||
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 encode { filepath; sha256; size } =
|
||||
Ok (filepath, sha256, size) in
|
||||
let decode (filepath, sha256, size) =
|
||||
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 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
|
||||
| Some { filepath; sha256; size } ->
|
||||
Ok (Some filepath, Some sha256, Some size)
|
||||
|
@ -112,12 +107,12 @@ let execution_result =
|
|||
Caqti_type.custom ~encode ~decode rep
|
||||
|
||||
let console =
|
||||
let encode console = Ok (Asn.console_to_cs console) in
|
||||
let decode data = Asn.console_of_cs data in
|
||||
Caqti_type.custom ~encode ~decode cstruct
|
||||
let encode console = Ok (Asn.console_to_str console) in
|
||||
let decode data = Asn.console_of_str data in
|
||||
Caqti_type.(custom ~encode ~decode octets)
|
||||
|
||||
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;
|
||||
password_hash = `Scrypt (password_hash, password_salt, {
|
||||
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 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 ->
|
||||
Model.build uuid db
|
||||
|> if_error "Error getting build" >>= fun (build_id, _build) ->
|
||||
|
@ -220,7 +216,7 @@ module Viz_aux = struct
|
|||
Model.not_found debug_binary
|
||||
|> not_found_error >>= fun debug_binary ->
|
||||
debug_binary.sha256
|
||||
|> hex
|
||||
|> Ohex.encode
|
||||
|> Lwt_result.return
|
||||
end
|
||||
| `Dependencies ->
|
||||
|
@ -232,7 +228,7 @@ module Viz_aux = struct
|
|||
Model.not_found opam_switch
|
||||
|> not_found_error >>= fun opam_switch ->
|
||||
opam_switch.sha256
|
||||
|> hex
|
||||
|> Ohex.encode
|
||||
|> Lwt_result.return
|
||||
|
||||
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 ->
|
||||
Dream.sql req (Model.build_artifact build filepath)
|
||||
|> 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
|
||||
| Some etag' when etag = etag' ->
|
||||
Dream.empty `Not_Modified |> Lwt_result.ok
|
||||
|
@ -498,7 +494,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
|
|||
|
||||
let upload req =
|
||||
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"
|
||||
~log:(fun e ->
|
||||
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")
|
||||
|> Lwt.return
|
||||
|> 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))
|
||||
end
|
||||
|> if_error ~status:`Bad_Request "Bad request" >>= fun hash ->
|
||||
|
|
4
lib/dune
4
lib/dune
|
@ -1,5 +1,5 @@
|
|||
(library
|
||||
(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
|
||||
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 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: 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
|
||||
|
@ -221,7 +221,7 @@ let save_artifacts staging artifacts =
|
|||
List.fold_left
|
||||
(fun r (file, data) ->
|
||||
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
|
||||
save destpath data)
|
||||
(Lwt_result.return ())
|
||||
|
@ -232,7 +232,7 @@ let commit_files datadir staging_dir job_name uuid artifacts =
|
|||
List.fold_left
|
||||
(fun r artifact ->
|
||||
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 dest = Fpath.(datadir // artifact_path artifact) in
|
||||
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 "system-packages")
|
||||
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
|
||||
|
||||
let save_console_and_script staging_dir job_name uuid console script =
|
||||
|
@ -377,7 +378,7 @@ let add_build
|
|||
if not_interesting filepath then
|
||||
Lwt_result.return acc
|
||||
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
|
||||
Lwt_result.ok (Lwt.pause ()) >|= fun () ->
|
||||
({ filepath; sha256; size }, data) :: acc)
|
||||
|
@ -483,7 +484,7 @@ let add_build
|
|||
and uuid = Uuidm.to_string uuid
|
||||
and job = job.name
|
||||
and platform = job.platform
|
||||
and `Hex sha256 = Hex.of_cstruct main_binary.sha256
|
||||
and sha256 = Ohex.encode main_binary.sha256
|
||||
in
|
||||
let fp_str p = Fpath.(to_string (datadir // p)) in
|
||||
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 ->
|
||||
((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
|
||||
|
||||
val build_exists : Uuidm.t -> Caqti_lwt.connection ->
|
||||
|
|
|
@ -202,7 +202,7 @@ let artifact
|
|||
else txtf "%a" Fpath.pp filepath
|
||||
];
|
||||
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;
|
||||
]
|
||||
|
||||
|
@ -491,7 +491,7 @@ module Job_build = struct
|
|||
pp_devices block_devices pp_devices net_devices]
|
||||
in
|
||||
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.a ~a:H.[a_href @@ Link.Job_build_artifact.make
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
(test
|
||||
(name 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
|
||||
(name markdown_to_html)
|
||||
|
|
|
@ -165,10 +165,9 @@ let () =
|
|||
.. to find them I follewed the trails of 'Albatross_cli.http_host'
|
||||
*)
|
||||
begin
|
||||
let `Hex sha_str =
|
||||
Cstruct.of_string "foo"
|
||||
|> Mirage_crypto.Hash.SHA256.digest
|
||||
|> Hex.of_cstruct
|
||||
let sha_str =
|
||||
Digestif.SHA256.(to_raw_string (digest_string "foo"))
|
||||
|> Ohex.encode
|
||||
in
|
||||
Fmt.str "/hash?sha256=%s" sha_str
|
||||
end;
|
||||
|
|
|
@ -25,8 +25,8 @@ module Testable = struct
|
|||
x.restricted = y.restricted &&
|
||||
match x.password_hash, y.password_hash with
|
||||
| `Scrypt (hash, salt, params), `Scrypt (hash', salt', params') ->
|
||||
Cstruct.equal hash hash' &&
|
||||
Cstruct.equal salt salt' &&
|
||||
String.equal hash hash' &&
|
||||
String.equal salt salt' &&
|
||||
params = params'
|
||||
in
|
||||
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 }) ->
|
||||
Format.fprintf ppf "user:%s;(%d,%d,%d);%B;%a;%a" username
|
||||
scrypt_n scrypt_r scrypt_p restricted
|
||||
Cstruct.hexdump_pp hash Cstruct.hexdump_pp salt
|
||||
Ohex.pp hash Ohex.pp salt
|
||||
in
|
||||
Alcotest.testable
|
||||
pp
|
||||
|
@ -43,7 +43,7 @@ module Testable = struct
|
|||
let file =
|
||||
let equal (x : Builder_db.Rep.file) (y : Builder_db.Rep.file) =
|
||||
Fpath.equal x.filepath y.filepath &&
|
||||
Cstruct.equal x.sha256 y.sha256 &&
|
||||
String.equal x.sha256 y.sha256 &&
|
||||
x.size = y.size
|
||||
in
|
||||
let pp ppf { Builder_db.Rep.filepath; sha256; size } =
|
||||
|
@ -51,7 +51,7 @@ module Testable = struct
|
|||
sha256 = %a;@;<1 0>\
|
||||
size = %d;@;<1 0>\
|
||||
@]@,}"
|
||||
Fpath.pp filepath Cstruct.hexdump_pp sha256 size
|
||||
Fpath.pp filepath Ohex.pp sha256 size
|
||||
in
|
||||
Alcotest.testable pp equal
|
||||
|
||||
|
@ -131,12 +131,12 @@ let result = Builder.Exited 0
|
|||
let main_binary =
|
||||
let filepath = Result.get_ok (Fpath.of_string "bin/hello.sh") 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
|
||||
{ Builder_db.Rep.filepath; sha256; size }
|
||||
let main_binary2 =
|
||||
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
|
||||
{ main_binary with sha256 ; size }
|
||||
let platform = "exotic-os"
|
||||
|
|
Loading…
Reference in a new issue
Here we should probably have used Eqaf in the first place. But let's save that for another PR.