let daemon_name = "UWOBO OCaml";;
let default_port = 8082;;
let port_env_var = "UWOBO_PORT";;
+let default_media_type = "text/xml";;
+let default_encoding = "utf8";;
let port =
try
int_of_string (Sys.getenv port_env_var)
(* facilities *)
let pp_error = sprintf "<html><body><h1>Error: %s</h1></body></html>" in
-let invocation_error msg outchan =
- (* return an ok (200) http response, which display in html an invocation error
- message *)
+let return_error msg outchan =
+ (* return an ok (200) http response, which display in html an error message *)
Http_daemon.respond ~body:(pp_error msg) outchan
in
let bad_request body outchan = (* return a bad request http response *)
| "/add" ->
(let bindings = req#paramAll "bind" in
if bindings = [] then
- invocation_error "No [key,stylesheet] binding provided" outchan
+ return_error "No [key,stylesheet] binding provided" outchan
else begin
let log = new Uwobo_logger.processingLogger () in
List.iter
act_on_keys
req styles outchan
styles#reload (fun () -> styles#reloadAll) "reloading"
-
| "/apply" ->
(let logger = new Uwobo_logger.processingLogger () in
let xmluri = req#param "xmluri" in
let domImpl = Gdome.domImplementation () in
let input = domImpl#createDocumentFromURI ~uri:xmluri () in
syslogger#log `Debug "Applying stylesheet chain ...";
- let output =
- Uwobo_engine.apply
- ~logger:syslogger ~styles ~keys ~input ~params ~props
- (* TODO uhm ... what to do if Uwobo_failure is raised? *)
- in
-(* syslogger#log `Debug logger#asText; *)
- let tempfile = (* temporary file on which save XML output *)
- (* TODO I don't need a tempfile, but gdome seems not to permit to
- return the string representation of a Gdome.document *)
- let inchan = Unix.open_process_in "tempfile --prefix=uwobo" in
- let name = input_line inchan in
- close_in inchan;
- name
- in
- syslogger#log
- `Debug
- (sprintf "saving output document to %s ..." tempfile);
- let res = domImpl#saveDocumentToFile ~doc:output ~name:tempfile () in
- if not res then
- raise (Uwobo_failure ("unable to save output to file " ^ tempfile));
- syslogger#log `Debug "sending output to client ....";
- Http_daemon.send_basic_headers ~code:200 outchan;
- (* TODO set Content-Type *)
- Http_daemon.send_CRLF outchan;
- Http_daemon.send_file ~name:tempfile outchan;
- Unix.unlink tempfile)
+ 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)
| "/help" -> Http_daemon.respond ~body:usage_string outchan
| invalid_request ->
Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan)
projects / helm.git / blobdiff