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 56bb2db880
commit 04f17262b6
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
1 changed files with 57 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

57
examples/echo.ml
View file

@ -33,6 +33,16 @@ let middleware_stat () : S.Middleware.t * (unit -> string) =
in
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 port_ = ref 8080 in
let j = ref 32 in
@ -106,6 +116,35 @@ let () =
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 *)
S.add_route_handler server
S.Route.(exact "stats" @/ return)
@ -171,6 +210,24 @@ let () =
txt " (GET) to access a VFS embedded in the binary";
];
];
li []
[
pre []
[
a [ A.href "/protected" ] [ txt "/protected" ];
txt
" (GET) to see a protected page (login: user, \
password: foobar)";
];
];
li []
[
pre []
[
a [ A.href "/logout" ] [ txt "/logout" ];
txt " (POST) to log out";
];
];
];
];
]