(*
* <COPYRIGHT>
* Copyright 2002 Joachim Schrod Network and Publication Consultance GmbH, Gerd Stolpmann
*
* <GPL>
* This file is part of WDialog.
*
* WDialog is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* WDialog is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with WDialog; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
* </>
*)
(* $Id: wd_run_fcgi.ml,v 1.1 2004-12-04 03:51:08 gremlin43820 Exp $
* ----------------------------------------------------------------------
*
*)
open Wd_types
open Netcgi
open Netchannels
let print_error (ch:out_obj_channel) exc =
let s = Printexc.to_string exc in
let out = ch # output_string in
out "<html><body><h1>Software error</h1>\n";
out "<tt>";
out (Netencoding.Html.encode_from_latin1 s);
out "</tt></body></html>\n"
;;
let processing name hdr =
`Automatic
;;
let create_request_handler
?(charset = `Enc_iso88591)
?session_manager
?(no_cache = true)
?(error_page = print_error)
?response_header
?(reg = (fun _ -> ()))
~uifile
() =
(* Load the UI term: *)
let app =
if Filename.check_suffix uifile ".ui.bin" then
Wd_transform.load_uiapplication ~charset uifile
else
if Filename.check_suffix uifile ".ui" then
Wd_transform.parse_uiapplication ~charset uifile
else
failwith "Wd_run_jserv: Bad file extension of ~uifile"
in
let universe = new Wd_universe.universe app in
reg universe;
let activate (cgi : cgi_activation) =
begin try
let cache =
match cgi # request_method with
`GET -> `No_cache
| `POST -> if no_cache then `No_cache else `Unspecified
| _ -> assert false
in
let charset_s =
Netconversion.string_of_encoding (charset :> Netconversion.encoding) in
let response_header =
match response_header with
None -> { rh_status = `Ok;
rh_content_type = "text/html; charset=" ^ charset_s;
(* Note: Some browsers (e.g. Mozilla-0.9.6) do not like
* quotes around charset
*)
rh_cache = cache;
rh_filename = None;
rh_language = None;
rh_script_type = None;
rh_style_type = None;
rh_set_cookie = [];
rh_fields = [];
}
| Some rh -> rh
in
Wd_cycle.process_request ?session_manager ~response_header universe cgi;
with
exc ->
cgi # output # rollback_work();
cgi # set_header ~status:`Internal_server_error ~cache:`No_cache ();
error_page (cgi#output :> out_obj_channel) exc;
(* may raise another exception! *)
end;
cgi # output # commit_work();
cgi # finalize();
in
activate
;;
(* ======================================================================
* History:
*
* $Log: wd_run_fcgi.ml,v $
* Revision 1.1 2004-12-04 03:51:08 gremlin43820
* finially adding fastcgi support
*
* Revision 1.2 2003/01/04 21:55:25 stolpmann
* new record response_header
*
* Revision 1.1 2002/03/19 22:09:55 stolpmann
* Initial revision.
*
*)
