X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fuwobo%2Fsrc%2Focaml%2Fuwobo.ml;h=2f5e549830e859d5978b65d7a898ad60e7249e65;hb=de8b8a901f012fb57268e71758e3e36aaee919c8;hp=bc9646b062e0dd3e1a5b16ef907b64bcd6decd1f;hpb=37ac9346846cc656742dd94bba1c7b272ab98128;p=helm.git diff --git a/helm/uwobo/src/ocaml/uwobo.ml b/helm/uwobo/src/ocaml/uwobo.ml index bc9646b06..2f5e54983 100644 --- 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)