From b8bc44da2bce663e58a85dd2e4c46fe8db700471 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Thu, 20 May 2004 14:30:27 +0000 Subject: [PATCH] - added support for HTTP (Basic) authentication - simplified usage of some internal optional parameters --- helm/DEVEL/ocaml-http/http_daemon.ml | 87 +++++++++++----------------- 1 file changed, 35 insertions(+), 52 deletions(-) diff --git a/helm/DEVEL/ocaml-http/http_daemon.ml b/helm/DEVEL/ocaml-http/http_daemon.ml index 9e0507dd2..61c2ded23 100644 --- a/helm/DEVEL/ocaml-http/http_daemon.ml +++ b/helm/DEVEL/ocaml-http/http_daemon.ml @@ -96,17 +96,16 @@ let foo_body code body = of an HTTP response; body, if given, will be appended to the body *) let send_foo_body code body = send_raw ~data:(foo_body code body) -let respond (* Warning: keep default values in sync with Http_response.response class *) - ?(body = "") ?(headers = []) - ?(version = http_version) ?(code = 200) ?status outchan +let respond + ?(body = "") ?(headers = []) ?version ?(code = 200) ?status outchan = let code = match status with | None -> code | Some s -> code_of_status s in - send_basic_headers ~version ~code outchan; + send_basic_headers ?version ~code outchan; send_headers ~headers outchan; send_header "Content-Length" (string_of_int (String.length body)) outchan; send_CRLF outchan; @@ -118,8 +117,8 @@ let respond reason phrase; if body is given it will be included in the body of the HTML page *) let send_empty_response - func_name ?(is_valid_status = fun _ -> true) ?(headers = []) ~body () = - fun ?(version = http_version) ?code ?status outchan -> + func_name ?(is_valid_status = fun _ -> true) ?(headers=[]) ?(body="") () = + fun ?version ?code ?status outchan -> let code = get_code_argument func_name ~code ~status in if not (is_valid_status code) then failwith @@ -132,23 +131,11 @@ let send_empty_response ] @ headers in let body = (foo_body code body) ^ body in - respond ~version ~code ~headers ~body outchan -(* - (* OLD VERSION, now use 'respond' function *) - send_basic_headers ~version ~code outchan; - send_header ~header:"Connection" ~value:"close" outchan; - send_header - ~header:"Content-Type" - ~value:"text/html; charset=iso-8859-1" - outchan; - send_headers ~headers outchan; - send_CRLF outchan; - send_foo_body ~code ~body outchan -*) + respond ?version ~code ~headers ~body outchan end let respond_redirect - ~location ?(body = "") ?(version = http_version) ?(code = 301) ?status outchan + ~location ?body ?version ?(code = 301) ?status outchan = let code = match status with @@ -157,43 +144,35 @@ let respond_redirect in send_empty_response "Daemon.respond_redirect" ~is_valid_status:is_redirection - ~headers:["Location", location] ~body () - ~version ~code outchan - -let respond_error - ?(body = "") ?(version = http_version) ?(code = 400) ?status outchan = - let code = - match status with - | None -> code - | Some s -> code_of_status s - in - send_empty_response - "Daemon.respond_error" ~is_valid_status:is_error ~body () - ~version ~code outchan - -let respond_not_found ~url ?(version = http_version) outchan = + ~headers:["Location", location] ?body () + ?version ~code outchan + +let respond_error ?body ?version ?(code = 400) ?status outchan = + let code = + match status with + | None -> code + | Some s -> code_of_status s + in send_empty_response - "Daemon.respond_not_found" ~body:"" () ~version ~code:404 outchan + "Daemon.respond_error" ~is_valid_status:is_error ?body () ?version ~code + outchan + +let respond_not_found ~url ?version outchan = + send_empty_response + "Daemon.respond_not_found" () ?version ~code:404 outchan -let respond_forbidden ~url ?(version = http_version) outchan = +let respond_forbidden ~url ?version outchan = send_empty_response - "Daemon.respond_permission_denied" ~body:"" () ~version ~code:403 outchan + "Daemon.respond_permission_denied" () ?version ~code:403 outchan + +let respond_unauthorized ?version ?(realm = server_string) outchan = + respond ~headers:["WWW-Authenticate", sprintf "Basic realm=\"%s\"" realm] + ~code:401 outchan -(* let send_file ?name ?file outchan = *) let send_file ~src outchan = let buflen = 1024 in let buf = String.make buflen ' ' in -(* - let (file, cleanup) = - (match (name, file) with - | Some n, None -> (* if we open the file, we close it before returning *) - let f = open_in n in - f, (fun () -> close_in f) - | None, Some f -> (f, (fun () -> ())) - | _ -> (* TODO use some static type checking *) - failwith "Daemon.send_file: either name or file must be given") - in -*) + let (file, cleanup) = match src with | FileSrc fname -> (* if we open the file, we close it before returning *) @@ -378,7 +357,9 @@ let start let (path, parameters) = safe_parse_request inchan outchan in callback path parameters outchan; flush outchan - with Again -> () + with + | Unauthorized realm -> respond_unauthorized ~realm outchan + | Again -> () in try (server_of_mode mode) ~sockaddr ~timeout daemon_callback @@ -396,7 +377,9 @@ let start' let req = safe_parse_request' inchan outchan in callback req outchan; flush outchan - with Again -> () + with + | Unauthorized realm -> respond_unauthorized ~realm outchan + | Again -> () in try (server_of_mode mode) ~sockaddr ~timeout daemon_callback -- 2.39.2