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

Revise error handling

Browse source 
- also validate UUID to be 36 characters
- also error with not_found for unknown jobs
This commit is contained in:
Reynir Björnsson 2021-06-07 15:52:37 +02:00 committed by Robur
parent e4407902f5
commit 8f4a45bf76
5 changed files with 154 additions and 194 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
bin/builder_web_app.ml
View file

@ -86,7 +86,7 @@ let setup_app level influx port host datadir =
| Error (#Caqti_error.load as e) -> | Error (#Caqti_error.load as e) ->
Format.eprintf "Error: %a\n%!" Caqti_error.pp e; Format.eprintf "Error: %a\n%!" Caqti_error.pp e;
exit 2 exit 2
| Error (#Builder_web.db_error | `Wrong_version _ as e) -> | Error (#Caqti_error.connect | #Caqti_error.call_or_retrieve | `Msg _ | `Wrong_version _ as e) ->
Format.eprintf "Error: %a\n%!" Builder_web.pp_error e; Format.eprintf "Error: %a\n%!" Builder_web.pp_error e;
exit 1 exit 1
| Ok () -> | Ok () ->

18
db/builder_db.ml
View file

@ -335,22 +335,8 @@ module Build = struct
let get_all_meta = let get_all_meta =
Caqti_request.collect Caqti_request.collect
Caqti_type.int64 Caqti_type.int64
(Caqti_type.tup2
id Meta.t)
{| SELECT id, uuid, start_d, start_ps, finish_d, finish_ps,
result_kind, result_code, result_msg, main_binary, job
FROM build
WHERE job = ?
ORDER BY start_d DESC, start_ps DESC
|}
let get_all_meta_by_name =
Caqti_request.collect
Caqti_type.string
(Caqti_type.tup3 (Caqti_type.tup3
id id Meta.t file_opt)
Meta.t
file_opt)
{| SELECT build.id, build.uuid, {| SELECT build.id, build.uuid,
build.start_d, build.start_ps, build.finish_d, build.finish_ps, build.start_d, build.start_ps, build.finish_d, build.finish_ps,
build.result_kind, build.result_code, build.result_msg, build.result_kind, build.result_code, build.result_msg,
@ -359,7 +345,7 @@ module Build = struct
FROM build, job FROM build, job
LEFT JOIN build_artifact ON LEFT JOIN build_artifact ON
build.main_binary = build_artifact.id build.main_binary = build_artifact.id
WHERE job.name = ? AND build.job = job.id WHERE job.id = ? AND build.job = job.id
ORDER BY start_d DESC, start_ps DESC ORDER BY start_d DESC, start_ps DESC
|} |}

4
db/builder_db.mli
View file

@ -140,9 +140,7 @@ sig
val get_all : val get_all :
(id, id * t, [ `Many | `One | `Zero ]) Caqti_request.t (id, id * t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_all_meta : val get_all_meta :
(id, id * Meta.t, [ `Many | `One | `Zero ]) Caqti_request.t (id, id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t
val get_all_meta_by_name :
(string, id * Meta.t * file option, [ `Many | `One | `Zero ]) Caqti_request.t
val get_latest : val get_latest :
(id, id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ]) (id, id * Meta.t * file option, [< `Many | `One | `Zero > `One `Zero ])
Caqti_request.t Caqti_request.t

233
lib/builder_web.ml
View file

@ -4,8 +4,6 @@ module Log = (val Logs.src_log src : Logs.LOG)
open Lwt.Syntax open Lwt.Syntax
open Lwt_result.Infix open Lwt_result.Infix
type db_error = [ Caqti_error.connect | Model.error ]
let pp_error ppf = function let pp_error ppf = function
| #Caqti_error.connect as e -> Caqti_error.pp ppf e | #Caqti_error.connect as e -> Caqti_error.pp ppf e
| #Model.error as e -> Model.pp_error ppf e | #Model.error as e -> Model.pp_error ppf e
@ -58,6 +56,20 @@ let mime_lookup path =
then "application/octet-stream" then "application/octet-stream"
else Magic_mime.lookup (Fpath.to_string path) else Magic_mime.lookup (Fpath.to_string path)
let or_error_response r =
let* r = r in
match r with
| Ok response -> Lwt.return response
| Error (text, status) -> Dream.respond ~status text
let if_error ~status ?(log=(fun e -> Log.warn (fun m -> m "%s: %a" (Dream.status_to_string status) pp_error e))) message r =
let* r = r in
match r with
| Error (#Model.error as e) ->
log e;
Lwt_result.fail (message, status)
| Ok _ as r -> Lwt.return r
let authorized handler = fun req -> let authorized handler = fun req ->
let unauthorized () = let unauthorized () =
let headers = ["WWW-Authenticate", Printf.sprintf "Basic realm=\"%s\"" realm] in let headers = ["WWW-Authenticate", Printf.sprintf "Basic realm=\"%s\"" realm] in
@ -97,17 +109,22 @@ let authorized handler = fun req ->
let string_of_html = let string_of_html =
Format.asprintf "%a" (Tyxml.Html.pp ()) Format.asprintf "%a" (Tyxml.Html.pp ())
let get_uuid s =
Lwt.return
(if String.length s = 36 then
match Uuidm.of_string s with
| Some uuid -> Ok uuid
| None -> Error ("Bad uuid", `Not_Found)
else Error ("Bad uuid", `Not_Found))
let add_routes datadir = let add_routes datadir =
let datadir_global = Dream.new_global ~name:"datadir" (fun () -> datadir) in let datadir_global = Dream.new_global ~name:"datadir" (fun () -> datadir) in
let builder req = let builder req =
let* jobs = Dream.sql req Model.jobs in Dream.sql req Model.jobs
match jobs with |> if_error ~status:`Internal_Server_Error "Error getting jobs"
| Error e -> ~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e))
Log.warn (fun m -> m "Error getting jobs: %a" pp_error e); >>= fun jobs ->
Dream.respond ~status:`Internal_Server_Error "Error getting jobs"
| Ok jobs ->
let* jobs =
List.fold_right List.fold_right
(fun (job_id, job_name) r -> (fun (job_id, job_name) r ->
r >>= fun acc -> r >>= fun acc ->
@ -119,63 +136,47 @@ let add_routes datadir =
Lwt_result.return acc) Lwt_result.return acc)
jobs jobs
(Lwt_result.return []) (Lwt_result.return [])
in |> if_error ~status:`Internal_Server_Error "Error getting jobs"
match jobs with ~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e))
| Error e -> >>= fun jobs ->
Log.warn (fun m -> m "Error getting jobs: %a" pp_error e); Views.builder jobs |> string_of_html |> Dream.html |> Lwt_result.ok
Dream.respond ~status:`Internal_Server_Error "Error getting jobs"
| Ok jobs ->
Views.builder jobs |> string_of_html |> Dream.html
in in
let job req = let job req =
let job_name = Dream.param "job" req in let job_name = Dream.param "job" req in
let* job = Dream.sql req (Model.job job_name) in Dream.sql req (Model.job job_name)
match job with |> if_error ~status:`Internal_Server_Error "Error getting job"
| Error e -> ~log:(fun e -> Log.warn (fun m -> m "Error getting job: %a" pp_error e))
Log.warn (fun m -> m "Error getting job: %a" pp_error e); >>= fun builds ->
Dream.respond ~status:`Internal_Server_Error "Error getting job" Views.job job_name builds |> string_of_html |> Dream.html |> Lwt_result.ok
| Ok builds ->
Views.job job_name builds |> string_of_html |> Dream.html
in in
let redirect_latest req = let redirect_latest req =
let job_name = Dream.param "job" req in let job_name = Dream.param "job" req in
let path = Dream.path req |> String.concat "/" in let path = Dream.path req |> String.concat "/" in
let* build = (Dream.sql req (Model.job_id job_name) >>= fun job_id ->
Dream.sql req (Model.job_id job_name) >>= fun job_id -> Dream.sql req (Model.latest_successful_build_uuid job_id))
Dream.sql req (Model.latest_successful_build_uuid job_id)
>>= Model.not_found >>= Model.not_found
in |> if_error ~status:`Not_Found "Error getting job" >>= fun build ->
match build with
| Error e ->
Log.warn (fun m -> m "Error getting job: %a" pp_error e);
Dream.respond ~status:`Not_Found "Error getting job"
| Ok build ->
Dream.redirect req Dream.redirect req
(Fmt.strf "/job/%s/build/%a/%s" job_name Uuidm.pp build path) (Fmt.strf "/job/%s/build/%a/%s" job_name Uuidm.pp build path)
|> Lwt_result.ok
in in
let job_build req = let job_build req =
let job_name = Dream.param "job" req let job_name = Dream.param "job" req
and build = Dream.param "build" req in and build = Dream.param "build" req in
match Uuidm.of_string build with get_uuid build >>= fun uuid ->
| None -> (Dream.sql req (Model.build uuid) >>= fun (build_id, build) ->
Dream.respond "Bad request." ~status:`Bad_Request
| Some uuid ->
let* data =
Dream.sql req (Model.build uuid) >>= fun (build_id, build) ->
Dream.sql req (Model.build_artifacts build_id) >>= fun artifacts -> Dream.sql req (Model.build_artifacts build_id) >>= fun artifacts ->
Dream.sql req (Model.latest_successful_build_uuid build.job_id) >>= fun latest_uuid -> Dream.sql req (Model.latest_successful_build_uuid build.job_id) >>= fun latest_uuid ->
Dream.sql req (Model.previous_successful_build build_id) >|= fun previous_build -> Dream.sql req (Model.previous_successful_build build_id) >|= fun previous_build ->
(build, artifacts, latest_uuid, previous_build) (build, artifacts, latest_uuid, previous_build))
in |> if_error ~status:`Internal_Server_Error "Error getting job build"
match data with ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e))
| Error e -> >>= fun (build, artifacts, latest_uuid, previous_build) ->
Log.warn (fun m -> m "Error getting job build: %a" pp_error e);
Dream.respond "Error getting job build" ~status:`Internal_Server_Error
| Ok (build, artifacts, latest_uuid, previous_build) ->
Views.job_build job_name build artifacts latest_uuid previous_build |> string_of_html |> Dream.html Views.job_build job_name build artifacts latest_uuid previous_build |> string_of_html |> Dream.html
|> Lwt_result.ok
in in
let job_build_file req = let job_build_file req =
@ -187,128 +188,102 @@ let add_routes datadir =
(* XXX: We don't check safety of [file]. This should be fine however since (* XXX: We don't check safety of [file]. This should be fine however since
* we don't use [file] for the filesystem but is instead used as a key for * we don't use [file] for the filesystem but is instead used as a key for
* lookup in the data table of the 'full' file. *) * lookup in the data table of the 'full' file. *)
match Uuidm.of_string build, Fpath.of_string filepath with get_uuid build >>= fun build ->
| None, _ -> Fpath.of_string filepath |> Rresult.R.open_error_msg |> Lwt_result.lift
Log.debug (fun m -> m "bad uuid: %s" build); |> if_error ~status:`Not_Found "File not found" >>= fun filepath ->
Dream.respond ~status:`Not_Found "File not found" Dream.sql req (Model.build_artifact build filepath)
| _, Error (`Msg e) -> |> if_error ~status:`Internal_Server_Error "Error getting build artifact" >>= fun file ->
Log.debug (fun m -> m "bad path: %s" e);
Dream.respond ~status:`Not_Found "File not found"
| Some build, Ok filepath ->
let* file = Dream.sql req (Model.build_artifact build filepath) in
match file with
| Error e ->
Log.warn (fun m -> m "Error getting build artifact: %a" pp_error e);
Dream.respond ~status:`Internal_Server_Error "Error getting build artifact"
| Ok file ->
let etag = Base64.encode_string (Cstruct.to_string file.Builder_db.sha256) in let etag = Base64.encode_string (Cstruct.to_string file.Builder_db.sha256) in
match if_none_match with match if_none_match with
| Some etag' when etag = etag' -> | Some etag' when etag = etag' ->
Dream.empty `Not_Modified Dream.empty `Not_Modified |> Lwt_result.ok
| _ -> | _ ->
let* data = Model.build_artifact_data datadir file in Model.build_artifact_data datadir file
match data with |> if_error ~status:`Internal_Server_Error "Error getting build artifact" >>= fun data ->
| Ok data ->
let headers = [ let headers = [
"Content-Type", mime_lookup file.Builder_db.filepath; "Content-Type", mime_lookup file.Builder_db.filepath;
"ETag", etag; "ETag", etag;
] in ] in
Dream.respond ~headers data Dream.respond ~headers data |> Lwt_result.ok
| Error e ->
Log.warn (fun m -> m "Error getting build artifact: %a" pp_error e);
Dream.respond ~status:`Internal_Server_Error "Error getting build artifact"
in in
let upload req = let upload req =
let* body = Dream.body req in let* body = Dream.body req in
match Builder.Asn.exec_of_cs (Cstruct.of_string body) with Builder.Asn.exec_of_cs (Cstruct.of_string body) |> Lwt.return
| Error (`Msg e) -> |> if_error ~status:`Bad_Request "Bad request"
Log.warn (fun m -> m "Received bad builder ASN.1"); ~log:(fun e ->
Log.debug (fun m -> m "Parse error: %s" e); Log.warn (fun m -> m "Received bad builder ASN.1: %a" pp_error e))
Dream.respond ~status:`Bad_Request "Bad request" >>= fun ((_, uuid, _, _, _, _, _) as exec) ->
| Ok ((_, uuid, _, _, _, _, _) as exec) -> Log.debug (fun m -> m "Received build %a" pp_exec exec);
Log.info (fun m -> m "Received build %a" pp_exec exec); Dream.sql req (Model.build_exists uuid)
let* r = Dream.sql req (Model.build_exists uuid) in |> if_error ~status:`Internal_Server_Error "Internal server error"
match r with ~log:(fun e ->
| Error e -> Log.warn (fun m -> m "Error saving build %a: %a" pp_exec exec pp_error e))
Log.warn (fun m -> m "Error saving build %a: %a" pp_exec exec pp_error e); >>= function
Dream.respond ~status:`Internal_Server_Error "Internal server error" | true ->
| Ok true ->
Log.warn (fun m -> m "Build with same uuid exists: %a" pp_exec exec); Log.warn (fun m -> m "Build with same uuid exists: %a" pp_exec exec);
Dream.respond ~status:`Conflict Dream.respond ~status:`Conflict
(Fmt.strf "Build with same uuid exists: %a\n" Uuidm.pp uuid) (Fmt.strf "Build with same uuid exists: %a\n" Uuidm.pp uuid)
| Ok false -> |> Lwt_result.ok
| false ->
let datadir = Dream.global datadir_global req in let datadir = Dream.global datadir_global req in
let* r = Dream.sql req (Model.add_build datadir exec) in Dream.sql req (Model.add_build datadir exec)
match r with |> if_error ~status:`Internal_Server_Error "Internal server error"
| Ok () -> ~log:(fun e -> Log.warn (fun m -> m "Error saving build %a: %a" pp_exec exec pp_error e))
Dream.respond "" >>= fun () -> Dream.respond "" |> Lwt_result.ok
| Error e ->
Log.warn (fun m -> m "Error saving build %a: %a" pp_exec exec pp_error e);
Dream.respond ~status:`Internal_Server_Error "Internal server error"
in in
let hash req = let hash req =
let hash_hex = Dream.query "sha256" req in Dream.query "sha256" req |> Option.to_result ~none:(`Msg "Missing sha256 query parameter") |> Lwt.return
match Option.map (fun h -> Hex.to_cstruct (`Hex h)) hash_hex with |> if_error ~status:`Bad_Request "Bad request" >>= fun hash_hex ->
begin try Hex.to_cstruct (`Hex 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 ->
Dream.sql req (Model.build_hash hash)
|> if_error ~status:`Internal_Server_Error "Internal server error" >>= function
| None -> | None ->
Log.debug (fun m -> m "sha256 query parameter not provided"); Log.debug (fun m -> m "Hash not found: %S" hash_hex);
Dream.respond ~status:`Bad_Request "Bad request" Dream.respond ~status:`Not_Found "Artifact not found" |> Lwt_result.ok
| Some hash -> | Some (job_name, build) ->
let* build = Dream.sql req (Model.build_hash hash) in
(match build with
| Error e ->
Log.warn (fun m -> m "Database error: %a" pp_error e);
Dream.respond ~status:`Internal_Server_Error "Internal server error"
| Ok None ->
Log.debug (fun m -> m "Hash not found: %S" (Option.get hash_hex));
Dream.respond ~status:`Not_Found "Artifact not found"
| Ok (Some (job_name, build)) ->
Dream.redirect req Dream.redirect req
(Fmt.strf "/job/%s/build/%a/" job_name Uuidm.pp build.Builder_db.Build.uuid)) (Fmt.strf "/job/%s/build/%a/" job_name Uuidm.pp build.Builder_db.Build.uuid)
| exception Invalid_argument _ -> |> Lwt_result.ok
Log.debug (fun m -> m "Invalid hash hex %S" (Option.get hash_hex));
Dream.respond ~status:`Bad_Request "Bad request"
in in
let compare_opam req = let compare_opam req =
let datadir = Dream.global datadir_global req in let datadir = Dream.global datadir_global req in
let build_left = Dream.param "build_left" req in let build_left = Dream.param "build_left" req in
let build_right = Dream.param "build_right" req in let build_right = Dream.param "build_right" req in
match Uuidm.of_string build_left, Uuidm.of_string build_right with get_uuid build_left >>= fun build_left ->
| None, _ | _, None -> get_uuid build_right >>= fun build_right ->
Dream.respond ~status:`Bad_Request "Bad request" (Dream.sql req (Model.build_artifact build_left (Fpath.v "opam-switch")) >>=
| Some build_left, Some build_right ->
let* r =
Dream.sql req (Model.build_artifact build_left (Fpath.v "opam-switch")) >>=
Model.build_artifact_data datadir >>= fun switch_left -> Model.build_artifact_data datadir >>= fun switch_left ->
Dream.sql req (Model.build_artifact build_right (Fpath.v "opam-switch")) >>= Dream.sql req (Model.build_artifact build_right (Fpath.v "opam-switch")) >>=
Model.build_artifact_data datadir >>= fun switch_right -> Model.build_artifact_data datadir >>= fun switch_right ->
Dream.sql req (Model.build build_left) >>= fun (_id, build_left) -> Dream.sql req (Model.build build_left) >>= fun (_id, build_left) ->
Dream.sql req (Model.build build_right) >>= fun (_id, build_right) -> Dream.sql req (Model.build build_right) >>= fun (_id, build_right) ->
Dream.sql req (Model.job_name build_left.job_id) >>= fun job_left -> Dream.sql req (Model.job_name build_left.job_id) >>= fun job_left ->
Dream.sql req (Model.job_name build_right.job_id) >>= fun job_right -> Dream.sql req (Model.job_name build_right.job_id) >|= fun job_right ->
Lwt_result.return (job_left, job_right, build_left, build_right, switch_left, switch_right) (job_left, job_right, build_left, build_right, switch_left, switch_right))
in |> if_error ~status:`Internal_Server_Error "Internal server error"
match r with >>= fun (job_left, job_right, build_left, build_right, switch_left, switch_right) ->
| Error e ->
Log.warn (fun m -> m "Database error: %a" pp_error e);
Dream.respond ~status:`Internal_Server_Error "Internal server error"
| Ok (job_left, job_right, build_left, build_right, switch_left, switch_right) ->
let switch_left = OpamFile.SwitchExport.read_from_string switch_left let switch_left = OpamFile.SwitchExport.read_from_string switch_left
and switch_right = OpamFile.SwitchExport.read_from_string switch_right in and switch_right = OpamFile.SwitchExport.read_from_string switch_right in
Opamdiff.compare switch_left switch_right Opamdiff.compare switch_left switch_right
|> Views.compare_opam job_left job_right build_left build_right |> Views.compare_opam job_left job_right build_left build_right
|> string_of_html |> Dream.html |> string_of_html |> Dream.html |> Lwt_result.ok
in in
let w f req = or_error_response (f req) in
Dream.router [ Dream.router [
Dream.get "/" builder; Dream.get "/" (w builder);
Dream.get "/job/:job/" job; Dream.get "/job/:job/" (w job);
Dream.get "/job/:job/build/latest/**" redirect_latest; Dream.get "/job/:job/build/latest/**" (w redirect_latest);
Dream.get "/job/:job/build/:build/" job_build; Dream.get "/job/:job/build/:build/" (w job_build);
Dream.get "/job/:job/build/:build/f/**" job_build_file; Dream.get "/job/:job/build/:build/f/**" (w job_build_file);
Dream.get "/hash" hash; Dream.get "/hash" (w hash);
Dream.get "/compare/:build_left/:build_right/opam-switch" compare_opam; Dream.get "/compare/:build_left/:build_right/opam-switch" (w compare_opam);
Dream.post "/upload" (authorized upload); Dream.post "/upload" (authorized (w upload));
] ]

9
lib/model.ml
View file

@ -77,13 +77,14 @@ let main_binary id main_binary (module Db : CONN) =
Db.find Builder_db.Build_artifact.get_by_build (id, main_binary) >|= fun (_id, file) -> Db.find Builder_db.Build_artifact.get_by_build (id, main_binary) >|= fun (_id, file) ->
Some file Some file
let job job (module Db : CONN) =
Db.collect_list Builder_db.Build.get_all_meta_by_name job >|=
List.map (fun (_id, meta, main_binary) -> (meta, main_binary))
let job_id job_name (module Db : CONN) = let job_id job_name (module Db : CONN) =
Db.find Builder_db.Job.get_id_by_name job_name Db.find Builder_db.Job.get_id_by_name job_name
let job job (module Db : CONN) =
job_id job (module Db) >>= fun job_id ->
Db.collect_list Builder_db.Build.get_all_meta job_id >|=
List.map (fun (_id, meta, main_binary) -> (meta, main_binary))
let jobs (module Db : CONN) = let jobs (module Db : CONN) =
Db.collect_list Builder_db.Job.get_all () Db.collect_list Builder_db.Job.get_all ()