From cfa5d660a0b860a39b0f53ee8ee8d0cee8617476 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sun, 2 Jan 2022 16:44:14 -0500
Subject: [PATCH] example: add super stupid http auth endpoints to echo.ml

the endpoint /protected requires user:foobar login to see the content.
---
 examples/echo.ml | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/examples/echo.ml b/examples/echo.ml
index e025d540..c36f1566 100644
--- a/examples/echo.ml
+++ b/examples/echo.ml
@@ -33,6 +33,13 @@ 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
@@ -115,6 +122,29 @@ 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)
     (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 "/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 "/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