← Back to branch summary

~ubuntu-branches/ubuntu/trusty/ocamlnet/trusty

« back to all changes in this revision

Viewing changes to examples/cgi/netcgi1/cgi/add.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-09-02 14:12:33 UTC
  • mfrom: (18.2.3 sid)
  • Revision ID: james.westby@ubuntu.com-20110902141233-zbj0ygxb92u6gy4z
Tags: 3.4-1
http://bugs.debian.org/637147
* New upstream release
  - add a new NetcgiRequire directive to ease dependency management
    (Closes: #637147)
  - remove patches that were applied upstream:
    + Added-missing-shebang-lines-in-example-shell-scripts
    + Try-also-ocamlc-for-POSIX-threads

Show diffs side-by-side

added added

removed removed

Lines of Context:
examples/cgi/netcgi1/cgi/add.ml
1
 
(* $Id: add.ml 1004 2006-09-25 16:01:06Z gerd $
2
 
 * ----------------------------------------------------------------------
3
 
 *
4
 
 *)
5
 
 
6
 
open Netcgi;;
7
 
open Netcgi_types;;
8
 
open Printf;;
9
 
 
10
 
(***********************************************************************
11
 
 * This example demonstrates a very simple CGI page that refers to itself
12
 
 * using the GET method.
13
 
 ***********************************************************************)
14
 
 
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 "<" = "&lt;", and text "�" = "&auml;"
18
 
 *)
19
 
 
20
 
let begin_page cgi 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";
24
 
  out "<HTML>\n";
25
 
  out "<HEAD>\n";
26
 
  out ("<TITLE>" ^ text title ^ "</TITLE>\n");
27
 
  out ("<STYLE TYPE=\"text/css\">\n");
28
 
  out "body { background: white; color: black; }\n";
29
 
  out "</STYLE>\n";
30
 
  out "</HEAD>\n";
31
 
  out "<BODY>\n";
32
 
  out ("<H1>" ^ text title ^ "</H1>\n")
33
 
;;
34
 
 
35
 
 
36
 
let end_page cgi =
37
 
  let out = cgi # output # output_string in
38
 
  out "</BODY>\n";
39
 
  out "</HTML>\n"
40
 
;;
41
 
 
42
 
 
43
 
let generate_query_page (cgi : cgi_activation) =
44
 
  (* Display the query form. *)
45
 
  begin_page cgi "Add Two Numbers";
46
 
  let out = cgi # output # output_string in
47
 
  out "<P>This CGI page can perform additions. Please enter two integers,\n";
48
 
  out "and press the button!\n";
