Redirection not working with nethttpd

Paolo Donadeo <[email protected]> Tue, 11 Aug 2009 15:46:36 +0200

Newsgroups	gmane.comp.lang.ocaml.lib.net.devel
Message-ID	<[email protected]>

Hi everybody, I think I need your help. I just wrote a minimal program
that highlights a problem with redirect and nethttpd. The script is so
simple that I think I simply missed something, or incorrectly
configured the netplex server.

The CGI script handles only 3 URLS: "/", the home page with a login
form, that has "/post_url" as action; "/post_url", that handles the
POST and redirect to "/redir" and, finally, "/redir" which displays
"OK". Everything else is "not found".

After the form POST I read this log line:

[Tue Aug 11 15:28:01 2009] [test server] [err] [-] [-] Nethttpd:
Uncaught exception: Failure("Caught Redirect_response, but it is too
late for redirections")

The script can be compiled with:

$ ocamlbuild test.d.byte (or test.native)

and run with

$ ./test.d.byte -conf netplex.conf -fg

All the files needed for compilation are attached. I'm running a 32
bit Ubuntu box, with Objective Caml 3.11.0 and Ocamlnet 2.2.9.

Can you help me?


-- 
Paolo
~
~
:wq

------------------------------------------------------------------------------
Let Crystal Reports handle the reporting - Free Crystal Reports 2008 30-Day 
trial. Simplify your report design, integration and deployment - and focus on 
what you do best, core application coding. Discover what's new with 
Crystal Reports now.  http://p.sf.net/sfu/bobj-july

_______________________________________________
Ocamlnet-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/ocamlnet-devel

myocamlbuild.ml (text/x-ocaml, 1.7 KB)

open Ocamlbuild_plugin
open Command (* no longer needed for OCaml >= 3.10.2 *)

(* these functions are not really officially exported *)
let run_and_read = Ocamlbuild_pack.My_unix.run_and_read
let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings

(* this lists all supported packages *)
let find_packages () =
  blank_sep_strings &
    Lexing.from_string &
      run_and_read "ocamlfind list | cut -d' ' -f1"

(* ocamlfind command *)
let ocamlfind x = S[A"ocamlfind"; x]

let _ = dispatch begin function
   | Before_options ->

       (* override default commands by ocamlfind ones *)
       Options.ocamlc   := ocamlfind & A"ocamlc";
       Options.ocamlopt := ocamlfind & A"ocamlopt";
       Options.ocamldep := ocamlfind & A"ocamldep";
       Options.ocamldoc := ocamlfind & A"ocamlfind";

   | After_rules ->
       (* When one link an OCaml library/binary/package, one should use -linkpkg *)
       flag ["ocaml"; "link"] & A"-linkpkg";
       flag ["ocaml"; "thread_option"] & A"-thread";
       flag ["infer_interface"; "use_camlp4"] & S[A"-I"; A"+camlp4"];

       (* For each ocamlfind package one inject the -package option when
       	* compiling, computing dependencies, generating documentation and
       	* linking. *)
        List.iter
          (
            fun pkg ->
              flag ["ocaml"; "compile";         "pkg_"^pkg] & S[A"-package"; A pkg];
              flag ["ocaml"; "ocamldep";        "pkg_"^pkg] & S[A"-package"; A pkg];
              flag ["ocaml"; "doc";             "pkg_"^pkg] & S[A"-package"; A pkg];
              flag ["ocaml"; "link";            "pkg_"^pkg] & S[A"-package"; A pkg];
              flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S[A"-package"; A pkg];
          ) (find_packages ());

   | _ -> ()
end

netplex.conf (application/octet-stream, 829 B)

netplex {
  controller {
    max_level = "debug";
    logging {
      type = "file";
      file = "/home/paolo/Documenti/Home_page/blog.git/src/test_MVC/test/test.log";
    }
  };
  service {
    name = "test server";
    protocol {
      name = "http";
      address {
        type = "internet";
        bind = "127.0.0.1:8000";
      };
    };
    processor {
      type = "nethttpd";
      host {
        pref_name = "localhost";
        pref_port = 8000;
        names = "*:0";
        uri {
          path = "/";
          service {
            type = "dynamic";
            handler = "test_handler";
          }
        };
      };
    };
    workload_manager {
      type = "dynamic";
      max_jobs_per_thread = 1;
      min_free_jobs_capacity = 1;
      max_free_jobs_capacity = 1;
      max_threads = 20;
    };
  }
}

_tags (application/octet-stream, 133 B) - not displayed

test.log (text/x-log, 158 B)

[Tue Aug 11 15:28:01 2009] [test server] [err] [-] [-] Nethttpd: Uncaught exception: Failure("Caught Redirect_response, but it is too late for redirections")

test.ml (text/x-ocaml, 2.9 KB)

let rec request_dispatcher (cgi : Netcgi.cgi_activation) =
  let script_name = cgi#environment#cgi_script_name in
  match script_name with
    | "/" -> begin (* The "home" page *)
    (* A simple login form *)
      let content = "<html>
  <head><title>Home page</head>
  <body>
    <p>Login</p>
    <p>
      <form action=\"/post_url\" method=\"post\">
        <input type=\"text\" name=\"login\" id=\"login\">
        <br />
        <input type=\"password\" name=\"pwd\" id=\"pwd\">
        <br />
     		<input type=\"submit\" name=\"submit\" id=\"submit\" value=\"Log In\"/> 
      </form>
    </p>
  </body>
</html>" in
      let content_length = String.length content in
        cgi#set_header
          ~status:`Ok
          ~cache:`No_cache
          ~content_length ();
        cgi#out_channel#output_string content;
        cgi#out_channel#commit_work ();
    end
    | "/post_url" -> begin (* handles the POST and redirect to /redir *)
      let e = cgi#environment in
        e#set_output_header_fields [];
        e#set_status `Found;
        e#set_output_header_field "Location" "/redir";
        cgi#out_channel#commit_work ();
    end
    | "/redir" -> begin (* the "logged in" page *)
      let content = "OK!" in
      let content_length = String.length content in
        cgi#set_header
          ~status:`Ok
          ~cache:`No_cache
          ~content_type:"text/plain"
          ~content_length ();
        cgi#out_channel#output_string content;
        cgi#out_channel#commit_work ();
    end
    | _ -> begin
      let content = "Sorry, not found!" in
      let content_length = String.length content in
        cgi#set_header
          ~status:`Not_found
          ~cache:`No_cache
          ~content_type:"text/plain"
          ~content_length ();
        cgi#out_channel#output_string content;
        cgi#out_channel#commit_work ();
    end
;;

let request_dispatcher' (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
  let cgi' = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
    request_dispatcher cgi';
;;

let netplex_dynamic_handler =
   {
     Nethttpd_services.dyn_handler = (fun _ -> request_dispatcher');
     dyn_activation = Nethttpd_services.std_activation `Std_activation_buffered;
     dyn_uri = None;
     dyn_translator = (fun _ -> "");
     dyn_accept_all_conditionals = false;
   };;

let nethttpd_factory () =
  Nethttpd_plex.nethttpd_factory
    ~handlers:[("test_handler", netplex_dynamic_handler)] ()
;;

let main() =
  let (opt_list, cmdline_cfg) = Netplex_main.args () in

    Arg.parse
      opt_list
      (fun s -> raise (Arg.Bad ("Don't know what to do with: " ^ s)))
      "usage: netplex [options]";

    Netplex_main.startup
      (Netplex_mp.mp ())
      Netplex_log.logger_factories
      Netplex_workload.workload_manager_factories
      [ nethttpd_factory () ]
      cmdline_cfg
;;

Sys.set_signal Sys.sigpipe Sys.Signal_ignore;;

main();;