X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fhttp_getter%2Fmain.ml;h=6501afdafb61799a08642c16df98667a1d4eae5c;hb=5325734bc2e4927ed7ec146e35a6f0f2b49f50c1;hp=974d029e5e28ca7aa22331d7045294f15c0e3c38;hpb=a3b2a5b4a985644c7bd7271b40b599e154d347ef;p=helm.git diff --git a/helm/http_getter/main.ml b/helm/http_getter/main.ml index 974d029e5..6501afdaf 100644 --- a/helm/http_getter/main.ml +++ b/helm/http_getter/main.ml @@ -31,12 +31,10 @@ open Printf 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"; @@ -115,9 +113,9 @@ 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 + sprintf "Http Getter error: %s" s let pp_internal_error s = - sprintf "Http Getter Internal error: %s" s + sprintf "Http Getter Internal error: %s" s let pp_msg s = sprintf "%s" s let null_pp s = s let return_html_error = mk_return_fun pp_error "text/html" @@ -228,7 +226,7 @@ let return_list_servers outchan = (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 @@ -254,8 +252,8 @@ let send_log_to ?prepend action 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" -> @@ -309,7 +307,7 @@ let callback (req: Http_types.request) outchan = 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_getter_logger.log "Done!\n" with | Http_types.Param_not_found attr_name -> let msg = sprintf "Parameter '%s' is missing" attr_name in @@ -339,16 +337,27 @@ let callback (req: Http_types.request) outchan = 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; - at_exit Http_getter.close_maps; - Sys.catch_break true; - try - Http_daemon.start' ~mode:`Thread - ~timeout:(Some 600) ~port:(Helm_registry.get_int "getter.port") - callback - with Sys.Break -> () (* 'close_maps' already registered with 'at_exit' *) + let batch_update = + try Sys.argv.(1) = "-update" with Invalid_argument _ -> false + in + if batch_update then (* batch mode: performs update and exit *) + Http_getter.update ~logger:Http_getter.stdout_logger () + else begin (* daemon mode: start http daemon *) + at_exit Http_getter.close_maps; + Sys.catch_break true; + try + Http_daemon.start' ~mode:`Thread + ~timeout:(Some 600) ~port:(Helm_registry.get_int "getter.port") + callback + with Sys.Break -> () (* 'close_maps' already registered with 'at_exit' *) + end let _ = main ()