simon/tiny_httpd
1
0
Fork 0
mirror of https://github.com/c-cube/tiny_httpd.git synced 2025-12-06 03:05:29 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

example: add super stupid http auth endpoints to echo.ml

Browse source 
the endpoint /protected requires user:foobar login to see the content.
This commit is contained in:
Simon Cruanes 2022-01-02 16:44:14 -05:00
parent dc0a1f08ac
commit cfa5d660a0
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
1 changed files with 32 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
examples/echo.ml
View file

@ -33,6 +33,13 @@ let middleware_stat () : S.Middleware.t * (unit -> string) =
in in
m, get_stat m, get_stat
(* ugly AF *)
let base64 x =
let ic, oc = Unix.open_process "base64" in
output_string oc x; flush oc; close_out oc;
let r = input_line ic in
ignore (Unix.close_process (ic,oc));
r
let () = let () =
let port_ = ref 8080 in let port_ = ref 8080 in
@ -115,6 +122,29 @@ let () =
S.Response.fail ~code:500 "couldn't upload file: %s" (Printexc.to_string e) S.Response.fail ~code:500 "couldn't upload file: %s" (Printexc.to_string e)
); );
(* protected by login *)
S.add_route_handler server S.Route.(exact "protected" @/ return)
(fun req ->
let ok =
match S.Request.get_header req "authorization" with
| Some v ->
S._debug(fun k->k"authenticate with %S" v);
v = "Basic " ^ base64 "user:foobar"
| None -> false
in
if ok then (
(* FIXME: a logout link *)
let s = "<p>hello, this is super secret!</p><a href=\"/logout\">log out</a>" in
S.Response.make_string (Ok s)
) else (
let headers = S.Headers.(empty |> set "www-authenticate" "basic realm=\"echo\"") in
S.Response.fail ~code:401 ~headers "invalid"
));
(* logout *)
S.add_route_handler server S.Route.(exact "logout" @/ return)
(fun _req -> S.Response.fail ~code:401 "logged out");
(* stats *) (* stats *)
S.add_route_handler server S.Route.(exact "stats" @/ return) S.add_route_handler server S.Route.(exact "stats" @/ return)
(fun _req -> (fun _req ->
@ -149,6 +179,8 @@ let () =
li[][pre[][a[A.href "/stats/"][txt"/stats/"]; txt" (GET) to access statistics"]]; li[][pre[][a[A.href "/stats/"][txt"/stats/"]; txt" (GET) to access statistics"]];
li[][pre[][a[A.href "/vfs/"][txt"/vfs"]; txt" (GET) to access a VFS embedded in the binary"]]; li[][pre[][a[A.href "/vfs/"][txt"/vfs"]; txt" (GET) to access a VFS embedded in the binary"]];
li[][pre[][a[A.href "/quit"][txt "/quit"]; txt" (POST) to quit"]]; li[][pre[][a[A.href "/quit"][txt "/quit"]; txt" (POST) to quit"]];
li[][pre[][a[A.href "/protected"][txt "/protected"]; txt" (GET) to see a protected page (user:foobar)"]];
li[][pre[][a[A.href "/logout"][txt "/logout"]; txt" (POST) to log out"]];
] ]
] ]
] in ] in