1
(* $Id: add_fastcgi.ml 1004 2006-09-25 16:01:06Z gerd $
2
* ----------------------------------------------------------------------
11
(***********************************************************************
12
* This is the adder for fcgi
13
***********************************************************************)
15
let text = Netencoding.Html.encode_from_latin1;;
16
(* This function encodes "<", ">", "&", double quotes, and Latin 1 characters
17
* as character entities. E.g. text "<" = "<", and text "�" = "ä"
20
let begin_page (cgi: cgi_activation) title =
21
(* Output the beginning of the page with the passed [title]. *)
22
let out = cgi # output # output_string in
23
out "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0//EN\" \"http://www.w3.org/TR/REC-html40/strict.dtd\">\n";
25
(List.iter (* dump the header fields *)
26
(fun (name, valu) -> out (name ^ ": " ^ valu ^ "\n"))
27
cgi#environment#input_header_fields);
28
out "cookies\n--------\n";
29
(List.iter (* dump cookies *)
30
(fun (name, valu) -> out (name ^ ": " ^ valu ^ "\n"))
31
cgi#environment#cookies);
32
out ("remote host: " ^ (cgi#environment#cgi_remote_addr) ^ "\n");
36
out ("<TITLE>" ^ text title ^ "</TITLE>\n");
37
out ("<STYLE TYPE=\"text/css\">\n");
38
out "body { background: white; color: black; }\n";
42
(* So we can find out the PID: *)
43
out ("<!-- PID: " ^ string_of_int (Unix.getpid()) ^ " -->\n");
44
out ("<H1>" ^ text title ^ "</H1>\n")
49
let out = cgi # output # output_string in
55
let generate_query_page (cgi : cgi_activation) =
56
(* Display the query form. *)
57
begin_page cgi "Add Two Numbers";
58
let out = cgi # output # output_string in
59
out "<P>This CGI page can perform additions. Please enter two integers,\n";
60
out "and press the button!\n";
61
out (sprintf "<P><FORM METHOD=POST ACTION=\"%s\">\n"
63
(* Note that cgi#url() returns the URL of this script (without ? clause).
64
* We pass this string through the text function to avoid problems with
67
out "<INPUT TYPE=TEXT NAME=\"x\"> + <INPUT TYPE=TEXT NAME=\"y\"> = ";
68
out "<INPUT TYPE=SUBMIT NAME=\"button\" VALUE=\"Go!\">\n";
69
(* The hidden field only indicates that now the result page should
72
out "<INPUT TYPE=HIDDEN NAME=\"page\" VALUE=\"result\">\n";
78
let generate_result_page (cgi : cgi_activation) =
79
(* Compute the result, and display it *)
81
let out = cgi # output # output_string in
82
out "<P>The result is:\n";
83
let x = cgi # argument_value "x" in
84
let y = cgi # argument_value "y" in
85
let sum = (int_of_string x) + (int_of_string y) in
86
out (sprintf "<P>%s + %s = %d\n" x y sum);
87
out (sprintf "<P><A HREF=\"%s\">Add further numbers</A>\n"
90
(`Args [new simple_argument "page" "query"])
93
(* Here, the URL contains the CGI argument "page", but no other arguments. *)
98
let generate_page (cgi : cgi_activation) =
99
(* Check which page is to be displayed. This is contained in the CGI
102
match cgi # argument_value "page" with
104
(* The argument is the empty string, or the argument is missing.
105
* This is the same like the page "query".
107
generate_query_page cgi
109
generate_query_page cgi
111
generate_result_page cgi
117
let process (cgi : cgi_activation) =
118
(* The [try] block catches errors during the page generation. *)
120
(* Set the header. The header specifies that the page must not be
121
* cached. This is important for dynamic pages called by the GET
122
* method, otherwise the browser might display an old version of
124
* Furthermore, we set the content type and the character set.
125
* Note that the header is not sent immediately to the browser because
126
* we have enabled HTML buffering.
130
~content_type:"text/html; charset=\"iso-8859-1\""
135
(* After the page has been fully generated, we can send it to the
138
cgi # output # commit_work();
141
(* An error has happened. Generate now an error page instead of
142
* the current page. By rolling back the output buffer, any
143
* uncomitted material is deleted.
145
cgi # output # rollback_work();
147
(* We change the header here only to demonstrate that this is
151
~status:`Forbidden (* Indicate the error *)
153
~content_type:"text/html; charset=\"iso-8859-1\""
156
begin_page cgi "Software error";
157
cgi # output # output_string "While processing the request an O'Caml exception has been raised:<BR>";
158
cgi # output # output_string ("<TT>" ^ text(Printexc.to_string error) ^ "</TT><BR>");
161
(* Now commit the error page: *)
162
cgi # output # commit_work()
165
(* start the fastcgi server *)
166
serv process buffered_transactional_optype;;
169
(* ======================================================================
173
* Revision 1.3 2004/11/24 18:01:07 gremlin43820
174
* commiting fastcgi compatibility patch from Kristof Pap which allows us to talk to a wider variety of fastcgi enabled web servers, and more closely follows the standard.
176
* Revision 1.1 2003/10/07 17:39:32 stolpmann
177
* Imported Eric's patch for fastcgi
179
* Revision 1.1 2003/10/03 22:02:07 eric
180
* added an example for fastcgi
182
* Revision 1.1 2002/03/25 00:12:50 stolpmann
185
* Revision 1.1 2002/02/03 21:31:34 stolpmann