* http://cs.unibo.it/helm/.
*)
-(* TODO quando si prova ad applicare uno stylesheet che non e' stato caricato
-viene lasciata passare una eccezione Not_found *)
+(* TODO braindead situation: /add of a stylesheet which uri is an uwobo
+invocation *)
open Printf;;
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 *)
let syslogger = new Uwobo_logger.sysLogger ~level:debug_level () in
syslogger#enable;
let styles = new Uwobo_styles.styles in
-let usage_string = "Help message: not yet written!!" in (* TODO *)
+let usage_string =
+ sprintf
+"
+<html>
+ <head>
+ <title>UWOBO's help message</title>
+ </head>
+ <body>
+ <p>
+ Usage: <kbd>http://hostname:uwoboport/</kbd><em>command</em>
+ </p>
+ <p>
+ Available commands:
+ </p>
+ <p>
+ <b><kbd>help</kbd></b><br />
+ display this help message
+ </p>
+ <p>
+ <b><kbd>add?bind=key,uri[&bind=key,stylesheet[&...]]</kbd></b><br />
+ load a new stylesheet, specified by <em>uri</em>, and bind it to key
+ <em>key</em>
+ </p>
+ <p>
+ <b><kbd>remove?[?keys=key1,key2,...]</kbd></b><br />
+ unload stylesheets specified by <em>key1, key2, ...</em> or all
+ stylesheets if no key was given
+ </p>
+ <p>
+ <b><kbd>reload?[?keys=key1,key2,...]</kbd></b><br />
+ reload stylesheets specified by <em>key1, key2, ...</em> or all
+ stylesheets if no key was given
+ </p>
+ <p>
+ <b><kbd>list</kbd></b><br />
+ return a list of loaded stylesheets
+ </p>
+ <p>
+ <b><kbd>apply?xmluri=uri&keys=key1,key2,...[¶m.name=value[¶m.name=value[&...]]][¶m.key.name=value[¶m.key.name=value[&...]]][&name[=value][&prop.name[=value][&...]]]</kbd></b><br />
+ apply a chain of stylesheets, specified by <em>key1, key2, ...</em>, to an
+ input document, specified by <em>uri</em>.<br />
+ Additional parameters can be set for each stylesheet application: global
+ parameters (i.e. parameters passed to all stylesheets) are set using
+ <em>param.name=value</em> syntax, per stylesheet parameters are set using
+ <em>param.key.name=value</em> where <em>key</em> is the key of a loaded
+ stylesheet.<br />
+ Properties of the final chain output can be set too: valueless properties
+ can be set using <em>prop.name</em> syntax, others can be set using
+ <em>prop.name=value</em> syntax.<br />
+ Current supported properties are: %s.
+ </p>
+ </body>
+</html>
+"
+ (String.concat ", " Uwobo_common.supported_properties)
+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 *)
((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" ->
| 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
`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)
projects / helm.git / blobdiff