(*
  OCaml HTTP - do it yourself (fully OCaml) HTTP daemon

  Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>

  This program 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.

  This program 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 this program; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)

open Printf;;

open Http_common;;
open Http_types;;

let debug_dump_request path params =
  debug_print ("request path = " ^ path);
  debug_print (
    sprintf"request params = %s"
      (String.concat ";"
        (List.map (fun (h,v) -> String.concat "=" [h;v]) params)))

exception Fallback;;  (* used internally by request class *)

class request ic =
  let (meth, uri, version) = Http_parser.parse_request_fst_line ic in
  let uri_str = Neturl.string_of_url uri in
  let path = Http_parser.parse_path uri in
  let query_get_params = Http_parser.parse_query_get_params uri in
  let headers = Http_parser.parse_headers ic in (* trailing \r\n consumed! *)
  let body =
    (* TODO fallback on Transfer-Encoding if Content-Length isn't defined *)
    if meth = `POST then
      Buffer.contents
        (try  (* read only Content-Length bytes *)
          let limit_raw =
            (try
              (snd (List.find
                (fun (h,v) -> String.lowercase h = "content-length") headers))
            with Not_found -> raise Fallback)
          in
          let limit =
            (try  (* TODO supports only a maximum content-length of 1Gb *)
              int_of_string limit_raw
            with Failure "int_of_string" ->
              raise (Invalid_header ("Content-Length: " ^ limit_raw)))
          in
          Http_misc.buf_of_inchan ~limit ic
        with Fallback -> Http_misc.buf_of_inchan ic)  (* read until EOF *)
    else "" (* TODO empty body for methods other than POST, is what we want? *)
  in
    (* TODO brave assumption: when meth = `POST, Content-Type is
    application/x-www-form-urlencoded and is therefore one-liner parsed as a GET
    query *)
  let query_post_params =
    match meth with
    | `POST -> Http_parser.split_query_params body
    | _ -> []
  in
  let params = query_post_params @ query_get_params in (* prefers POST params *)
  let _ = debug_dump_request path params in
  let (clisockaddr, srvsockaddr) =
    (Http_misc.peername_of_in_channel ic, Http_misc.sockname_of_in_channel ic)
  in

  object (self)

    inherit
      Http_message.message ~body ~headers ~version ~clisockaddr ~srvsockaddr

    val params_tbl =
      let tbl = Hashtbl.create (List.length params) in
      List.iter (fun (n,v) -> Hashtbl.add tbl n v) params;
      tbl

    method meth = meth
    method uri = uri_str
    method path = path
    method param ?meth name =
      (match (meth: meth option) with
      | None ->
          (try
            Hashtbl.find params_tbl name
          with Not_found -> raise (Param_not_found name))
      | Some `GET -> List.assoc name query_get_params
      | Some `POST -> List.assoc name query_post_params)
    method paramAll ?meth name =
      (match (meth: meth option) with
      | None -> List.rev (Hashtbl.find_all params_tbl name)
      | Some `GET -> Http_misc.list_assoc_all name query_get_params
      | Some `POST -> Http_misc.list_assoc_all name query_post_params)
    method params = params
    method params_GET = query_get_params
    method params_POST = query_post_params

    method private fstLineToString =
      sprintf "%s %s %s"
        (string_of_method self#meth) self#uri (string_of_version self#version)

  end

(*    (* OLD IMPLEMENTATION *)
class request
  ~body ~headers ~version ~meth ~uri
  ~clisockaddr ~srvsockaddr
  ~path ~params
  ()
  =
  object (self)

    inherit
      Http_message.message ~body ~headers ~version ~clisockaddr ~srvsockaddr

    val params_tbl =
      let tbl = Hashtbl.create (List.length params) in
      List.iter (fun (n,v) -> Hashtbl.add tbl n v) params;
      tbl

    method meth = meth
    method uri = uri
    method path = path
    method param name =
      try
        Hashtbl.find params_tbl name
      with Not_found ->
        raise (Param_not_found name)
    method paramAll name = List.rev (Hashtbl.find_all params_tbl name)
    method params = params

    method private fstLineToString =
      sprintf
        "%s %s %s"
        (string_of_method self#meth)
        self#uri
        (string_of_version self#version)

  end
*)