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

the endpoint /protected requires user:foobar login to see the content.

examples/echo.ml

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