(* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
(*
    This file is part of mldonkey.

    mldonkey 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.

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

open Int64ops
open Printf2
open CommonResult
open CommonInteractive
open CommonNetwork
open CommonSearch
open CommonTypes
open CommonGlobals
open GuiTypes
open CommonComplexOptions
open CommonFile
open Options
open BasicSocket
open TcpBufferedSocket
open DriverInteractive
open CommonOptions

  
let rec dollar_escape o with_frames s =
  String2.convert false (fun b escaped c ->
      if escaped then
        match c with
        | 'O' -> if with_frames then
              if !!html_mods then Buffer.add_string b "output"
              else Buffer.add_string b " target=\"output\""; 
              false
        | 'S' -> if with_frames then
              if !!html_mods then Buffer.add_string b "fstatus"
              else Buffer.add_string b " target=\"fstatus\"";
              false
        | 'P' -> if with_frames then
              if !!html_mods then Buffer.add_string b "_parent"
              else Buffer.add_string b " target=\"_parent\""; 
              false
        | 'G' -> false
            
        | 'r' ->
            if o.conn_output = ANSI then 
              Buffer.add_string b Terminal.ANSI.ansi_RED;
            false
            
        | 'b' ->
            if o.conn_output = ANSI then 
              Buffer.add_string b Terminal.ANSI.ansi_BLUE;
            false
            
        | 'g' ->
            if o.conn_output = ANSI then
              Buffer.add_string b Terminal.ANSI.ansi_GREEN;
            false
            
        | 'n' ->
            if o.conn_output = ANSI then 
              Buffer.add_string b Terminal.ANSI.ansi_NORMAL;
            false
            
        | _ -> 
(*
            try
              Buffer.add_string b (dollar_escape with_frames
                  (CommonNetwork.escape_char c));
              false
            
            with _ -> *)
                Buffer.add_char b '$'; Buffer.add_char b c; false
      else
      if c = '$' then true else
        (Buffer.add_char b c; false)) s

let eval auth cmd o =
  let buf = o.conn_buf in
  let cmd =
    if String2.check_prefix cmd "ed2k://" then "dllink " ^ cmd
    else if String2.check_prefix cmd "fha://" then "ovlink " ^ cmd
    else cmd in
  let l = String2.tokens cmd in
  match l with
    [] -> ()
  | ["longhelp"] | ["??"] ->
      let module M = CommonMessages in
      Buffer.add_string  buf M.available_commands_are;
      if use_html_mods o then begin
          let counter = ref 0 in
          List.iter (fun (cmd, _, _, help) ->
              incr counter;
              let ncmd = ref cmd in
              let nhelp = ref help in
              Printf.bprintf buf "\\<tr class=\\\"%s\\\"\\>"(if (!counter mod 2 == 0) then "dl-1" else "dl-2";);
              html_mods_td buf [ ("", "sr", !ncmd); ("", "srw", Str.global_replace (Str.regexp "\n") "\\<br\\>" !nhelp) ];
              Printf.bprintf buf "\\</tr\\>\n";
          ) 
          (List.sort (fun (c1,_, _,_) (c2,_, _,_) -> compare c1 c2)
            !CommonNetwork.network_commands);
          Printf.bprintf buf "\\</table\\>\\</div\\>"
        end else        
        begin
          let list = Hashtbl2.to_list2 commands_by_kind in
          let list = List.sort (fun (s1,_) (s2,_) -> compare s1 s2) list in
          List.iter (fun (s,list) ->
              Printf.bprintf buf "\n   $b%s$n:\n" s;
              let list = List.sort (fun (s1,_) (s2,_) -> compare s1 s2) !list in
              List.iter (fun (cmd, help) ->
                  Printf.bprintf buf "$r%s$n %s\n" cmd help;
              ) list
          ) list;
        end 
        
    | ["help"] | ["?"] ->
          let module M = CommonMessages in
          Buffer.add_string  buf
            "Main commands are:

$bServers:$n
          $rvm$n : list connected servers
          $rvma$n : list all servers
          $rc/x <num>$n : connect/disconnect from a server

$bDownloads:$n
          $rvd$n : view current downloads
          $rcancel/pause/resume <num>$n : cancel/pause/resume download <num>

$bSearches:$n
          $rs  <keywords>$n : start a search for keywords <keywords> on the network
          $rvr$n : view results of the last search
          $rd <num>$n : download result number <num>
          $rvs$n : view previous searches
          $rvr <num>$n : view results of search <num>

$bGeneral:$n
          $rsave$n : save configuration files
          $rkill$n : kill mldonkey properly
          $rq$n : quit this interface

Use '$r";
           if o.conn_output = HTML then
             Buffer.add_string buf "\\<a href=\\\"submit?q=longhelp\\\"\\>";
           Buffer.add_string buf "longhelp";
           if o.conn_output = HTML then
             Buffer.add_string buf "\\</a\\>";
           Buffer.add_string buf "$n' or '$r";
           if o.conn_output = HTML then
             Buffer.add_string buf "\\<a href=\\\"submit?q=longhelp\\\"\\>";
           Buffer.add_string buf "??";
           if o.conn_output = HTML then
             Buffer.add_string buf "\\</a\\>";
           Buffer.add_string buf "$n' for all commands.
Use '$rhelp command$n' or '$r? command$n' for help on a command.
            ";
    | "?" :: args | "help" :: args ->
          List.iter (fun arg ->
              List.iter (fun (cmd, _, _, help) ->
                  if cmd = arg then    
                    Printf.bprintf  buf "%s %s\n" cmd help) 
              !CommonNetwork.network_commands)
          args
    | cmd :: args ->
      if cmd = "q" then
        raise CommonTypes.CommandCloseSocket
      else
      if cmd = "auth" then
        let user, pass =
          match args with
            [] -> failwith "Usage: auth <user> <password>"
          | [s1] -> "admin", s1
          | user :: pass :: _ -> user, pass
        in
        if valid_password user pass then begin
            auth := true;
            o.conn_user <- find_ui_user user;
            let module M = CommonMessages in
            Buffer.add_string buf M.full_access
          end else 
        let module M = CommonMessages in
        Buffer.add_string buf M.bad_login
      else
      if !auth then
        DriverCommands.execute_command 
          !CommonNetwork.network_commands o cmd args      
      else
      let module M = CommonMessages in
      Buffer.add_string buf M.command_not_authorized

              
(* This function is called every hour to check if we have something to do 
just now *)
        
let calendar_options = {
    conn_buf = Buffer.create 1000;
    conn_output = TEXT;
    conn_sortvd = NotSorted;
    conn_filter = (fun _ -> ());
    conn_user = default_user;
    conn_width = 80; conn_height = 0;
  }
      
let check_calendar () =
  let time = last_time () in
  let tm = Unix.localtime (date_of_int time) in
  List.iter (fun (days, hours, command) ->
      if (List.mem tm.Unix.tm_wday days || days = [])  &&
        (List.mem tm.Unix.tm_hour hours || hours = []) then begin
          eval (ref true) command calendar_options;
          lprintf "Calendar execute: %s\n%s\n" command
            (Buffer.contents calendar_options.conn_buf);
          Buffer.clear calendar_options.conn_buf;          
        end
  ) !!calendar
  

(*************************************************************

                  The Telnet Server
  
**************************************************************)  

let before_telnet_output o sock = 
  if o.conn_output = ANSI && o.conn_height <> 0 then
    write_string sock (Printf.sprintf 
        "%s%s\n%s%s" 
        (Terminal.gotoxy 0 (o.conn_height-3))
      Terminal.ANSI.ansi_CLREOL
      Terminal.ANSI.ansi_CLREOL
      (Terminal.gotoxy 0 (o.conn_height-3)))
  
let after_telnet_output o sock = 
  if o.conn_output = ANSI && o.conn_height <> 0 then
    write_string sock (Printf.sprintf "\n\n%s"
        (Terminal.gotoxy 0 (o.conn_height - 2)));
  if o.conn_output = ANSI then
    write_string sock (Printf.sprintf "%sMLdonkey command-line:%s\n> "
      Terminal.ANSI.ansi_REVERSE
      Terminal.ANSI.ansi_NORMAL)
  
(*  
let user_reader o telnet sock nread  = 
  let b = TcpBufferedSocket.buf sock in
  let end_pos = b.pos + b.len in
  let new_pos = end_pos - nread in
  let rec iter i =
    let end_pos = b.pos + b.len in
    for i = b.pos to b.pos + b.len - 1 do
      let c = int_of_char b.buf.[i] in
      if c <> 13 && c <> 10 && (c < 32 || c > 127) then
        lprintf "term[%d] = %d\n" i c;
    done;
    
    if i < end_pos then
      let c = b.buf.[i] in
      let c = int_of_char c in
      if c = 13 || c = 10 || c = 0 then
        let len = i - b.pos  in
        let cmd = String.sub b.buf b.pos len in
        buf_used sock (len+1);
        if cmd <> "" then begin
            before_telnet_output o sock;
            let buf = o.conn_buf in
            Buffer.clear buf;
            if o.conn_output = ANSI then Printf.bprintf buf "> $b%s$n\n" cmd;
            eval telnet.telnet_auth cmd o;
            Buffer.add_char buf '\n';
            if o.conn_output = ANSI then Buffer.add_string buf "$n";
            TcpBufferedSocket.write_string sock 
              (dollar_escape o false (Buffer.contents buf));
            after_telnet_output o sock;
          end;
        iter b.pos
       else
         iter (i+1)
  in
  try
    iter new_pos
  with
  | CommonTypes.CommandCloseSocket ->
    (try
       shutdown sock "user quit";
     with _ -> ());
  | e -> 
      before_telnet_output o sock;
      TcpBufferedSocket.write_string sock
        (Printf.sprintf "exception [%s]\n" (Printexc2.to_string e));
      after_telnet_output o sock
        *)

type telnet_state =
  EMPTY
| STRING
| IAC
| WILL
| WONT
| DO
| DONT
| NAWS
| SB

type telnet_conn = {
    telnet_buffer : Buffer.t;
    mutable telnet_iac : bool;
    mutable telnet_wait : int;
    telnet_auth : bool ref;
  }


let iac_will_naws = "\255\253\031"  
  
let user_reader o telnet sock nread  = 
  let b = TcpBufferedSocket.buf sock in
  let end_pos = b.pos + b.len in
  let new_pos = end_pos - nread in
  let rec iter () =
    if b.len > 0 then
      let c = b.buf.[b.pos] in
      buf_used b 1;
(*      lprintf "char %d\n" (int_of_char c); *)
      if c = '\255' && not telnet.telnet_iac then begin
          telnet.telnet_iac <- true;
          iter ()
        end else
      if c <> '\255' && telnet.telnet_iac then begin
          telnet.telnet_iac <- false;
          (match c with
              '\250' | '\251' -> 
                Buffer.add_char telnet.telnet_buffer c;                
                telnet.telnet_wait <- 1
            | _ -> 
                Buffer.clear telnet.telnet_buffer
          );
          iter ()
        end else
      
      let i = int_of_char c in
      telnet.telnet_iac <- false;
      let is_normal_char = i > 31 && i < 127 in
      
      if telnet.telnet_wait = 1 then begin
          Buffer.add_char telnet.telnet_buffer c;
          let cmd = Buffer.contents telnet.telnet_buffer in
          telnet.telnet_wait <- 0;
          let len = String.length cmd in
          if len = 2 then
            match cmd with
              "\251\031" -> 
                Buffer.clear telnet.telnet_buffer
            | "\250\031" -> 
                telnet.telnet_wait <- 4
            | _ -> 
                (*
                lprintf "telnet server: Unknown control sequence %s\n"
                  (String.escaped cmd);                *)
                Buffer.clear telnet.telnet_buffer
          else
          let s = String.sub cmd 0 2 in
          Buffer.clear telnet.telnet_buffer;
          match s with
          | "\250\031" -> 
              let dx = BigEndian.get_int16 cmd 2 in
              let dy = BigEndian.get_int16 cmd 4 in
              o.conn_width <- dx;
              o.conn_height <- dy;
(*              lprintf "SIZE RECEIVED %d x %d\n" dx dy; *)
          | _ -> 
              (*
              lprintf "telnet server: Unknown control sequence %s\n"
              (String.escaped cmd); *)
              ()
        end else 
      if telnet.telnet_wait > 1 then begin
          Buffer.add_char telnet.telnet_buffer c;
          telnet.telnet_wait <- telnet.telnet_wait - 1;
        end else
      if is_normal_char then 
        Buffer.add_char telnet.telnet_buffer c
      else begin
(* evaluate the command *)
          let cmd = Buffer.contents telnet.telnet_buffer in
          Buffer.clear telnet.telnet_buffer;
          if cmd <> "" then begin
              before_telnet_output o sock;
              let buf = o.conn_buf in
              Buffer.clear buf;
              if o.conn_output = ANSI then Printf.bprintf buf "> $b%s$n\n" cmd;
              eval telnet.telnet_auth cmd o;
              Buffer.add_char buf '\n';
              if o.conn_output = ANSI then Buffer.add_string buf "$n";
              TcpBufferedSocket.write_string sock 
                (dollar_escape o false (Buffer.contents buf));
              after_telnet_output o sock;
            end;
          if i = 255 then telnet.telnet_wait <- 2;
        end;
      iter ()
  in
  try
    iter ()
  with
  | CommonTypes.CommandCloseSocket ->
    (try
       shutdown sock Closed_by_user;
     with _ -> ());
  | e -> 
      before_telnet_output o sock;
      TcpBufferedSocket.write_string sock
        (Printf.sprintf "exception [%s]\n" (Printexc2.to_string e));
      after_telnet_output o sock

  
let user_closed sock  msg =
  user_socks := List2.removeq sock !user_socks;
  ()

(* Here, we clearly need a good html parser to remove tags, and to translate
special characters. Avoid them in the meantime. *)
let text_of_html html = 
  String2.convert false (fun buf state c -> 
    if state then
      c <> '>' 
    else 
      if c = '<' then true else begin
	Buffer.add_char buf c;
	false
      end
) html
  
let telnet_handler t event = 
  match event with
    TcpServerSocket.CONNECTION (s, Unix.ADDR_INET (from_ip, from_port)) ->
      let from_ip = Ip.of_inet_addr from_ip in
      if Ip.matches from_ip !!allowed_ips then 
        let token = create_token unlimited_connection_manager in
        let sock = TcpBufferedSocket.create_simple token
          "telnet connection"
          s in
        let telnet = {
            telnet_auth = ref (empty_password "admin");
            telnet_iac = false;
            telnet_wait = 0;
            telnet_buffer = Buffer.create 100;
          } in
        let o = {
            conn_buf = Buffer.create 1000;
            conn_output = (if !!term_ansi then ANSI else TEXT);
            conn_sortvd = NotSorted;
            conn_filter = (fun _ -> ());
            conn_user = default_user;
            conn_width = 80; 
            conn_height = 0;
          } in
        TcpBufferedSocket.prevent_close sock;
        TcpBufferedSocket.set_max_output_buffer sock !!interface_buffer;
        TcpBufferedSocket.set_reader sock (user_reader o telnet);
        TcpBufferedSocket.set_closer sock user_closed;
        user_socks := sock :: !user_socks;

        TcpBufferedSocket.write_string sock iac_will_naws;

        before_telnet_output o sock;
        TcpBufferedSocket.write_string sock (text_of_html !!motd_html);

        TcpBufferedSocket.write_string sock (dollar_escape o false
            "\n$bWelcome on mldonkey command-line$n\n\nUse $r?$n for help\n\n");
        
        after_telnet_output o sock
      else 
        Unix.close s

  | _ -> ()

(*************************************************************

                  The Chat Server
  
**************************************************************)  

let chat_handler t event = 
  match event with
    TcpServerSocket.CONNECTION (s, Unix.ADDR_INET (from_ip, from_port)) ->
      (
        try
          let o = {
              conn_buf = Buffer.create 1000;
              conn_output = TEXT;
              conn_sortvd = NotSorted;
              conn_filter = (fun _ -> ());
              conn_user = default_user;
              conn_width = 80; conn_height = 0;
            } in
          
	 let from_ip = Ip.of_inet_addr from_ip in
	 if Ip.matches from_ip !!allowed_ips then 
	   (
	    let chanin = Unix.in_channel_of_descr s in
	    let chanout = Unix.out_channel_of_descr s in
	    let paq = Chat_proto.read_packet_channel chanin in
	    let ret = 
	      match paq with
		((v,id,(host,port)),iddest,pro) ->
		  if v <> CommonChat.version then 
		    None
		  else
		    Some paq
	    in
	    close_out chanout;
	    (match ret with
	      None -> ()
	    | Some ((v,id,(host,port)),iddest,pro) ->
		match pro with
		  Chat_proto.Hello ->
		    CommonChat.send_hello_ok ()
		| Chat_proto.HelloOk -> ()
		| Chat_proto.AddOpen _ -> ()
		| Chat_proto.Byebye -> ()
		| Chat_proto.RoomMessage _ ->
		    (* A VOIR *)
		    ()
		| Chat_proto.Message s ->
		    if iddest = !!CommonOptions.chat_console_id then
		   (* we must eval the string as a command *)
		      (
                            let buf = o.conn_buf in
                            Buffer.clear buf;
		       let auth = ref true in
		       eval auth s o;
		       CommonChat.send_text !!CommonOptions.chat_console_id None 
			 (dollar_escape o false (Buffer.contents buf));
		       Buffer.reset buf
		      )
		    else
		   (* we must forward the message *)
                      (networks_iter (fun r ->
			network_private_message r iddest s)
                      )
	    )
	   )
	 else 
           Unix.close s
     with
       Failure mess ->
	 lprintf "%s\n" mess;
	 Unix.close s
    )
  | _ ->
      ()

(*************************************************************

                  The HTTP Server
  
**************************************************************)  

let buf = Buffer.create 1000
      
let html_page = ref true  

open Http_server

let get_theme_page page =
	let theme = Filename.concat html_themes_dir !!html_mods_theme in
	let fname = Filename.concat theme page in fname

let theme_page_exists page = 
	if Sys.file_exists (get_theme_page page) then true else false 

(* if files are small really_input should be okay *)
let read_theme_page page =
	let theme_page = get_theme_page page in
	let file = open_in theme_page in
	let size = (Unix.stat theme_page).Unix.st_size in
	let s = String.make size ' ' in
	let ok = really_input file s 0 size in
	close_in file; s
  
let add_simple_commands buf =
  let this_page = "commands.html" in
  Buffer.add_string buf (
    if !!html_mods_theme != "" && theme_page_exists this_page then
      read_theme_page this_page else
    if !!html_mods then !!CommonMessages.web_common_header_mods0
    else !!CommonMessages.web_common_header_old)
  
let http_add_gen_header r =
  add_reply_header r "Server" "MLdonkey";
  add_reply_header r "Connection" "close"

let add_gzip_headers r =
  if Autoconf.has_zlib && !!html_use_gzip then begin
    add_reply_header r "Content-Encoding" "gzip";
    add_reply_header r "Vary" "Accept-Encoding";
  end 

let http_add_html_header r = 
  http_add_gen_header r;
  add_reply_header r "Pragma" "no-cache";
  add_reply_header r "Content-Type" "text/html; charset=iso-8859-1";
  add_gzip_headers r

let http_add_css_header r = 
  http_add_gen_header r;
  add_reply_header r "Content-Type" "text/css; charset=iso-8859-1";
  add_gzip_headers r

let http_add_js_header r =
  http_add_gen_header r;
  add_reply_header  r "Content-Type" "text/javascript; charset=iso-8859-1";
  add_gzip_headers r
  
let any_ip = Ip.of_inet_addr Unix.inet_addr_any
  
let html_open_page buf t r open_body =
  Buffer.clear buf;
  html_page := true;
  http_add_html_header r;
  
  if not !!html_mods then 
    (Buffer.add_string buf
      "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\" 
        \"http://www.w3.org/TR/html4/frameset.dtd\">\n<HTML>\n<HEAD>\n";)
    else Buffer.add_string buf "<html>\n<head>\n";
  
  if !CommonInteractive.display_vd then begin
	let this_page = "dheader.html" in 
      Buffer.add_string buf 
        (
		if !!html_mods_theme != "" && theme_page_exists this_page then
			read_theme_page this_page else
			if !!html_mods then !!CommonMessages.download_html_header_mods0 
			else !!CommonMessages.download_html_header_old);
      Printf.bprintf buf "<meta http-equiv=Refresh
          content=\"%d\">" !!vd_reload_delay;
    end else 
	let this_page = "header.html" in
    Buffer.add_string buf (
		if !!html_mods_theme != "" && theme_page_exists this_page then
			read_theme_page this_page else
			if !!html_mods then !!CommonMessages.html_header_mods0
			else !!CommonMessages.html_header_old);
  
  Buffer.add_string buf "</head>\n";
  if open_body then Buffer.add_string buf "<body>\n";    
  if not !!use_html_frames then add_simple_commands buf;
  ()
  
let html_close_page buf =
  Buffer.add_string buf "</body>\n";  
  Buffer.add_string buf "</html>\n";
  ()

let clear_page buf =
  Buffer.clear buf;
  html_page := false
  
let http_handler o t r =
  CommonInteractive.display_vd := false;
  clear_page buf;
  
  let user = if r.options.login = "" then "admin" else r.options.login in
  if not (valid_password user r.options.passwd) then begin
      clear_page buf;
      need_auth r !!http_realm
    end
  else
    begin
      let user = find_ui_user user  in
      let o = match user.ui_http_conn with
          Some oo -> oo.conn_buf <- o.conn_buf; oo
        | None -> let oo = { o with conn_user = user } in
            user.ui_http_conn <- Some oo; oo
      in
      try
        match r.get_url.Url.short_file with
        | "/wap.wml" ->
            begin
              clear_page buf;
              add_reply_header r "Server" "MLdonkey";
              add_reply_header r "Connection" "close";
              add_reply_header r "Content-Type" "text/vnd.wap.wml";
              let dlkbs = 
                (( (float_of_int !udp_download_rate) +. (float_of_int !control_download_rate)) /. 1024.0) in
              let ulkbs =
                (( (float_of_int !udp_upload_rate) +. (float_of_int !control_upload_rate)) /. 1024.0) in 
              Printf.bprintf buf "
<?xml version=\"1.0\"?>
<!DOCTYPE wml PUBLIC \"-//WAPFORUM//DTD WML 1.1//EN\" \"http://www.wapforum.org/DTD/wml_1.1.xml\">

<wml>
<card id=\"main\" title=\"MLDonkey Index Page\">  ";
(* speed *)
              Printf.bprintf buf "<p align=\"left\">
   <small>
    DL %.1f KB/s (%d|%d) UL: %.1f KB/s (%d|%d)
   </small>
</p>" dlkbs !udp_download_rate !control_download_rate ulkbs !udp_upload_rate !control_upload_rate;


(* functions *)
              List.iter (fun (arg, value) ->
                  match arg with
                    "VDC" -> 
                      let num = int_of_string value in
                      let file = file_find num in
                      file_cancel file
                  | "VDP" -> 
                      let num = int_of_string value in
                      let file = file_find num in
                      file_pause file
                  | "VDR" -> 
                      let num = int_of_string value in
                      let file = file_find num in
                      file_resume file
                  | _ -> ()
              ) r.get_url.Url.args;

(* downloads *)
              Printf.bprintf buf "<p align=\"left\"><small>";
              let mfiles = List2.tail_map file_info !!files in
              List.iter (fun file ->
                  Printf.bprintf buf  "<a href=\"wap.wml?%s=%d\">%s</a> <a href=\"wap.wml?VDC=%d\">C</a> [%-5d] %5.1f %s %s/%s <br />" (if downloading file then "VDP" else "VDR" ) (file.file_num) (if downloading file then "P" else "R" ) (file.file_num) (file.file_num) (file.file_download_rate /. 1024.)(short_name file) (print_human_readable file (Int64.sub file.file_size file.file_downloaded)) (print_human_readable file file.file_size);
              
              ) mfiles;
              Printf.bprintf buf "<br />Downloaded %d/%d files " (List.length !!done_files) (List.length !!files);
              Printf.bprintf buf "</small></p>";
              
              
              Printf.bprintf buf "</card></wml>";
            end	
        | "/commands.html" ->
            html_open_page buf t r true;
            let this_page = "commands.html" in 
            Buffer.add_string buf (
              if !!html_mods_theme != "" && theme_page_exists this_page then
                read_theme_page this_page else
              if !!html_mods then !!CommonMessages.web_common_header_mods0
              else !!CommonMessages.web_common_header_old)
        | "/" | "/index.html" -> 
            if !!use_html_frames then begin
                html_open_page buf t r false;
                let this_page = "frames.html" in 
                if !!html_mods_theme != "" && theme_page_exists this_page then
                  Buffer.add_string buf (read_theme_page this_page) else
                if !!html_mods then
                  Printf.bprintf buf "
			 <frameset src=\"index\" rows=\"%d,25,*\">
                  <frame name=\"commands\" NORESIZE SCROLLING=\"NO\" NOSHADE marginwidth=0 marginheight=0 BORDER=0 FRAMESPACING=0 FRAMEBORDER=0 src=\"commands.html\">
                  <frame name=\"fstatus\" NORESIZE SCROLLING=\"NO\" NOSHADE marginwidth=0 marginheight=0 BORDER=0 FRAMESPACING=0 FRAMEBORDER=0 src=\"noframe.html\">
               <frame name=\"output\" NORESIZE NOSHADE marginwidth=0 marginheight=0 BORDER=0 FRAMESPACING=0 FRAMEBORDER=0 src=\"oneframe.html\">
            </frameset>" !!commands_frame_height
                else
                  Printf.bprintf buf "
            <frameset src=\"index\" rows=\"%d,2*\">
               <frameset src=\"index\" cols=\"5*,1*\">
                  <frame name=\"commands\" src=\"commands.html\">
                  <frame name=\"fstatus\" src=\"noframe.html\">
               </frameset>
               <frame name=\"output\" src=\"oneframe.html\">
            </frameset>" !!commands_frame_height; 
              end else
              html_open_page buf t r true
        | "/complex_search.html" ->
            html_open_page buf t r true;
            CommonSearch.complex_search buf
        | "/noframe.html" -> 
            html_open_page buf t r true
        
        | "/oneframe.html" ->
            html_open_page buf t r true;
            Buffer.add_string buf !!motd_html
        
        | "/filter" ->
            html_open_page buf t r true;
            let b = Buffer.create 10000 in 
            let filter = ref (fun _ -> ()) in
            begin              
              match r.get_url.Url.args with
                ("num", num) :: args ->
                  List.iter (fun (arg, value) ->
                      match arg with
                      | "media" -> 
                          let old_filter = !filter in
                          filter := (fun r ->
                              if r.result_type = value then raise Not_found;
                              old_filter r
                          )
                      | "format" -> 
                          let old_filter = !filter in
                          filter := (fun r ->
                              if r.result_format = value then raise Not_found;
                              old_filter r
                          )
                      | "size" -> 
                          let old_filter = !filter in
                          let mega5 = Int64.of_int (5 * 1024 * 1024) in
                          let mega20 = Int64.of_int (20 * 1024 * 1024) in
                          let mega400 = Int64.of_int (400 * 1024 * 1024) in
                          let min, max = match value with
                              "0to5" -> Int64.zero, mega5
                            | "5to20" -> mega5, mega20
                            | "20to400" -> mega20, mega400
                            | "400+" -> mega400, Int64.max_int
                            | _ -> Int64.zero, Int64.max_int
                          in
                          filter := (fun r ->
                              if r.result_size >= min && 
                                r.result_size <= max then
                                raise Not_found;
                              old_filter r
                          )
                      | _ -> ()
                  )  args;
                  
                  let num = int_of_string num in
                  let s = search_find num in
                  
                  DriverInteractive.print_search b s
                    { o with conn_filter = !filter };
                  
                  Buffer.add_string buf (html_escaped 
                      (Buffer.contents b))
              
              | _ -> 
                  Buffer.add_string buf "Bad filter"
            end
        
        
        | "/results" ->
            html_open_page buf t r true;
            let b = Buffer.create 10000 in
            List.iter (fun (arg, value) ->
                match arg with
                  "d" -> begin
                      try
                        let num = int_of_string value in 
                        let r = find_result num in
                        let files = result_download r [] false in
                        List.iter CommonInteractive.start_download files;
                        
                        let module M = CommonMessages in
                        Gettext.buftext buf M.download_started num
                      with  e -> 
                          Printf.bprintf buf "Error %s with %s<br>" 
                            (Printexc2.to_string e) value;
                    end
                | _ -> ()
            ) r.get_url.Url.args;
            Buffer.add_string buf (html_escaped (Buffer.contents b))
        
        
        | "/files" ->
            
            List.iter (fun (arg, value) ->
                match arg with
                  "cancel" -> 
                    let num = int_of_string value in
                    let file = file_find num in
                    file_cancel file
                | "pause" -> 
                    let num = int_of_string value in
                    let file = file_find num in
                    file_pause file
                | "resume" -> 
                    let num = int_of_string value in
                    let file = file_find num in
                    file_resume file
                | "sortby" -> 
                    begin
                      match value with
                      | "Percent" -> o.conn_sortvd <- ByPercent
                      | "%" -> o.conn_sortvd <- ByPercent
                      | "File" -> o.conn_sortvd <- ByName
                      | "Downloaded" -> o.conn_sortvd <- ByDone
                      | "DLed" -> o.conn_sortvd <- ByDone
                      | "Size" -> o.conn_sortvd <- BySize
                      | "Rate" -> o.conn_sortvd <- ByRate
                      | "ETA" -> o.conn_sortvd <- ByETA
                      | "Priority" -> o.conn_sortvd <- ByPriority
                      | "Age" -> o.conn_sortvd <- ByAge
                      | "Last" -> o.conn_sortvd <- ByLast
                      | "Srcs" -> o.conn_sortvd <- BySources
                      | "A" -> o.conn_sortvd <- ByASources
                      | "N" -> o.conn_sortvd <- ByNet
                      | "Avail" -> o.conn_sortvd <- ByAvail
                      | _ -> ()
                    end
                | _ -> ()
            ) r.get_url.Url.args;
            let b = Buffer.create 10000 in
            
            DriverInteractive.display_file_list b o;
            html_open_page buf t r true;
            Buffer.add_string buf (html_escaped (Buffer.contents b))
        
        | "/submit" ->
            begin
              match r.get_url.Url.args with
              | ("q", cmd) :: other_args ->
                  List.iter (fun arg ->
                      match arg with
                      | "sortby", "size" -> o.conn_sortvd <- BySize
                      | "sortby", "name" -> o.conn_sortvd <- ByName
                      | "sortby", "rate" -> o.conn_sortvd <- ByRate
                      | "sortby", "done" -> o.conn_sortvd <- ByDone
                      | "sortby", "percent" -> o.conn_sortvd <- ByPercent
                      | "sortby", "priority" -> o.conn_sortvd <- ByPriority
                      | _ -> ()
                  ) other_args;
                  let s = 
                    let b = o.conn_buf in
                    clear_page b;
                    eval (ref true) cmd o;
                    html_escaped (Buffer.contents b)
                  in
                  html_open_page buf t r true;

(* Konqueror doesn't like html within <pre> *)
                  let drop_pre = ref false in
                  let rawcmd = ref cmd in
                  
                  if String.contains cmd ' ' then
                    rawcmd := String.sub cmd 0 (String.index cmd ' ');
                  
                  (match !rawcmd with 
                    | "vm" | "vma" | "view_custom_queries"  | "xs" | "vr"
                    | "afr" | "friend_remove" | "reshare" | "recover_temp"
                    | "c" | "commit" | "bw_stats" | "ovweb" | "friends"
                    | "message_log" | "friend_add" | "remove_old_servers"
                    | "downloaders" | "uploaders" | "scan_temp" | "cs"
                    | "version" | "rename" | "force_download" | "close_fds"
                    | "vd" | "vo" | "voo" | "upstats" | "shares" | "share"
                    | "unshare" -> drop_pre := true;
                    | _ -> ());
                  
                  Printf.bprintf buf "%s\n" 
                    (if use_html_mods o && !drop_pre then s else "\n<pre>\n" ^ s ^ "</pre>");
              
              | [ ("custom", query) ] ->
                  html_open_page buf t r true;
                  CommonSearch.custom_query buf query
              
              | ("custom", query) :: args ->
                  html_open_page buf t r true;
                  send_custom_query o.conn_user buf query  args
              
              | [ "setoption", _ ; "option", name; "value", value ] ->
                  html_open_page buf t r true;
                  CommonInteractive.set_fully_qualified_options name value;
                  Buffer.add_string buf "Option value changed"
              
              | args -> 
                  List.iter (fun (s,v) ->
                      lprintf "[%s]=[%s]" (String.escaped s) (String.escaped v);
                      lprint_newline ()) args;
                  
                  raise Not_found
            end
        
        | "/preview_download" ->
            begin
              clear_page buf;
              match r.get_url.Url.args with
                ["q", file_num] ->
                  let file_num = int_of_string file_num in
                  let file = file_find file_num in
                  let fd = file_fd file in
                  let size = file_size file in
                  
                  let (begin_pos, end_pos) = 
                    try
                      let (begin_pos, end_pos) = request_range r in
                      let end_pos = match end_pos with
                          None -> size
                        | Some end_pos -> end_pos in
                      let range_size = end_pos -- begin_pos in
                      add_reply_header r "Content-Length"
                        (Int64.to_string range_size);                      
                      add_reply_header r "Content-Range" 
                        (Printf.sprintf "bytes %Ld-%Ld/%Ld"
                          begin_pos (end_pos -- one)
                        size);
                      r.reply_head <- "206 Partial Content";
                      begin_pos, end_pos
                    with _ ->
                        add_reply_header r "Content-Length"
                          (Int64.to_string size);
                        zero, size
                  in
                  
                  add_reply_header r "Content-type" "application/binary";
                  add_reply_header r "Accept-Ranges" "bytes";

                  let s = String.create 200000 in
                  set_max_output_buffer r.sock (String.length s);
                  set_rtimeout r.sock 10000.;                  
                  let rec stream_file file pos sock =
                    let max = (max_refill sock) - 1 in
                    if max > 0 && !pos < end_pos then
                      let max64 = min (end_pos -- !pos) (Int64.of_int max)  in
                      let max = Int64.to_int max64 in
                      Unix32.read fd !pos s 0 max;
                      pos := !pos ++ max64;
                      set_lifetime sock 60.;
(*                      lprintf "HTTPSEND: refill %d %Ld\n" max !pos;*)
(*                    lprintf "HTTPSEND: [%s]\n" (String.escaped 
                        (String.sub s 0 max)); *)
                      write sock s 0 max;
                      if output_buffered sock = 0 then begin
(*                          lprintf "Recursing STREAM\n"; *)
                          stream_file file pos sock
                        end
                  in
                  r.reply_stream <- Some (stream_file file (ref begin_pos))
                  
              | args -> 
                  List.iter (fun (s,v) ->
                      lprintf "[%s]=[%s]" (String.escaped s) (String.escaped v);
                      lprint_newline ()) args;
                  
                  raise Not_found                  
            end
            
        | "/h.css" ->
            clear_page buf;
            http_add_css_header r;
            let this_page = "h.css" in
            Buffer.add_string buf (
              if !!html_mods_theme != "" && theme_page_exists this_page then
                read_theme_page this_page else
              if !!html_mods then !CommonMessages.html_css_mods
              else !!CommonMessages.html_css_old)
        
        | "/dh.css" ->          
            clear_page buf;
            http_add_css_header r;
            let this_page = "dh.css" in
            Buffer.add_string buf (
              if !!html_mods_theme != "" && theme_page_exists this_page then
                read_theme_page this_page else
              if !!html_mods then !CommonMessages.download_html_css_mods
              else !!CommonMessages.download_html_css_old)
        
        | "/i.js" ->
            clear_page buf;
            http_add_js_header r;
            let this_page = "i.js" in
            Buffer.add_string buf (
              if !!html_mods_theme != "" && theme_page_exists this_page then
                read_theme_page this_page else
              if !!html_mods then !!CommonMessages.html_js_mods0
              else !!CommonMessages.html_js_old)
        
        | "/di.js" ->          
            clear_page buf;
            http_add_js_header r;
            let this_page = "di.js" in
            Buffer.add_string buf (
              if !!html_mods_theme != "" && theme_page_exists this_page then
                read_theme_page this_page else
              if !!html_mods then !!CommonMessages.download_html_js_mods0
              else !!CommonMessages.download_html_js_old)
        | cmd ->
            html_open_page buf t r true;
            Printf.bprintf buf "No page named %s" (html_escaped cmd)
      with e ->
          Printf.bprintf buf "\nException %s\n" (Printexc2.to_string e);
          r.reply_stream <- None
    end;
  
  if !html_page then  html_close_page buf;
  let s = Buffer.contents buf in
  let s = dollar_escape o !!use_html_frames s in
  r.reply_content <- if Autoconf.has_zlib && !!html_use_gzip then Autoconf.zlib__gzip_string s else s
        
let http_options = { 
    conn_buf = Buffer.create 10000;
    conn_output = HTML;
    conn_sortvd = NotSorted;
    conn_filter = (fun _ -> ());
    conn_user = default_user;
    conn_width = 80; conn_height = 0;
  }      
  
let create_http_handler () = 
  let config = {
      bind_addr = Ip.to_inet_addr !!http_bind_addr ;
      port = !!http_port;
      requests = [];
      addrs = !!allowed_ips;
      base_ref = "";
      default = http_handler http_options;      
    } in
  option_hook allowed_ips (fun _ -> config.addrs <- !!allowed_ips);
  let sock = find_port "http server" !!http_bind_addr http_port
      (Http_server.handler config) in
  config.port <- !!http_port
  
