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 ("<html><body>" ^ s ^ "</body></html>")
let get_option key =
| 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
let pp_error = sprintf "<html><body><h1>Error: %s</h1></body></html>";;
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";;
(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
(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
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 ->
"<h4>Only constraints</h4>" ^
"Enforce Only constraints for objects: " ^
"<input type='checkbox' name='only_obj'" ^
- (if only_obj = None then "" else " checked='yes'") ^ " /><br />" ^
+ (if only_obj = None then "" else " checked='yes'") ^
+ " /><br />" ^
"Enforce Rel constraints for objects: " ^
"<input type='checkbox' name='only_rel'" ^
- (if only_rel = None then "" else " checked='yes'") ^ " /><br />" ^
+ (if only_rel = None then "" else " checked='yes'") ^
+ " /><br />" ^
"Enforce Sort constraints for objects: " ^
"<input type='checkbox' name='only_sort'" ^
- (if only_sort = None then "" else " checked='yes'") ^ " /><br />"
+ (if only_sort = None then "" else " checked='yes'") ^
+ " /><br />"
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 ->
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 ->
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!"