diff --git a/examples/echo.ml b/examples/echo.ml index b0d152c0..6956f4d0 100644 --- a/examples/echo.ml +++ b/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 = + "
hello, this is super secret!
log out" + 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"; + ]; + ]; ]; ]; ]