first moogle template checkin

[helm.git] / helm / http_getter / main.ml
diff --git a/helm/http_getter/main.ml b/helm/http_getter/main.ml

index 974d029e5e28ca7aa22331d7045294f15c0e3c38..6501afdafb61799a08642c16df98667a1d4eae5c 100644 (file)
--- 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 "<html><body>Http Getter error: %s</body></html>" s
+  sprintf "<html><body>Http Getter error: <span style=\"color:red\">%s</span></body></html>" s
  let pp_internal_error s =
-  sprintf "<html><body>Http Getter Internal error: %s</body></html>" s
+  sprintf "<html><body>Http Getter Internal error: <span style=\"color:red\">%s</span></body></html>" s
  let pp_msg s = sprintf "<html><body>%s</body></html>" 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 ()