From d8566ee98ccb6c4422720a793609c74b26079bc4 Mon Sep 17 00:00:00 2001
From: Stefano Zacchiroli <zack@upsilon.cc>
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