From d8566ee98ccb6c4422720a793609c74b26079bc4 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Sun, 1 Dec 2002 20:06:11 +0000 Subject: [PATCH] - bugfix (or hack, as you wish :-) for recursive invocations problem: fork a new process to handle "/apply" requests --- helm/uwobo/src/ocaml/uwobo.ml | 72 +++++++++++++++++++---------------- 1 file changed, 40 insertions(+), 32 deletions(-) diff --git a/helm/uwobo/src/ocaml/uwobo.ml b/helm/uwobo/src/ocaml/uwobo.ml index fef1c0d91..af7f47cc4 100644 --- a/helm/uwobo/src/ocaml/uwobo.ml +++ b/helm/uwobo/src/ocaml/uwobo.ml @@ -24,6 +24,9 @@ * 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 *) + open Printf;; open Uwobo_common;; @@ -38,7 +41,7 @@ Http_common.debug := http_debug;; let daemon_name = "UWOBO OCaml";; let default_port = 8082;; let port_env_var = "UWOBO_PORT";; -let default_media_type = "text/xml";; +let default_media_type = "text/html";; let default_encoding = "utf8";; let port = try @@ -149,37 +152,42 @@ let callback req outchan = req styles outchan styles#reload (fun () -> styles#reloadAll) "reloading" | "/apply" -> - (let logger = new Uwobo_logger.processingLogger () in - let xmluri = req#param "xmluri" in - let keys = Pcre.split ~pat:"," (req#param "keys") in - (* notation: "local" parameters are those defined on a per-stylesheet - pasis (i.e. param.key.param=value), "global" parameters are those - defined for all stylesheets (i.e. param.param=value) *) - let (params, props) = parse_apply_params req#params in - syslogger#log `Debug (sprintf "Parsing input document %s ..." xmluri); - let domImpl = Gdome.domImplementation () in - let input = domImpl#createDocumentFromURI ~uri:xmluri () in - syslogger#log `Debug "Applying stylesheet chain ..."; - try - let (write_result, media_type, encoding) = (* out_channel -> unit *) - Uwobo_engine.apply - ~logger:syslogger ~styles ~keys ~input ~params ~props - in - let content_type = (* value of Content-Type HTTP response header *) - sprintf - "%s; charset=%s" - (match media_type with None -> default_media_type | Some t -> t) - (match encoding with None -> default_encoding | Some e -> e) - in - syslogger#log `Debug "sending output to client ...."; - Http_daemon.send_basic_headers ~code:200 outchan; - Http_daemon.send_header "Content-Type" content_type outchan; - Http_daemon.send_CRLF outchan; - write_result outchan - with Uwobo_failure errmsg -> - return_error - (sprintf "Stylesheet chain application failed: %s" errmsg) - outchan) + if Unix.fork () = 0 then + (let logger = new Uwobo_logger.processingLogger () in + let xmluri = req#param "xmluri" in + let keys = Pcre.split ~pat:"," (req#param "keys") in + (* notation: "local" parameters are those defined on a per-stylesheet + pasis (i.e. param.key.param=value), "global" parameters are those + defined for all stylesheets (i.e. param.param=value) *) + let (params, props) = parse_apply_params req#params in + syslogger#log `Debug (sprintf "Parsing input document %s ..." xmluri); + let domImpl = Gdome.domImplementation () in + let input = domImpl#createDocumentFromURI ~uri:xmluri () in + syslogger#log `Debug "Applying stylesheet chain ..."; + try + let (write_result, media_type, encoding) = (* out_channel -> unit *) + Uwobo_engine.apply + ~logger:syslogger ~styles ~keys ~input ~params ~props + in + let content_type = (* value of Content-Type HTTP response header *) + sprintf + "%s; charset=%s" + (match media_type with None -> default_media_type | Some t -> t) + (match encoding with None -> default_encoding | Some e -> e) + in + syslogger#log + `Debug + (sprintf + "sending output to client (Content-Type: %s)...." + content_type); + Http_daemon.send_basic_headers ~code:200 outchan; + Http_daemon.send_header "Content-Type" content_type outchan; + Http_daemon.send_CRLF outchan; + write_result outchan + with Uwobo_failure errmsg -> + return_error + (sprintf "Stylesheet chain application failed: %s" errmsg) + outchan) | "/help" -> Http_daemon.respond ~body:usage_string outchan | invalid_request -> Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan) -- 2.39.2