open Http_getter_common
open Http_getter_misc
open Http_getter_types
-open Http_getter_debugger
(* constants *)
-(* let configuration_file = "/projects/helm/etc/http_getter.conf.xml" *)
-let configuration_file = "http_getter.conf.xml"
+let configuration_file = BuildTimeOpts.conffile
let common_headers = [
"Cache-Control", "no-cache";
| s when String.lowercase s = "xml" -> `Xml
| s -> raise (Bad_request ("Invalid /" ^ meth ^ " format: " ^ s))
- (* parse "baseuri" format for /ls method, no default value *)
-let parse_ls_uri =
- let parse_ls_RE = Pcre.regexp "^(\\w+):(.*)$" in
- let trailing_slash_RE = Pcre.regexp "/+$" in
- let wrong_uri uri =
- raise (Bad_request ("Invalid /ls baseuri: " ^ uri))
- in
- fun (req: Http_types.request) ->
- let baseuri = req#param "baseuri" in
- try
- let subs =
- Pcre.extract ~rex:parse_ls_RE
- (Pcre.replace ~rex:trailing_slash_RE baseuri)
- in
- (match (subs.(1), subs.(2)) with
- | "cic", uri -> Cic uri
- | "theory", uri -> Theory uri
- | _ -> wrong_uri baseuri)
- with Not_found -> wrong_uri baseuri
-
(* parse "position" argument, default is 0 *)
let parse_position (req: Http_types.request) =
try
let return_html_msg = mk_return_fun pp_msg "text/html"
let return_html_raw = mk_return_fun null_pp "text/html"
let return_xml_raw = mk_return_fun null_pp "text/xml"
-let return_400 body outchan = Http_daemon.respond_error ~code:400 ~body outchan
+let return_400 body outchan =
+ Http_daemon.respond_error ~code:(`Code 400) ~body outchan
let return_all_foo_uris doctype uris outchan =
- Http_daemon.send_basic_headers ~code:200 outchan;
+ Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
Http_daemon.send_header "Content-Type" "text/xml" outchan;
Http_daemon.send_headers common_headers outchan;
Http_daemon.send_CRLF outchan;
let return_all_rdf_uris classs outchan =
return_all_foo_uris "allrdfuris" (Http_getter.getallrdfuris classs) outchan
-let return_ls xmluri fmt outchan =
- let ls_items = Http_getter.ls xmluri in
+let return_ls regexp fmt outchan =
+ let ls_items = Http_getter.ls regexp in
let buf = Buffer.create 10240 in
(match fmt with
| `Text ->
(Http_getter.list_servers ()))))
outchan
-let log_failure msg = debug_print ("Request not fulfilled: " ^ msg)
+let log_failure msg = Http_getter_logger.log ("Request not fulfilled: " ^ msg)
(** given an action (i.e. a function which expects a logger and do something
* using it as a logger), perform it sending its output incrementally to the
* given output channel. Response is sent embedded in an HTML document.
* Channel is closed afterwards. *)
let send_log_to ?prepend action outchan =
- 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;
output_string outchan "<html><body>\n"; flush outchan;
let callback (req: Http_types.request) outchan =
try
- debug_print ("Connection from " ^ req#clientAddr);
- debug_print ("Received request: " ^ req#path);
+ Http_getter_logger.log ("Connection from " ^ req#clientAddr);
+ Http_getter_logger.log ("Received request: " ^ req#path);
(match req#path with
| "/help" -> return_help outchan
| "/getxml" ->
return_all_xml_uris (parse_output_format "getalluris" req) outchan
| "/getallrdfuris" -> return_all_rdf_uris (parse_rdf_class req) outchan
| "/ls" ->
- return_ls (parse_ls_uri req) (parse_output_format "ls" req) outchan
+ return_ls (req#param "baseuri") (parse_output_format "ls" req) outchan
| "/getempty" ->
Http_daemon.respond ~body:Http_getter_const.empty_xml outchan
| invalid_request ->
- Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan);
- debug_print "Done!\n"
+ Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request))
+ outchan);
+ Http_getter_logger.log "Done!\n"
with
| Http_types.Param_not_found attr_name ->
let msg = sprintf "Parameter '%s' is missing" attr_name in
let main () =
Helm_registry.load_from configuration_file;
+ Http_getter_logger.set_log_level
+ (Helm_registry.get_opt_default Helm_registry.get_int 1 "getter.log_level");
+ Http_getter_logger.set_log_file
+ (Helm_registry.get_opt Helm_registry.get_string "getter.log_file");
Http_getter_env.reload ();
print_string (Http_getter_env.env_to_string ());
flush stdout;
projects / helm.git / blobdiff