- added support for default properties

[helm.git] / helm / uwobo / src / ocaml / uwobo.ml

diff --git a/helm/uwobo/src/ocaml/uwobo.ml b/helm/uwobo/src/ocaml/uwobo.ml
index bc9646b062e0dd3e1a5b16ef907b64bcd6decd1f..2f5e549830e859d5978b65d7a898ad60e7249e65 100644 (file)
--- a/helm/uwobo/src/ocaml/uwobo.ml
+++ b/helm/uwobo/src/ocaml/uwobo.ml
@@ -24,10 +24,6 @@
  * http://cs.unibo.it/helm/.
  *)
 
-(* TODO libxslt support 'http_proxy' variables, but IIRC access to this
-variables is mentioned in non-reentrant stuff, so having those variables set
-cause uwobo not to work properly when invoked recursively *)
-
 (* TODO braindead situation: /add of a stylesheet which uri is an uwobo
 invocation *)
 
@@ -38,7 +34,7 @@ open Uwobo_common;;
 let debug = true;;
 let debug_level = `Debug;;
 let debug_print s = if debug then prerr_endline s;;
-let http_debug = false;;
+let http_debug = true;;
 Http_common.debug := http_debug;;
 
   (* environment settings *)
@@ -129,15 +125,17 @@ let usage_string =
 in
 
   (* thread action *)
-let callback req outchan =
+let callback (req: Http_types.request) outchan =
     (* perform an 'action' that can be applied to a list of keys or, if no
     keys was given, to all keys *)
-  let act_on_keys req styles outchan per_key_action all_keys_action logmsg =
+  let act_on_keys (req: Http_types.request)
+    styles outchan per_key_action all_keys_action logmsg
+    =
     let log = new Uwobo_logger.processingLogger () in
     let keys =
       try
         Pcre.split ~pat:"," (req#param "keys")
-      with Http_request.Param_not_found _ -> []
+      with Http_types.Param_not_found _ -> []
     in
     (match keys with
     | [] -> (* no key provided, act on all stylesheets *)
@@ -175,6 +173,7 @@ let callback req outchan =
       ((fun _ -> []), []) (* no parameters, no properties *)
   in
   try
+    syslogger#log `Notice (sprintf "Connection from %s" req#clientAddr);
     syslogger#log `Debug (sprintf "Received request: %s" req#path);
     (match req#path with
     | "/add" ->
@@ -251,7 +250,7 @@ let callback req outchan =
     | invalid_request ->
         Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan)
   with
-  | Http_request.Param_not_found attr_name ->
+  | Http_types.Param_not_found attr_name ->
       bad_request (sprintf "Parameter '%s' is missing" attr_name) outchan
   | exc ->
       Http_daemon.respond
@@ -264,6 +263,7 @@ syslogger#log
   `Notice
   (sprintf "%s started and listening on port %d" daemon_name port);
 syslogger#log `Notice (sprintf "current directory is %s" (Sys.getcwd ()));
+Unix.putenv "http_proxy" "";  (* reset http_proxy to avoid libxslt problems *)
 Http_daemon.start' ~port ~mode:`Thread callback;
 syslogger#log `Notice (sprintf "%s is terminating, bye!" daemon_name)