From 3e23b4a5bff585946aa18310599b6ae9bf98d2c0 Mon Sep 17 00:00:00 2001 From: rand00 Date: Sun, 26 Jun 2022 18:14:15 +0200 Subject: [PATCH 1/6] Implemented general error-handler + Added special error-page for iframes/vizs --- bin/builder_web_app.ml | 3 ++- lib/builder_web.ml | 25 +++++++++++++++++++++++++ lib/views.ml | 38 ++++++++++++++++++++++++++++++++++++-- 3 files changed, 63 insertions(+), 3 deletions(-) diff --git a/bin/builder_web_app.ml b/bin/builder_web_app.ml index e44806c..55a3dba 100644 --- a/bin/builder_web_app.ml +++ b/bin/builder_web_app.ml @@ -146,13 +146,14 @@ let setup_app level influx port host datadir cachedir configdir run_batch_viz_fl | Some Error -> Some `Error | Some App -> None in + let error_handler = Dream.error_template Builder_web.error_template in Dream.initialize_log ?level (); let dream_routes = Builder_web.( routes ~datadir ~cachedir ~configdir |> to_dream_routes ) in - Dream.run ~port ~interface:host ~tls:false + Dream.run ~port ~interface:host ~tls:false ~error_handler @@ Dream.logger @@ Dream.sql_pool ("sqlite3:" ^ dbpath) @@ Http_status_metrics.handle diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 7d4e24a..7754bf8 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -662,4 +662,29 @@ module Middleware = struct end +let is_iframe_page ~req = + match Option.bind req (fun r -> Dream.header r "Sec-Fetch-Dest") with + | Some "iframe" -> true + | _ -> false + +let error_template error _debug_info suggested_response = + let target = + match error.Dream.request with + | None -> "?" + | Some req -> Dream.target req in + let referer = + error.Dream.request + |> Option.map (fun req -> Dream.header req "referer") + |> Option.value ~default:None + in + let html = + if is_iframe_page ~req:error.Dream.request then + Views.viz_not_found ~target + else + Views.page_not_found ~target ~referer + in + Dream.set_header suggested_response "Content-Type" Dream.text_html; + Dream.set_body suggested_response @@ string_of_html html; + Lwt.return suggested_response + module Link = Link diff --git a/lib/views.ml b/lib/views.ml index 75f5d05..6d9a6a4 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -216,12 +216,12 @@ let resource_not_found ~text = ] |> layout ~title:"Resource not found" -let page_not_found ~path ~referer = +let page_not_found ~target ~referer = [ H.h2 ~a:[ H.a_style "padding-top: 33vh" ] [ txtf "This page does not exist" ]; H.p [ - H.txt @@ Fmt.str "You requested the page %s" path + H.txt @@ Fmt.str "You requested the page %s" target ]; ] @ ( match referer with @@ -235,6 +235,40 @@ let page_not_found ~path ~referer = ) |> layout ~title:"Page not found" +let viz_not_found ~target = + let title = "Visualization not found" in + let content = + [ + H.h2 ~a:[ H.a_style "\ + padding-top: 41vh;\ + text-align: center;\ + "] + [ txtf "%s" title ]; + (* H.p [ + * H.txt @@ Fmt.str "You requested the page %s" target + * ]; *) + ] + in + let static_css = static_css :: [ Tyxml.Html.Unsafe.data "\ + body {\ + background: rgb(191,191,191);\ + }\ + "] + in + let body = + let style = H.a_style "\ + " + in + [ H.div ~a:[ style ] content ] + in + H.html + (H.head (H.title (H.txt title)) + [H.style ~a:H.[a_mime_type "text/css"] static_css]) + (H.body [ + H.main body + ]) + + module Builds = struct let data = From ffc062727a90f09112e80e021b84cae59b9fef8a Mon Sep 17 00:00:00 2001 From: rand00 Date: Sun, 26 Jun 2022 18:18:09 +0200 Subject: [PATCH 2/6] Views: Cleanup --- lib/views.ml | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/lib/views.ml b/lib/views.ml index 6d9a6a4..b90459a 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -244,23 +244,13 @@ let viz_not_found ~target = text-align: center;\ "] [ txtf "%s" title ]; - (* H.p [ - * H.txt @@ Fmt.str "You requested the page %s" target - * ]; *) ] in let static_css = static_css :: [ Tyxml.Html.Unsafe.data "\ - body {\ - background: rgb(191,191,191);\ - }\ - "] - in - let body = - let style = H.a_style "\ - " - in - [ H.div ~a:[ style ] content ] + body { background: rgb(191,191,191); }\ + "] in + let body = [ H.div content ] in H.html (H.head (H.title (H.txt title)) [H.style ~a:H.[a_mime_type "text/css"] static_css]) From f3d8eea54647020ec1d570cad59c7937014c90b5 Mon Sep 17 00:00:00 2001 From: rand00 Date: Sun, 26 Jun 2022 18:26:40 +0200 Subject: [PATCH 3/6] Fixed unused param + simplification --- lib/builder_web.ml | 6 ++---- lib/views.ml | 2 +- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 7754bf8..41ba400 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -673,13 +673,11 @@ let error_template error _debug_info suggested_response = | None -> "?" | Some req -> Dream.target req in let referer = - error.Dream.request - |> Option.map (fun req -> Dream.header req "referer") - |> Option.value ~default:None + Option.bind error.Dream.request (fun req -> Dream.header req "referer") in let html = if is_iframe_page ~req:error.Dream.request then - Views.viz_not_found ~target + Views.viz_not_found else Views.page_not_found ~target ~referer in diff --git a/lib/views.ml b/lib/views.ml index b90459a..5498b21 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -235,7 +235,7 @@ let page_not_found ~target ~referer = ) |> layout ~title:"Page not found" -let viz_not_found ~target = +let viz_not_found = let title = "Visualization not found" in let content = [ From 9416e0552d6e8fef07f548cd7dc30c52bb753bc2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Thu, 14 Jul 2022 11:43:41 +0200 Subject: [PATCH 4/6] error_handler: only show not found for `Not_Found For all other error status codes we just pass on the suggested response. --- lib/builder_web.ml | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 41ba400..07ed2d6 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -675,14 +675,18 @@ let error_template error _debug_info suggested_response = let referer = Option.bind error.Dream.request (fun req -> Dream.header req "referer") in - let html = - if is_iframe_page ~req:error.Dream.request then - Views.viz_not_found - else - Views.page_not_found ~target ~referer - in - Dream.set_header suggested_response "Content-Type" Dream.text_html; - Dream.set_body suggested_response @@ string_of_html html; - Lwt.return suggested_response + match Dream.status suggested_response with + | `Not_Found -> + let html = + if is_iframe_page ~req:error.Dream.request then + Views.viz_not_found + else + Views.page_not_found ~target ~referer + in + Dream.set_header suggested_response "Content-Type" Dream.text_html; + Dream.set_body suggested_response @@ string_of_html html; + Lwt.return suggested_response + | _ -> + Lwt.return suggested_response module Link = Link From 234c7a0cb2403a87f7e40bcd978eb12d98535e31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 15 Jul 2022 11:13:11 +0200 Subject: [PATCH 5/6] Refactor not found logic --- lib/builder_web.ml | 39 ++++++++++++++++++++++----------------- lib/model.ml | 2 +- lib/model.mli | 2 +- 3 files changed, 24 insertions(+), 19 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 07ed2d6..0db497e 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -85,6 +85,13 @@ let if_error Lwt_result.fail (message, status) | Ok _ as r -> Lwt.return r +let not_found_error r = + let* r = r in + match r with + | Error `Not_found -> + Lwt_result.fail ("Resource not found", `Not_Found) + | Ok _ as r -> Lwt.return r + let get_uuid s = Lwt.return (if String.length s = 36 then @@ -99,11 +106,11 @@ let main_binary_of_uuid uuid db = |> if_error "Error getting job build" ~log:(fun e -> Log.warn (fun m -> m "Error getting job build: %a" pp_error e)) >>= fun (_id, build) -> - match build.Builder_db.Build.main_binary with - | None -> Lwt_result.fail ("Resource not found", `Not_Found) - | Some main_binary -> - Model.build_artifact_by_id main_binary db - |> if_error "Error getting main binary" + Model.not_found build.Builder_db.Build.main_binary + |> not_found_error + >>= fun main_binary -> + Model.build_artifact_by_id main_binary db + |> if_error "Error getting main binary" module Viz_aux = struct @@ -203,12 +210,11 @@ module Viz_aux = struct artifacts in begin - match debug_binary with - | None -> Lwt_result.fail ("Error getting debug-binary", `Not_Found) - | Some debug_binary -> - debug_binary.sha256 - |> hex - |> Lwt_result.return + Model.not_found debug_binary + |> not_found_error >>= fun debug_binary -> + debug_binary.sha256 + |> hex + |> Lwt_result.return end | `Dependencies -> let opam_switch = @@ -216,12 +222,11 @@ module Viz_aux = struct (fun p -> Fpath.(equal (v "opam-switch") (base p.localpath))) artifacts in - match opam_switch with - | None -> Lwt_result.fail ("Error getting opam-switch", `Not_Found) - | Some opam_switch -> - opam_switch.sha256 - |> hex - |> Lwt_result.return + Model.not_found opam_switch + |> not_found_error >>= fun opam_switch -> + opam_switch.sha256 + |> hex + |> Lwt_result.return let try_load_cached_visualization ~cachedir ~uuid viz_typ db = Lwt.return (get_viz_version_from_dirs ~cachedir ~viz_typ) diff --git a/lib/model.ml b/lib/model.ml index d7f9cc7..3e796ba 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -15,7 +15,7 @@ let pp_error ppf = function Caqti_error.pp ppf e let not_found = function - | None -> Lwt.return (Error `Not_found :> (_, [> error ]) result) + | None -> Lwt_result.fail `Not_found | Some v -> Lwt_result.return v let staging datadir = Fpath.(datadir / "_staging") diff --git a/lib/model.mli b/lib/model.mli index 6982c61..c81857e 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -2,7 +2,7 @@ type error = [ Caqti_error.call_or_retrieve | `Not_found | `File_error of Fpath. val pp_error : Format.formatter -> error -> unit -val not_found : 'a option -> ('a, [> error ]) result Lwt.t +val not_found : 'a option -> ('a, [> `Not_found ]) result Lwt.t val staging : Fpath.t -> Fpath.t From e253848a157e6e2ee4ec81a5693782c8df068cfb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 15 Jul 2022 11:16:01 +0200 Subject: [PATCH 6/6] Rely on the default error page triggering for 404s It is not immediately obvious how to avoid the error handler making a different 404 response when the application code returns an explicit 404 page. Since we were already replying "Resource not found" in all cases except one where we reply "File not found" not much is lost by relying on the error handler behavior. --- lib/builder_web.ml | 3 --- lib/views.ml | 10 ---------- 2 files changed, 13 deletions(-) diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 0db497e..8f5de34 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -64,9 +64,6 @@ let or_error_response r = let* r = r in match r with | Ok response -> Lwt.return response - | Error (text, `Not_Found) -> - Views.resource_not_found ~text - |> string_of_html |> Dream.html ~status:`Not_Found | Error (text, status) -> Dream.respond ~status text let default_log_warn ~status e = diff --git a/lib/views.ml b/lib/views.ml index 5498b21..9e5ae72 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -206,16 +206,6 @@ let artifact txtf " (%a)" Fmt.byte_size size; ] -let resource_not_found ~text = - [ - H.h2 ~a:[ H.a_style "padding-top: 33vh" ] - [ txtf "This resource does not exist" ]; - H.p [ - H.txt @@ Fmt.str "Error: '%s'" text - ]; - ] - |> layout ~title:"Resource not found" - let page_not_found ~target ~referer = [ H.h2 ~a:[ H.a_style "padding-top: 33vh" ]