(************************************************************
   http.ml		Created      : Sat Feb  8 19:40:34 2003
  			Last modified: Sun Dec 24 11:11:14 2006
  Compile: ocamlc.opt -a -o http.cma -g str.cma unix.cma mytcp.ml url.cmo http.ml #
  Compile: ocamlc.opt -g str.cma unix.cma mytcp.ml url.cmo http.ml -o http #
  FTP Directory: sources/ocaml #
************************************************************)
(**

  @author Takashi Masuyama <mamewo@dk9.so-net.ne.jp>

*)
exception Error of string

open Url

let split_regexp = Str.regexp "\r\n\r\n"

let issue_http_request http_method version header url =
  if url.protocol <> HTTP then
    raise (Error ("irregural protocol"))
  else
    let header_string =
      let rec iter = function
	  [] -> ""
	| hd::tl -> hd^"\r\n"^(iter tl) in
      iter header in
    let request_string =
      Printf.sprintf "%s %s HTTP/%s\r\n%s\r\n" http_method url.path version header_string in
(*    prerr_endline request_string;*)
    let s = Mytcp.connect url.hostname url.port in
    let buf = String.make 1 '\000' in
    let c = ref "" in
    try
      Unix.setsockopt_float s Unix.SO_RCVTIMEO 30.0;
      Unix.setsockopt_float s Unix.SO_SNDTIMEO 30.0;
      ignore (Unix.write s request_string 0 (String.length request_string));
      while true do
	let num = Unix.read s buf 0 1 in
	if num = 0 then
	  raise End_of_file
	else
	  c := !c^(String.sub buf 0 1)
      done;
      (* dummy *)
      ("hoge", !c)
    with
      End_of_file ->
	let content = !c in
	let size = String.length content in
	let pos = Str.search_forward split_regexp content 0 in
	let head = String.sub content 0 pos in
	let content_init_pos = Str.match_end () in
	let content = 
	  String.sub content content_init_pos (size - content_init_pos) in
	(head, content)
    | (Unix.Unix_error(id, msg, _)) as e ->
	Printf.fprintf Pervasives.stderr "http.ml: get Unix_error %s: %s" msg (Unix.error_message id);
	raise e

let get10 ?(header = []) url =
  issue_http_request "GET" "1.0" header url

let head10 ?(header = []) url =
  issue_http_request "HEAD" "1.0" header url

let get11 ?(header = []) url =