From f2dbbd0fbc278bfa7f76076416d233c23dd1e407 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Thu, 10 Jun 2021 13:32:05 +0200 Subject: [PATCH] WIP Session login --- lib/authorization.ml | 73 ++++++++++++++++++++++++++------------------ lib/builder_web.ml | 69 ++++++++++++++++++++++++++++++++++------- lib/views.ml | 33 ++++++++++++++++++-- 3 files changed, 133 insertions(+), 42 deletions(-) diff --git a/lib/authorization.ml b/lib/authorization.ml index 3a24ad3..31edb15 100644 --- a/lib/authorization.ml +++ b/lib/authorization.ml @@ -13,36 +13,51 @@ let authenticate handler = fun req -> let headers = ["WWW-Authenticate", Printf.sprintf "Basic realm=\"%s\"" realm] in Dream.respond ~headers ~status:`Unauthorized "Forbidden!" in - match Dream.header "Authorization" req with - | None -> unauthorized () - | Some data -> match String.split_on_char ' ' data with - | [ "Basic" ; user_pass ] -> - (match Base64.decode user_pass with - | Error `Msg msg -> - Log.info (fun m -> m "Invalid user / pasword encoding in %S: %S" data msg); - Dream.respond ~status:`Bad_Request "Couldn't decode authorization" - | Ok user_pass -> match String.split_on_char ':' user_pass with - | [] | [_] -> - Log.info (fun m -> m "Invalid user / pasword encoding in %S" data); + match Dream.session "username" req with + | Some username -> + let* user_info = Dream.sql req (Model.user username) in + begin match user_info with + | Ok (Some (user_id, user_info)) -> + handler (Dream.with_local user_info_local (user_id, user_info) req) + | Ok None -> + Log.warn (fun m -> m "User %S from session doesn't exist" username); + let* () = Dream.invalidate_session req in + Dream.respond ~status:`Internal_Server_Error "Internal server error" + | Error e -> + Log.warn (fun m -> m "Error getting user: %a" Model.pp_error e); + Dream.respond ~status:`Internal_Server_Error "Internal server error" + end + | None -> + match Dream.header "Authorization" req with + | None -> unauthorized () + | Some data -> match String.split_on_char ' ' data with + | [ "Basic" ; user_pass ] -> + (match Base64.decode user_pass with + | Error `Msg msg -> + Log.info (fun m -> m "Invalid user / pasword encoding in %S: %S" data msg); Dream.respond ~status:`Bad_Request "Couldn't decode authorization" - | user :: password -> - let pass = String.concat ":" password in - let* user_info = Dream.sql req (Model.user user) in - match user_info with - | Ok (Some (id, user_info)) -> - if Builder_web_auth.verify_password pass user_info - then handler (Dream.with_local user_info_local (id, user_info) req) - else unauthorized () - | Ok None -> - let _ : _ Builder_web_auth.user_info = - Builder_web_auth.hash ~username:user ~password:pass ~restricted:true () in - unauthorized () - | Error e -> - Log.warn (fun m -> m "Error getting user: %a" Model.pp_error e); - Dream.respond ~status:`Internal_Server_Error "Internal server error") - | _ -> - Log.warn (fun m -> m "Error retrieving authorization %S" data); - Dream.respond ~status:`Bad_Request "Couldn't decode authorization" + | Ok user_pass -> match String.split_on_char ':' user_pass with + | [] | [_] -> + Log.info (fun m -> m "Invalid user / pasword encoding in %S" data); + Dream.respond ~status:`Bad_Request "Couldn't decode authorization" + | user :: password -> + let pass = String.concat ":" password in + let* user_info = Dream.sql req (Model.user user) in + match user_info with + | Ok (Some (id, user_info)) -> + if Builder_web_auth.verify_password pass user_info + then handler (Dream.with_local user_info_local (id, user_info) req) + else unauthorized () + | Ok None -> + let _ : _ Builder_web_auth.user_info = + Builder_web_auth.hash ~username:user ~password:pass ~restricted:true () in + unauthorized () + | Error e -> + Log.warn (fun m -> m "Error getting user: %a" Model.pp_error e); + Dream.respond ~status:`Internal_Server_Error "Internal server error") + | _ -> + Log.warn (fun m -> m "Error retrieving authorization %S" data); + Dream.respond ~status:`Bad_Request "Couldn't decode authorization" let authorized req job_name = match Dream.local user_info_local req with diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 64e31b5..0956713 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -103,7 +103,9 @@ let add_routes datadir = |> if_error "Error getting jobs" ~log:(fun e -> Log.warn (fun m -> m "Error getting jobs: %a" pp_error e)) >>= fun jobs -> - Views.builder jobs |> string_of_html |> Dream.html |> Lwt_result.ok + let username = Dream.session "username" req in + Views.builder username (Dream.csrf_token req) jobs + |> string_of_html |> Dream.html |> Lwt_result.ok in let job req = @@ -273,16 +275,61 @@ let add_routes datadir = >>= fun () -> Dream.respond "" |> Lwt_result.ok in + let login req = + let username = Dream.session "username" req in + Views.login username (Dream.csrf_token req) |> string_of_html |> Dream.html + in + + let do_login req = + let* form = Dream.form req in + (match form with + | `Ok [ "password", password; "user", username ] -> + Lwt.return (Ok (username, password)) + | _ -> + Lwt.return (Error ("Bad request", `Bad_Request))) >>= fun (username, password) -> + Dream.sql req (Model.user username) + |> if_error "Internal server error" >>= fun user_info -> + match user_info with + | Some (_user_id, user_info) -> + if Builder_web_auth.verify_password password user_info + then + let* () = Dream.invalidate_session req in + let* () = Dream.put_session "username" user_info.Builder_web_auth.username req in + Dream.redirect req "/" |> Lwt_result.ok + else + Dream.redirect req "/login" |> Lwt_result.ok + | None -> + let _ = Builder_web_auth.hash ~username ~password ~restricted:true () in + Dream.redirect req "/login" |> Lwt_result.ok + in + + let do_logout req = + let* form = Dream.form req in + match form with + | `Ok [] -> + let* () = Dream.invalidate_session req in + Dream.redirect req "/" + | _ -> + Log.warn (fun m -> m "Bad logout"); + Dream.redirect req "/" + in + let w f req = or_error_response (f req) in - Dream.router [ - Dream.get "/" (w builder); - Dream.get "/job/:job/" (w job); - Dream.get "/job/:job/build/latest/**" (w redirect_latest); - Dream.get "/job/:job/build/:build/" (w job_build); - Dream.get "/job/:job/build/:build/f/**" (w job_build_file); - Dream.get "/hash" (w hash); - Dream.get "/compare/:build_left/:build_right/opam-switch" (w compare_opam); - Dream.post "/upload" (Authorization.authenticate (w upload)); - Dream.post "/job/:job/upload" (Authorization.authenticate (w upload_binary)); + Dream.pipeline [ + Dream.sql_sessions; + Dream.router [ + Dream.get "/" (w builder); + Dream.get "/job/:job/" (w job); + Dream.get "/job/:job/build/latest/**" (w redirect_latest); + Dream.get "/job/:job/build/:build/" (w job_build); + Dream.get "/job/:job/build/:build/f/**" (w job_build_file); + Dream.get "/hash" (w hash); + Dream.get "/compare/:build_left/:build_right/opam-switch" (w compare_opam); + Dream.post "/upload" (Authorization.authenticate (w upload)); + Dream.post "/job/:job/upload" (Authorization.authenticate (w upload_binary)); + Dream.get "/login" login; + Dream.post "/login" (w do_login); + Dream.post "/logout" do_logout; + ]; ] diff --git a/lib/views.ml b/lib/views.ml index d2faa8b..8929f4f 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -5,6 +5,11 @@ let pp_ptime = Ptime.pp_human () let txtf fmt = Fmt.kstrf txt fmt let a_titlef fmt = Fmt.kstrf a_title fmt +let form ~csrf_token ?a children = + form ?a + (input ~a:[a_name "dream.csrf"; a_input_type `Hidden; a_value csrf_token] () :: + children) + let check_icon result = match result with | Builder.Exited 0 -> @@ -95,10 +100,21 @@ let artifact ?(basename=false) job_name build { Builder_db.filepath; localpath = -let builder jobs = +let builder username csrf_token jobs = layout ~title:"Builder Web" [ h1 [txt "Builder web"]; - form ~a:[a_action "/hash"; a_method `Get] + begin match username with + | Some username -> + form ~csrf_token ~a:[a_method `Post; a_action "/logout"] + [ + p [ + txtf "Logged in as %s." username; + ]; + input ~a:[a_input_type `Submit; a_value "Log out!"] (); + ]; + | None -> txt "" + end; + form ~csrf_token ~a:[a_action "/hash"; a_method `Get] [ label [ txt "Search artifact by SHA256"; @@ -305,3 +321,16 @@ let compare_opam job_left job_right [txt "Unchanged packages"]; code (packages same); ] + +let login _username csrf_token = + layout ~title:"Login" [ + h1 [txt "Please login"]; + form ~csrf_token ~a:[a_method `Post; a_action "/login"] + [ + label ~a:[a_label_for "user"] [txt "User name"]; + input ~a:[a_name "user"] (); + label ~a:[a_label_for "password"] [txt "Password"]; + input ~a:[a_input_type `Password; a_name "password"] (); + input ~a:[a_input_type `Submit; a_value "Log in!"] (); + ] + ]