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

« back to all changes in this revision

Viewing changes to examples/nethttpd/easy_engine.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
* 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:
2
2
 
3
3
open Printf
4
4
 
5
 
let generate (cgi : Netcgi_types.cgi_activation) =
 
5
let generate (cgi : Netcgi.cgi_activation) =
6
6
  (* A Netcgi-based content provider *)
7
7
  cgi # set_header
8
8
    ~cache:`No_cache
41
41
  ( try
42
42
      let env = notification # environment in
43
43
      let cgi =
44
 
        new Netcgi.std_activation
45
 
          ~env:(env :> Netcgi_env.cgi_environment)
46
 
          ~operating_type:Netcgi.buffered_transactional_optype () in
 
44
        Netcgi_common.cgi_with_args 
 
45
          (new Netcgi_common.cgi)
 
46
          (env :> Netcgi.cgi_environment)
 
47
          Netcgi.buffered_transactional_outtype
 
48
          env#input_channel
 
49
          (fun _ _ _ -> `Automatic) in
47
50
      generate cgi;
48
51
    with
49
52
        e ->
73
76
   *)
74
77
  printf "Connected\n";
75
78
  flush stdout;
76
 
  let config : Nethttpd_engine.http_engine_config =
77
 
    object
78
 
      method config_timeout_next_request = 15.0
79
 
      method config_timeout = 300.0
80
 
      method config_cgi = Netcgi_env.default_config
81
 
      method config_error_response n = "<html>Error " ^ string_of_int n ^ "</html>"
82
 
      method config_log_error _ _ _ _ msg =
83
 
        (printf "Error log: %s\n" msg; flush stdout)
84
 
      method config_max_reqline_length = 256
85
 
      method config_max_header_length = 32768
86
 
      method config_max_trailer_length = 32768
87
 
      method config_limit_pipeline_length = 5
88
 
      method config_limit_pipeline_size = 250000  (* no effect here! *)
89
 
      method config_input_flow_control = false
90
 
      method config_output_flow_control = true
91
 
      method config_announce_server = `Ocamlnet
92
 
    end
93
 
  in
 
79
  let config = Nethttpd_engine.default_http_engine_config in
94
80
  Unix.set_nonblock fd;
95
81
  let http_engine = 
96
82
    new Nethttpd_engine.http_engine ~on_request_header () config fd ues in
133
119
  (* Start the main event loop. *)
134
120
  Unixqueue.run ues
135
121
;;
 
122
let conf_debug() =
 
123
  (* Set the environment variable DEBUG to either:
 
124
       - a list of Netlog module names
 
125
       - the keyword "ALL" to output all messages
 
126
       - the keyword "LIST" to output a list of modules
 
127
     By setting DEBUG_WIN32 additional debugging for Win32 is enabled.
 
128
   *)
 
129
  let debug = try Sys.getenv "DEBUG" with Not_found -> "" in
 
130
  if debug = "ALL" then
 
131
    Netlog.Debug.enable_all()
 
132
  else if debug = "LIST" then (
 
133
    List.iter print_endline (Netlog.Debug.names());
 
134
    exit 0
 
135
  )
 
136
  else (
 
137
    let l = Netstring_str.split (Netstring_str.regexp "[ \t\r\n]+") debug in
 
138
    List.iter
 
139
      (fun m -> Netlog.Debug.enable_module m)
 
140
      l
 
141
  );
 
142
  if (try ignore(Sys.getenv "DEBUG_WIN32"); true with Not_found -> false) then
 
143
    Netsys_win32.Debug.debug_c_wrapper true
 
144
;;
136
145
 
137
 
Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
 
146
Netsys_signal.init();
 
147
conf_debug();
138
148
start();;