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

WIP Session login

Browse source
This commit is contained in:
Reynir Björnsson 2021-06-10 13:32:05 +02:00
parent bde3baec46
commit f2dbbd0fbc
3 changed files with 133 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

73
lib/authorization.ml
View file

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

69
lib/builder_web.ml
View file

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

33
lib/views.ml
View file

@ -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!"] ();
]
]