From 72e5ddf0f07b0e692f5e3544438f77f2e346b12a Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Mon, 17 Jan 2005 16:23:26 +0000 Subject: [PATCH] No longer return HTTP 400 answers or non-xml answers: all document returned by the getter are now XHTML documents, possibly with the addition of an attribute helm:exception on the root element in the http://www.cs.unibo.it/helm namespace. The presence of such an attribute means that an exception has occured, its value is meant to be a string encoding of the relevant ocaml exception --- helm/http_getter/main.ml | 58 +++++++++++++++++++++++++++------------- 1 file changed, 39 insertions(+), 19 deletions(-) diff --git a/helm/http_getter/main.ml b/helm/http_getter/main.ml index 47784d137..f65e991b7 100644 --- a/helm/http_getter/main.ml +++ b/helm/http_getter/main.ml @@ -29,6 +29,7 @@ open Printf open Http_getter_common +open Http_getter_const open Http_getter_misc open Http_getter_types @@ -89,22 +90,38 @@ let parse_rdf_class (req: Http_types.request) = | "backward" -> `Backward | c -> raise (Bad_request ("Invalid RDF class: " ^ c)) +let html_tag ?exn () = + let xml_decl = "\n" in + match exn with + | Some exn -> + sprintf + "%s\n" + xml_decl xhtml_ns helm_ns exn + | None -> + sprintf "%s\n" + xml_decl xhtml_ns helm_ns + let mk_return_fun pp_fun contype msg outchan = Http_daemon.respond ~body:(pp_fun msg) ~headers:["Content-Type", contype] outchan -let pp_error s = - sprintf "Http Getter error: %s" s -let pp_internal_error s = - sprintf "Http Getter Internal error: %s" s -let pp_msg s = sprintf "%s" s +let pp_msg s = sprintf "%s%s" (html_tag ()) s let null_pp s = s -let return_html_error = mk_return_fun pp_error "text/html" -let return_html_internal_error = mk_return_fun pp_internal_error "text/html" -let return_html_msg = mk_return_fun pp_msg "text/html" -let return_html_raw = mk_return_fun null_pp "text/html" +let return_html_error exn = + let pp_error s = + sprintf "%s\nHttp Getter error: %s" + (html_tag ~exn ()) s + in + mk_return_fun pp_error "text/xml" +let return_html_internal_error exn = + let pp_internal_error s = + sprintf "%s\nHttp Getter Internal error: %s" + (html_tag ~exn ()) s + in + mk_return_fun pp_internal_error "text/xml" +let return_html_msg = mk_return_fun pp_msg "text/xml" +let return_html_raw = mk_return_fun null_pp "text/xml" let return_xml_raw = mk_return_fun null_pp "text/xml" -let return_400 body outchan = - Http_daemon.respond_error ~code:(`Code 400) ~body outchan +let return_400 exn body = return_html_error exn body let return_all_foo_uris doctype uris outchan = Http_daemon.send_basic_headers ~code:(`Code 200) outchan; @@ -200,7 +217,8 @@ let return_resolve uri outchan = let return_list_servers outchan = return_html_raw - (sprintf "\n%s\n

" + (sprintf "%s\n%s\n

" + (html_tag ()) (String.concat "\n" (List.map (fun (pos, server) -> @@ -216,9 +234,10 @@ let log_failure msg = Http_getter_logger.log ("Request not fulfilled: " ^ msg) * Channel is closed afterwards. *) let send_log_to ?prepend action outchan = Http_daemon.send_basic_headers ~code:(`Code 200) outchan; - Http_daemon.send_header "Content-Type" "text/html" outchan; + Http_daemon.send_header "Content-Type" "text/xml" outchan; Http_daemon.send_CRLF outchan; - output_string outchan "\n"; flush outchan; + output_string outchan (sprintf "%s\n" (html_tag ())); + flush outchan; (match prepend with | None -> () | Some text -> output_string outchan text; flush outchan); @@ -298,13 +317,13 @@ let callback (req: Http_types.request) outchan = | Http_types.Param_not_found attr_name -> let msg = sprintf "Parameter '%s' is missing" attr_name in log_failure msg; - return_400 msg outchan + return_400 "Bad_request" msg outchan | Bad_request msg -> log_failure msg; - return_html_error msg outchan + return_html_error "Bad_request" msg outchan | Internal_error msg -> log_failure msg; - return_html_internal_error msg outchan + return_html_internal_error "Internal_error" msg outchan | Shell.Subprocess_error l -> let msgs = List.map @@ -313,11 +332,12 @@ let callback (req: Http_types.request) outchan = l in log_failure (String.concat ", " msgs); - return_html_internal_error (String.concat "
\n" msgs) outchan + return_html_internal_error "Subprocess_error" + (String.concat "
\n" msgs) outchan | exc -> let msg = "Uncaught exception: " ^ (Printexc.to_string exc) in log_failure msg; - return_html_error msg outchan + return_html_error "Uncaught_exception" msg outchan (* Main *) -- 2.39.2