49
 
  out (sprintf "<P><FORM METHOD=GET ACTION=\"%s\">\n" 
50
 
         (text (cgi#url())));
51
 
  (* Note that cgi#url() returns the URL of this script (without ? clause).
52
 
   * We pass this string through the text function to avoid problems with
53
 
   * some characters.
54
 
   *)
55
 
  out "<INPUT TYPE=TEXT NAME=\"x\"> + <INPUT TYPE=TEXT NAME=\"y\"> = ";
56
 
  out "<INPUT TYPE=SUBMIT NAME=\"button\" VALUE=\"Go!\">\n";
57
 
  (* The hidden field only indicates that now the result page should
58
 
   * be consulted.
59
 
   *)
60
 
  out "<INPUT TYPE=HIDDEN NAME=\"page\" VALUE=\"result\">\n";
61
 
  out "</FORM>\n";
62
 
  end_page cgi
63
 
;;
64
 
 
65
 
 
66
 
let generate_result_page (cgi : cgi_activation) =
67
 
  (* Compute the result, and display it *)
68
 
  begin_page cgi "Sum";
69
 
  let out = cgi # output # output_string in
70
 
  out "<P>The result is:\n";
71
 
  let x = cgi # argument_value "x" in
72
 
  let y = cgi # argument_value "y" in
73
 
  let sum = (int_of_string x) + (int_of_string y) in
74
 
  out (sprintf "<P>%s + %s = %d\n" x y sum);
75
 
  out (sprintf "<P><A HREF=\"%s\">Add further numbers</A>\n" 
76
 
         (text (cgi#url 
77
 
                  ~with_query_string:
78
 
                                   (`Args [new simple_argument "page" "query"])
79
 
                  ()
80
 
               )));
81
 
  (* Here, the URL contains the CGI argument "page", but no other arguments. *)
82
 
  end_page cgi
83
 
;;
84
 
 
85
 
 
86
 
let generate_page (cgi : cgi_activation) =
87
 
  (* Check which page is to be displayed. This is contained in the CGI
88
 
   * argument "page".
89
 
   *)
90
 
  match cgi # argument_value "page" with
91
 
      "" ->
92
 
        (* The argument is the empty string, or the argument is missing.
93
 
         * This is the same like the page "query".
94
 
         *)
95
 
        generate_query_page cgi
96
 
    | "query" ->
97
 
        generate_query_page cgi
98
 
    | "result" ->
99
 
        generate_result_page cgi
100
 
    | _ ->
101
 
        assert false
102
 
;;
103
 
 
104
 
 
105
 
let process() =
106
 
  (* A [cgi_activation] is an object that allows us to program pages
107
 
   * in a quite abstract way. By creating the [std_activation] object
108
 
   * the CGI/1.1 protocol is used to communicate with the outer world.
109
 
   * The CGI arguments are read in, and further properties of the protocol
110
 
   * are available by method calls.
111
 
   *
112
 
   * The parameter [~operating_type] specifies that the generated HTML
113
 
   * page is buffered, and sent to the browser when it is complete. This
114
 
   * has the advantage that you can catch errors while the page is generated,
115
 
   * and can output error messages. Other [~operating_type]s make it
116
 
   * possible that the HTML page is buffered in a temporary file, and it
117
 
   * can also be specified that the HTML page is not buffered at all.
118
 
   *)
119
 
  let cgi =
120
 
    new std_activation ~operating_type:buffered_transactional_optype () in
121
 
  
122
 
  (* The [try] block catches errors during the page generation. *)
123
 
  try
124
 
    (* Set the header. The header specifies that the page must not be
125
 
     * cached. This is important for dynamic pages called by the GET
126
 
     * method, otherwise the browser might display an old version of
127
 
     * the page.
128
 
     * Furthermore, we set the content type and the character set.
129
 
     * Note that the header is not sent immediately to the browser because
130
 
     * we have enabled HTML buffering.
131
 
     *)
132
 
    cgi # set_header 
133
 
      ~cache:`No_cache 
134
 
      ~content_type:"text/html; charset=\"iso-8859-1\""
135
 
      ();
136
 
 
137
 
    generate_page cgi;
138
 
 
139
 
    (* After the page has been fully generated, we can send it to the
140
 
     * browser. 
141
 
     *)
142
 
    cgi # output # commit_work();
143
 
  with
144
 
      error ->
145
 
        (* An error has happened. Generate now an error page instead of
146
 
         * the current page. By rolling back the output buffer, any 
147
 
         * uncomitted material is deleted.
148
 
         *)
149
 
        cgi # output # rollback_work();
150
 
 
151
 
        (* We change the header here only to demonstrate that this is
152
 
         * possible.
153
 
         *)
154
 
        cgi # set_header 
155
 
          ~status:`Forbidden                  (* Indicate the error *)
156
 
          ~cache:`No_cache 
157
 
          ~content_type:"text/html; charset=\"iso-8859-1\""
158
 
          ();
159
 
 
160
 
        begin_page cgi "Software error";
161
 
        cgi # output # output_string "While processing the request an O'Caml exception has been raised:<BR>";
162
 
        cgi # output # output_string ("<TT>" ^ text(Printexc.to_string error) ^ "</TT><BR>");
163
 
        end_page cgi;
164
 
 
165
 
        (* Now commit the error page: *)
166
 
        cgi # output # commit_work()
167
 
;;
168
 
 
169
 
 
170
 
let main() =
171
 
  (* Call the function that processes the request, and catch any remaining
172
 
   * errors. These include protocol errors, and insufficient memory.
173
 
   * Because we cannot do anything else the error is simply logged.
174
 
   *
175
 
   * Note: Some web servers (e.g. iPlanet) do not always write the stderr output
176
 
   * to the error log. By prepending an empty line, the response is invalid
177
 
   * anyway, and chances are high that it is logged.
178
 
   *)
179
 
  try
180
 
    process()
181
 
  with
182
 
      error ->
183
 
        prerr_newline();
184
 
        prerr_endline ("O'Caml exception: " ^ Printexc.to_string error)
185
 
;;
186
 
 
187
 
 
188
 
main();;
189
 
 
190
 
  
191
 
 
192
 
(* ======================================================================
193
 
 * History:
194
 
 * 
195
 
 * $Log$
196
 
 * Revision 1.1  2001/10/18 22:16:48  stolpmann
197
 
 *      Initial revision.
198
 
 *
199
 
 * 
200
 
 *)