(*
  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 Http_types;;
open Http_constants;;
open Http_common;;
open Http_daemon;;
open Printf;;

let status_line_RE = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$"

class response
  (* Warning: keep default values in sync with Http_daemon.respond function *)
  ?(body = "") ?(headers = [])
  ?(version = http_version) ?(code = 200) ?status ()
  =
    (* remove all bindings of 'name' from hashtbl 'tbl' *)
  let rec hashtbl_remove_all tbl name =
    if not (Hashtbl.mem tbl name) then
      raise (Header_not_found name);
    Hashtbl.remove tbl name;
    if Hashtbl.mem tbl name then hashtbl_remove_all tbl name
  in
    (* "version code reason_phrase" *)
  object (self)

    val mutable _version = version
    val mutable _code =
      match status with
      | None -> code
      | Some (s: Http_types.status) -> code_of_status s
    val mutable _reason: string option = None
    val _contentsBuf = Buffer.create 1024
    val _headers = Hashtbl.create 11

    initializer
      self#setContents body;
      self#addHeaders headers

    method version = _version
    method setVersion v = _version <- v

    method code = _code
    method setCode c =
      ignore (status_of_code c);  (* sanity check on c *)
      _code <- c
    method status = status_of_code _code
    method setStatus (s: Http_types.status) = _code <- code_of_status s
    method reason =
      match _reason with
      | None -> Http_misc.reason_phrase_of_code _code
      | Some r -> r
    method setReason r = _reason <- Some r
    method statusLine =
      String.concat
        " "
        [string_of_version self#version; string_of_int self#code; self#reason]
    method setStatusLine s =
      try
        let subs = Pcre.extract ~rex:status_line_RE s in
        self#setVersion (version_of_string subs.(1));
        self#setCode (int_of_string subs.(2));
        self#setReason subs.(3)
      with Not_found ->
        raise (Invalid_status_line s)

    method isInformational = is_informational _code
    method isSuccess = is_success _code
    method isRedirection = is_redirection _code
    method isClientError = is_client_error _code
    method isServerError = is_server_error _code
    method isError = is_error _code

    method contents = Buffer.contents _contentsBuf
    method setContents c =
      Buffer.clear _contentsBuf;
      Buffer.add_string _contentsBuf c
    method contentsBuf = _contentsBuf
    method setContentsBuf b =
      Buffer.clear _contentsBuf;
      Buffer.add_buffer _contentsBuf b
    method addContents s = Buffer.add_string _contentsBuf s
    method addContentsBuf b = Buffer.add_buffer _contentsBuf b

    method addHeader ~name ~value =
      Http_parser.heal_header (name, value);
      Hashtbl.add _headers name value
    method addHeaders =
      List.iter (fun (name, value) -> self#addHeader ~name ~value)

    method replaceHeader ~name ~value =
      Http_parser.heal_header (name, value);
      Hashtbl.replace _headers name value
    method replaceHeaders =
      List.iter (fun (name, value) -> self#replaceHeader ~name ~value)
      
      (* FIXME duplication of code between this and send_basic_headers *)
    method addBasicHeaders =
      self#addHeader ~name:"Date" ~value:(Http_misc.date_822 ());
      self#addHeader ~name:"Server" ~value:server_string
    method removeHeader ~name = hashtbl_remove_all _headers name
    method hasHeader ~name = Hashtbl.mem _headers name
    method header ~name =
      if not (self#hasHeader name) then
        raise (Header_not_found name);
      String.concat ", " (List.rev (Hashtbl.find_all _headers name))
    method headers =
      List.rev
        (Hashtbl.fold
          (fun name _ headers -> (name, self#header ~name)::headers)
          _headers
          [])

    method contentType = self#header "Content-Type"
    method setContentType t = self#replaceHeader "Content-Type" t
    method contentEncoding = self#header "Content-Encoding"
    method setContentEncoding e = self#replaceHeader "Content-Encoding" e
    method date = self#header "Date"
    method setDate d = self#replaceHeader "Date" d
    method expires = self#header "Expires"
    method setExpires t = self#replaceHeader "Expires" t
    method server = self#header "Server"
    method setServer s = self#replaceHeader "Server" s

    method toString =
      sprintf
        "%s%s%s%s%s"
        self#statusLine (* status line *)
        crlf
        (String.concat  (* headers, crlf terminated *)
          ""
          (List.map (fun (h,v) -> h ^ ": " ^ v ^ crlf) self#headers))
        crlf
        (Buffer.contents _contentsBuf) (* body *)
    method serialize outchan =
      output_string outchan self#toString;
      flush outchan

  end