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

remove usage of cstruct, require mirage-crypto 1.0.0 #1

Merged
reynir merged 5 commits from no-cstruct into main 2024-09-05 15:12:38 +00:00
Conversation 3 Commits 5 Files changed 20 +123 -136
20 changed files with 123 additions and 136 deletions
Show stats Download patch file Download diff file 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 }
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
reynir commented 2024-09-04 06:09:43 +00:00
Review
Copy link

Here we should probably have used Eqaf in the first place. But let's save that for another PR.

Here we should probably have used Eqaf in the first place. But let's save that for another PR.
👍 1
(pbkdf2_sha256 ~params ~salt ~password)
password_hash
| `Scrypt (password_hash, salt, params) ->
Cstruct.equal
String.equal
(scrypt ~params ~salt ~password)
password_hash

2
auth/dune
View file

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

51
bin/builder_db_app.ml
View file

@ -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

2
bin/builder_web_app.ml
View file

@ -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 =

10
bin/migrations/m20210706.ml
View file

@ -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 2024-09-04 06:16:40 +00:00
Review
Copy link

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) ()

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 @@
"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
bin/migrations/m20210712c.ml
View file

@ -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"

16
builder-web.opam
View file

@ -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"}
"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}

24
db/builder_db.ml
View file

@ -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
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,

23
db/builder_db.mli
View file

@ -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
View file

@ -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))

25
db/representation.ml
View file

@ -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

30
lib/builder_web.ml
View file

@ -134,14 +134,14 @@ module Viz_aux = struct
viz_dir ~cachedir ~viz_typ ~version
/ input_hash + "html"
)
let choose_versioned_viz_path
~cachedir
~viz_typ
~viz_input_hash
~current_version =
let ( >>= ) = Result.bind in
let rec aux current_version =
let rec aux current_version =
let path =
viz_path ~cachedir
~viz_typ
@ -153,7 +153,7 @@ module Viz_aux = struct
Error (`Msg (Fmt.str "viz '%s': There exist no version of the requested \
visualization"
(viz_type_to_string viz_typ)))
else
else
aux @@ pred current_version
)
in
@ -162,7 +162,7 @@ module Viz_aux = struct
let get_viz_version_from_dirs ~cachedir ~viz_typ =
let ( >>= ) = Result.bind in
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
versioned_dirs
|> List.filter_map (fun versioned_dir ->
@ -171,7 +171,7 @@ module Viz_aux = struct
Logs.warn (fun m -> m "%s" err);
None
| Ok false -> None
| Ok true ->
| Ok true ->
let dir_str = Fpath.filename versioned_dir in
if not (String.starts_with ~prefix:viz_typ_str dir_str) then
None
@ -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) ->
@ -210,7 +206,7 @@ module Viz_aux = struct
|> if_error "Error getting build artifacts" >>= fun artifacts ->
match typ with
| `Treemap ->
let debug_binary =
let debug_binary =
let bin = Fpath.base main_binary.filepath in
List.find_opt
(fun p -> Fpath.(equal (bin + "debug") (base p.filepath)))
@ -220,10 +216,10 @@ 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 ->
end
| `Dependencies ->
let opam_switch =
List.find_opt
(fun p -> Fpath.(equal (v "opam-switch") (base p.filepath)))
@ -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
View file

@ -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
View file

@ -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 =

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 ->
((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 ->

4
lib/views.ml
View file

@ -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

2
test/dune
View file

@ -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)

7
test/router.ml
View file

@ -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;

14
test/test_builder_db.ml
View file

@ -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"