open Easycgi;;
(* Simple Guestbook cgi to be compiled with OcamlEditor *)
(* 
   cgi file: gb.ml.cgi  
  (You can rename/copy to the name you set for 'cginame' after compiling.)
   source file: gb.ml.ml  

  To modify and recompile, use "New file" link of OcamlEditor,
  Copy & paste & edit the file, put the file name, push "save",
  and then push "save & recompile".

  Note: The source filename must have ".ml.ml" extension for this to work.

  Currently, it simply adds new comment at the top.
  No admin feature, no security 
  (other than simple double post prevention), nothing.

  Use OcamlEditor to Edit/Delete the guestbook.html in place of admin features.
  Modify template portion, and add features as you like.
  
  It reads the template file "gbtemplate.htm" so that the appearance of 
  the guestbook can be changed without recompiling the CGI.
  The header and footer section will be regenerated from the template 
  on each post.

  See the Template file for more detail.

*)

let version = "0.16";;

(* template filename and three markers are fixed *)
let templatename = "gbtemplate.html";;
let initmark = "<!-- End init -->";;
let headermark = "<!-- End header -->";;
let footermark = "<!-- footer -->";;

(*  set default values for essential variables.
    variables starting with 'default_' can be overridden in templatefile  *)
let default_gbname = "guestbool.html";;
let default_gblast = ".ht.gblast";;
let default_cginame = "gb.ml.cgi";;

(* minimum interval next post is allowed in seconds. It MUST be in string *)
let default_waitsec = "20";;
(* message displayed when next post attempt comes in less than 'waitsec' *) 
let default_busymess = "<h1 align=center style=\"color:red\">Guestbook is Busy. Please try again.</h1><h2 align=center><a href=\"GB_gbname_\">Go back to the Guestbook</a></h2><hr>";;
(* message displayed when double post is detected. *)
let default_doublemess = "<h1 align=center style=\"color:red\">Double post! Post data discarded.</h1><h2 align=center><a href=\"GB_gbname_\">Go back to the Guestbook</a></h2><hr>";;

(* runtime variables using SMap. SMap is defined in easycgi.ml *)
let vardat = ref SMap.empty;;
let varadd k v = vardat := SMap.add k v !vardat;;
let var k = try SMap.find k !vardat with Not_found -> "";;

(* helper functions *)

(* find string -> substring -> int -> position *)
let findi s ss start =
  let i = ref start and si = ref start in
  let len = strlen ss in
  if len = 0 then 0 else
    (let c = ss.[0] in
      while (String.sub s !si len) <> ss do
        si := String.index_from s !i c;
        i := !si + 1 
      done; !si)
  ;;

(* parse and reaplace variables in the template string *)
let replace_var s =
  let buf = Buffer.create ((strlen s) + 1024) in
  let si = ref 0 and ei = ref 0 in
  (try while true do
    si := (findi s "GB_" !ei);
    Buffer.add_string buf (slice s !ei !si);
    ei := String.index_from s (!si+3) '_';
    Buffer.add_string buf (var (slice s (!si+3) !ei));
    incr ei;
  done with _ -> ());
  Buffer.add_string buf (slice s !ei 0);
  Buffer.contents buf  ;;

(* main routine *)

let _ = 
(* set some variables used in comment from 'form' input *)
  varadd "version" version;
  varadd "data" (replace (henc (form "data")) "\n" "<br>\n" );
  varadd "name" (henc (form "name"));
  varadd "prevname" (var "name");
  let t = Unix.localtime (Unix.time ()) in
  varadd "datestr"
    (Printf.sprintf "%04d/%02d/%02d %02d:%02d(%02d)" (t.Unix.tm_year+1900)
    t.Unix.tm_mon t.Unix.tm_mday t.Unix.tm_hour t.Unix.tm_min t.Unix.tm_sec);

(* read template file *)
  let template = fileread templatename in
(* get init section from template *)
  let si = ref 0 and ei = ref (find template initmark) in
  let init = slice template 0 !ei in
(* get header section from template *)
  si := !ei + (strlen initmark) + 1;
  ei := (find template headermark) + (strlen headermark) + 1;
  let header = slice template !si !ei in
(* get comment section from template *)
  si := !ei;
  ei := find template footermark;
  let comment = slice template !si !ei in
(* get footer section from template *)
  si := !ei;
  let footer = slice template !si 0 in

(* parse init section and set variables *)
  let le = ref 0 in
  (try while true do
    si := (findi init "\nGB_" !le) + 4 ;
    ei := String.index_from init !si '_';
    le := String.index_from init (!ei+2) '\n';
(*
    Printf.printf "si=%d, ei=%d, le=%d, k=%s, v=%s###<br>\n" 
      !si !ei !le (slice init !si !ei) (slice init (!ei+2) !le);
*)
    varadd (slice init !si !ei) (slice init (!ei+2) !le);
  done with _ -> ());

(* check if necessary variables are set. If not, use default value *)
  if (var "gbname") = "" then varadd "gbname" default_gbname;
  if (var "gblast") = "" then varadd "gblast" default_gblast;
  if (var "cginame") = "" then varadd "cginame" default_cginame;
  if (var "busymess") = "" then 
    varadd "busymess" default_busymess;
  if (var "doublemess") = "" then 
    varadd "doublemess" default_doublemess;
  (try 
     if (int_of_string (var "waitsece")) < 1 then varadd "waitsec" default_waitsec;
    with _ -> varadd "waitsec" default_waitsec);

(* show current guestbook and exit if there is no data input *)
(*  if (var "data") = "" then (
    pr (fileread (var "gbname"));
    exit 0;
  );
*)

(* read current guestbook file and keep only comment portion *)
  let gb = 
    try 
      let s = (fileread (var "gbname")) in
      slice s ( (find s headermark) + (strlen headermark) + 1 ) 
        (find s footermark) 
    with _ -> "" in

(* show Busy screen if last post was made within 'waitsec' seconds *)
  if (Sys.file_exists (var "gbname")) && (((Unix.lstat (var "gbname")).Unix.st_mtime) +. (float_of_string (var "waitsec")))
    > (Unix.time ()) then (
    varadd "prevdata" (henc (form "data"));
    pr (replace_var header);
    pr (replace_var (var "busymess"));
 (*    pr """mtime+waitsec=%(((Unix.lstat (var "gbname")).Unix.st_mtime) +. (float_of_string (var "waitsec")))f , Unix.time=%(Unix.time ())f <br>\n"""; *)
  (*  pr gb; *)
    pr (replace_var footer);
    exit 0;
  );

(* compare the comment data with the one saved last time
       to detect and prevent double post  *)
  let gbl = ref "" in
  (try gbl:= fileread (var "gblast") ;
  with _->  gbl := ""; );
  if (var "data") <> !gbl then (
      let outlast = open_out (var "gblast") in
      output_string outlast (var "data");
      close_out outlast;
  ) else (
    pr (replace_var header);
    pr (replace_var (var "doublemess"));
 (*   pr gb; *)
    pr (replace_var footer);
    exit 0;
  );

(* output new guestbook file replacing variables found in the template *)
  let out = open_out (var "gbname") in
  output_string out (replace_var header);
  if (var "data") <> "" then (
      output_string out (replace_var comment));
  output_string out gb;
  output_string out (replace_var footer);
  close_out out;

(* show the new guestbook to the browser *)
  pr (fileread (var "gbname"));

(* end *)