(* The file: protocol *)
open Printf
open Unix
open Filename
open Mstring
open Hyper
open Www
open Url
open Messages
open Http_headers
open Http
open Document
open Feed

exception File_error of string

(* 
 * Simulate directory
 *)

let isdir path f =
  let fullname = Filename.concat path f in
    (stat fullname).st_kind = S_DIR

let d2html path d =
  (* make sure that when path is used in url, it is / terminated *)
  let pathurl =
    let l = String.length path in
    if l = 0 then path else
    if path.[l-1] = '/' then path
    else sprintf "%s/" path
  in
  printf 
"<HTML>
<HEAD><TITLE>%s</TITLE>
<BASE HREF=\"file://localhost%s\">
</HEAD>
<BODY>
<H1>Directory list: %s</H1>
<DL COMPACT>" path pathurl path;
  let entries = ref [] in
  begin try
    while true do 
      entries := (readdir d) :: !entries
      done      	
  with 
      End_of_file -> closedir d
  end;
  entries := Sort.list (<=) !entries;
  List.iter (function
      "." -> ()
    | ".." ->
       printf "<DT>Dir</DT> <DD><A HREF=\"file://localhost%s\">..</A></DD>"
       	      (Filename.concat (dirname (dirname pathurl)) "")
    | f ->
       try 
       	let it, uri = if isdir path f 
      	       	      then "Dir", Filename.concat f ""
      	       	      else "File", f in

       	printf "<DT>%s</DT> <DD><A HREF=\"%s\">%s</A></DD>"
	       it uri f
       with
	 Unix_error(_,_,_) -> ())
    !entries;
  printf "</DL></BODY></HTML>"

(* It's easiest to do it asynchronously anyway *)
let dir path =
  try
    let d = opendir path in
    let cin, cout = pipe() in
      match Low.fork() with
      	0 -> close cin; dup2 cout stdout; close cout;
	     begin try d2html path d with _ -> () end;
	     exit 0; cin (*duh*)
      | n -> closedir d; close cout; cin
  with
    Unix_error(_,_,_)  -> 
      raise (File_error (I18n.sprintf "cannot open dir"))
  

let document_id wwwr =
  { document_url = wwwr.www_url; document_stamp = no_stamp}

(* TODO: tilde_subst ? *)
let binary_prefix = ref ""

(* Not true CGI interface, just a hack *)
(* TODO: headers ? *)
let fake_cgi wwwr cont path =
  try 
    let (cmd_in, cmd_out) = pipe() in
    let cmd, args = 
      try 
      	let pos = first_char_pos '?' path in
	let cmd = String.sub path 0 pos in
	if pos + 1 = String.length path then cmd, [| cmd |]
	else 
         cmd, [|cmd; String.sub path (pos+1) (String.length path - pos - 1)|]
      with
      	Not_found -> path, [| path |] in
    match Low.fork() with
      0 -> 
      	close cmd_in;
	dup2 cmd_out stdout; close cmd_out;
	begin try execvp cmd args 
	with
	  Unix_error(e, _, _) ->
	   Munix.write_string stdout "HTTP/1.0 404 Not found\r\n";
	   Munix.write_string stdout "Content-Type: text/html\r\n\r\n";
	   Munix.write_string stdout "<H1>Cannot execute local file</H1>";
	   Munix.write_string stdout "Command \"";
	   Munix.write_string stdout cmd;
	   Munix.write_string stdout "\" failed:";
	   Munix.write_string stdout (Unix.error_message e);
	   Munix.write_string stdout "\n";
	   exit 1
	end
    | n ->
         close cmd_out;
	 let dh = {document_id = document_id wwwr;
		   document_referer = wwwr.www_link.h_context;
		   document_status = 0;
		   document_headers = [];
		   document_feed = Feed.of_fd cmd_in;
		   document_fragment = wwwr.www_fragment;
		   document_logger = tty_logger} in
	  dh.document_feed.feed_schedule
	    (fun () ->
	       try
		 if dh.document_headers = [] then begin
		   (* it should be the HTTP Status-Line *)
		    let l = Munix.read_line cmd_in in
		      dh.document_status <- (parse_status l).status_code;
		      dh.document_headers <- [l] (* keep it there *)
		    end
		  else 
		    dh.document_headers <- 
		      read_headers cmd_in dh.document_headers
	       with
		 End_of_headers ->
		   dh.document_feed.feed_unschedule();
		   cont.document_process dh
	       | Not_found -> (* No HTTP/ header *)
		   dh.document_feed.feed_unschedule();
		   dh.document_status = 200;
	           dh.document_headers <- ["Content-Type: text/plain"];
		   cont.document_process dh
	       | Unix_error(_,_,_) ->
		   dclose true dh;
	           raise (File_error (I18n.sprintf 
		       "Error while reading headers of %s\n%s" path "(read)"))
	       | Invalid_HTTP_header s ->
		   dclose true dh;
		   raise (File_error (I18n.sprintf 
			      "Error while reading headers of %s\n%s" path s))
	       | End_of_file ->
		   dclose true dh;
		   raise (File_error (I18n.sprintf 
			   "Error while reading headers of %s\n%s" path "eof"))
	      )
  with Unix_error(_,_,_) -> 
    raise (File_error (I18n.sprintf "cannot exec file"))

(*
 * Display a file on the local unix file system (file:)
 *  is path really supposed to be absolute ?
 * Note: completely ignores method (GET, POST,...)
 *)
let request wr cont =
  let path = match wr.www_url.path with
    Some path -> "/" ^ (Lexurl.remove_dots path)
  | None -> "/" in
  if !binary_prefix <> "" &
     String.length path > String.length !binary_prefix &
     String.sub path 0 (String.length !binary_prefix) = !binary_prefix then
    (fake_cgi wr cont path;
     (fun () -> ()))
  else   (* A bit weird, but we don't want to capture errors from the cont *)
  let st =
    try stat path 
    with 
      _ -> raise (File_error (I18n.sprintf "cannot stat file")) in
    match st.st_kind with
	S_REG ->
	  let s = 
	     try openfile path [O_RDONLY] 0
	     with Unix_error(_,_,_) -> 
	       raise (File_error (I18n.sprintf "cannot open file")) in
	    cont.document_process
	      {document_id = document_id wr;
	       document_referer = wr.www_link.h_context;
	       document_status = 200;
	       document_headers = [sprintf "Content-Length: %d" st.st_size];
	       document_feed = Feed.of_fd s;
	       document_fragment = wr.www_fragment;
	       document_logger = tty_logger};
            (fun () -> ())
      | S_DIR -> 
	  let s = dir path in
	    cont.document_process 
	      {document_id = document_id wr;
	       document_referer = wr.www_link.h_context;
	       document_status = 200;
	       document_headers = ["Content-Type: text/html"];
	       document_feed = Feed.of_fd s;
	       document_fragment = wr.www_fragment;
      	       document_logger = tty_logger};
            (fun () -> ())

      | _ -> raise (File_error (I18n.sprintf "cannot open file"))
