From: Stefano Zacchiroli Date: Thu, 20 May 2004 16:20:21 +0000 (+0000) Subject: ported to latest ocaml-http API X-Git-Tag: V_0_0_9~19 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=41bb791af5cba55838dae8307339aea5098c4e2d;p=helm.git ported to latest ocaml-http API --- diff --git a/helm/DEVEL/rdfly/rdfly.ml b/helm/DEVEL/rdfly/rdfly.ml index d0bddd8ec..b9a79d139 100644 --- a/helm/DEVEL/rdfly/rdfly.ml +++ b/helm/DEVEL/rdfly/rdfly.ml @@ -131,7 +131,8 @@ let mk_return_fun contype msg outchan = let return_html = mk_return_fun "text/html" let return_xml = mk_return_fun "text/xml" -let return_400 body ch = Http_daemon.respond_error ~code:400 ~body ch +let return_400 body ch = + Http_daemon.respond_error ~code:(`Code 400) ~body ch let return_html_error s = return_html ("" ^ s ^ "") let get_option key = @@ -170,7 +171,9 @@ let callback (req: Http_types.request) ch = | s -> return_html_error ("unsupported kind: " ^ s) ch end ; M.disconnect db - | invalid_request -> Http_daemon.respond_error ~status:(`Client_error `Bad_request) ch) + | invalid_request -> + Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request)) + ch) with | Http_types.Param_not_found attr_name -> return_400 (Printf.sprintf "Parameter '%s' is missing" attr_name) ch diff --git a/helm/searchEngine/searchEngine.ml b/helm/searchEngine/searchEngine.ml index fc0fb9cbe..87bcad36a 100644 --- a/helm/searchEngine/searchEngine.ml +++ b/helm/searchEngine/searchEngine.ml @@ -166,7 +166,8 @@ let port = Helm_registry.get_int "search_engine.port";; let pp_error = sprintf "

Error: %s

";; let bad_request body outchan = - Http_daemon.respond_error ~status:(`Client_error `Bad_request) ~body outchan + Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request)) ~body + outchan ;; let contype = "Content-Type", "text/html";; @@ -305,7 +306,7 @@ let callback mqi_handle (req: Http_types.request) outchan = (match page with | page when is_permitted page -> (let fname = sprintf "%s/%s" pages_dir (remove_fragment page) in - Http_daemon.send_basic_headers ~code:200 outchan; + Http_daemon.send_basic_headers ~code:(`Code 200) outchan; Http_daemon.send_header "Content-Type" "text/html" outchan; Http_daemon.send_CRLF outchan; if preprocess then begin @@ -397,13 +398,14 @@ let callback mqi_handle (req: Http_types.request) outchan = (match selection_mode with | `SINGLE -> assert false | `MULTIPLE -> - Http_daemon.send_basic_headers ~code:200 outchan ; + Http_daemon.send_basic_headers ~code:(`Code 200) outchan; Http_daemon.send_CRLF outchan ; iter_file (fun line -> let formatted_choices = String.concat "," - (List.map (fun uri -> sprintf "\'%s\'" uri) choices) + (List.map (fun uri -> sprintf "\'%s\'" uri) + choices) in let processed_line = apply_substs @@ -445,7 +447,7 @@ let callback mqi_handle (req: Http_types.request) outchan = in String.concat ", " (aux 0 interpretations) in - Http_daemon.send_basic_headers ~code:200 outchan ; + Http_daemon.send_basic_headers ~code:(`Code 200) outchan ; Http_daemon.send_CRLF outchan ; iter_file (fun line -> @@ -526,15 +528,18 @@ let callback mqi_handle (req: Http_types.request) outchan = "

Only constraints

" ^ "Enforce Only constraints for objects: " ^ "
" ^ + (if only_obj = None then "" else " checked='yes'") ^ + " />
" ^ "Enforce Rel constraints for objects: " ^ "
" ^ + (if only_rel = None then "" else " checked='yes'") ^ + " />
" ^ "Enforce Sort constraints for objects: " ^ "
" + (if only_sort = None then "" else " checked='yes'") ^ + " />
" in - Http_daemon.send_basic_headers ~code:200 outchan ; + Http_daemon.send_basic_headers ~code:(`Code 200) outchan ; Http_daemon.send_CRLF outchan ; iter_file (fun line -> @@ -551,7 +556,7 @@ let callback mqi_handle (req: Http_types.request) outchan = G.query_of_constraints universe must'' only' in let results = MQueryInterpreter.execute mqi_handle query in - Http_daemon.send_basic_headers ~code:200 outchan ; + Http_daemon.send_basic_headers ~code:(`Code 200) outchan ; Http_daemon.send_CRLF outchan ; iter_file (fun line -> @@ -567,7 +572,8 @@ let callback mqi_handle (req: Http_types.request) outchan = output_string outchan (processed_line ^ "\n")) final_results_TPL | invalid_request -> - Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan); + Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request)) + outchan); debug_print (sprintf "%s done!" req#path) with | Chat_unfinished -> prerr_endline "Chat unfinished, Try again!"