open Easycgi;;

let oced_version = "2.45";;

let script = if (env "REDIRECT_URL") <> "" then env "REDIRECT_URL" else script;;

let dbg = false;;

let allowall = true;;
      
let dirname p = if Sys.file_exists p && is_dir p 
      then p else Filename.dirname p ;;

let rec rdirname p = if Sys.file_exists p && is_dir p then p 
     else ( let pp =Filename.dirname p in rdirname pp) ;;

let safedirname p = 
    if allowall || (find p home) = 0 then dirname p else home;;

let formcwd = form "cwd" ;;
let fn = ref (form "fn");;
let tmpfn = !fn;;
let fn_isabs = !fn <> "" && !fn.[0] = '/';;

if dbg then pr( (henc tmpfn) ^ " tmpfn###<BR>");;
  
let tmpabsfn = 
    if fn_isabs then !fn else
      if formcwd = "" then  path_join cwd !fn
      else if formcwd.[0] <> '/' then path_join (path_join cwd formcwd) !fn
           else path_join formcwd !fn  ;;

if dbg then pr( (henc tmpabsfn) ^ " tmpabsfn###<BR>");;
(*
let absfn = if Sys.file_exists tmpabsfn then tmpabsfn else safedirname tmpabsfn;;
*)
let absfn = tmpabsfn;;
let itexists = Sys.file_exists absfn;;

if dbg then pr( (henc absfn) ^ " absfn###<BR>");;
let cmd = form "cmd";;
    
let fcwd = if itexists && (is_dir absfn) then (fn := ""; absfn) 
      else (fn := (Filename.basename absfn); Filename.dirname absfn );;
let fcwdexists = Sys.file_exists fcwd;;
let safecwd =safedirname fcwd;;
        
if dbg then if itexists && (is_dir absfn) then (pre "is_dir absfn true") 
      else pr ((henc (Filename.basename absfn)) ^ " basename##<<br>" );;
if dbg then pr( (henc fcwd) ^ " fcwd### ");;
if dbg then pr( (henc !fn) ^ " !fn###<BR>");;

let hfcwd = henc fcwd and efcwd = encode fcwd;;
let hscript = henc script and escript = encode script;;

let ct = ref (form "ct")
let hfn = henc !fn;;
let efn = encode !fn;;

let habsfn = henc absfn;;
let eabsfn = encode absfn;;
let itsdir = try is_dir absfn with _ -> false;;
let itsfile = try is_file absfn with _ -> false;;

let epr = (fun s -> pr (encode s));;
let hpr = (fun s -> pr (henc s));;
  
if dbg then pr( habsfn ^ " ### " ^ hfn ^ "<BR>");;

(*
  let slink = "a href=\"" ^ script ^ "?cwd=" ^ 
      (if cmd = "list" then lcwd else efcwd )^ "&cmd=" ;; *)
let slink = "a href=\"" ^ script ^ "?cwd=" ^ efcwd ^ "&cmd=" ;;

let quote = Filename.quote;;
let sort = form "sort" ;;
let glob = form "glob" ;;
let param = "&sort=" ^ sort ^ "&glob=" ^ glob ;;
let paramform ="<input type=hidden name=\"sort\" value=\"" ^ sort ^ "\">
  <input type=hidden name=\"glob\" value=\"" ^ glob ^ "\">";;

let backlink = ("<h2 align=center><" ^ slink ^ "list" ^ param ^"\">Go back to 'List'</a></h2>") ;;

let footer _ =
  pre ("<hr><center>Ocaml Editor (oced.ml.cgi) ver." ^ oced_version ^ "&nbsp;&nbsp;with Easycgi ver." ^ easycgi_version ^ "&nbsp;&nbsp;</center></body></html>");;

let exitmess s =
  pre s;footer (); exit 0;;

let exist_check _ =
  if not itexists then 
     exitmess ("<h2>Path '" ^ habsfn ^ "' doesn't exist !</h2>" ^ backlink);;
 


(* Translate shell glob pattern into a list of Ocaml's Str regex *)
let globre s  =
  let len = strlen s in
  let r = ref []in
  begin
    match len with 0 -> r := [".*"] | _ ->
      let b = Buffer.create len in
      let addbuf = Buffer.add_char b in
      let addbufs = Buffer.add_string b in
      let i = ref 0 in
      let fr = ref (fun _-> ()) in
      let ccr = ref !fr in  
      let cc1 = ref false in  (* Flag for 1st char of character class *)
      let esc = ref false in  (* Flag for escaped char *)
      let isend i f = incr i; if !i < len then f () in
      let rec gl _ =        (* glob pattern handling func *)
        let c = s.[!i] in
        fr :=gl;
        if !esc then (addbuf c; esc := false) else
          begin match c with
            '\\'-> addbuf c; esc := true
            | '*' -> (match !r with  "" :: tl when (Buffer.length b) = 0 -> ()
                      | _ -> r := Buffer.contents b :: !r ;Buffer.reset b)
            | '?' -> addbuf '.'
            | '.' | '+' | '^' | '$' -> addbuf '\\';addbuf c
            | '[' -> addbuf c; fr := !ccr; cc1 := true
            | _ -> addbuf c
          end; 
        isend i !fr in
    
      let rec cc _ =       (* Character Class handling func *)
        let c = s.[!i] in
        fr :=cc;
        if !esc then (addbuf c; esc := false) else
          begin match c with
            '\\' -> addbuf c ;esc := true
            | '!' when !cc1 -> addbuf '^'
            | ']' -> addbuf c ;fr := gl 
            | '[' | '^' -> addbuf '\\';addbuf c
            | _ -> addbuf c
          end; 
        cc1 :=false; isend i !fr in
      ccr := cc; gl (); 
      if (Buffer.length b) > 0 then r := Buffer.contents b :: !r 
      else if s.[!i-1] ='*' then r := ".*" :: !r 
      ;r := List.rev !r;
   end;
   List.map (fun s ->s, Str.regexp s ) !r;;

(* For testing strings for compiled shellglob pattern list made by globre *)
let globtest grxp s = 
  let ms = ref "" in
  let i = ref 0 and pos = ref 0 in
  match grxp with [] -> true |  (rs,re)::tl ->
    if rs = "" || ( (Str.string_match re s 0) &&
        (ms := (Str.matched_string s); i := (strlen !ms);true) )
    then (
       try 
         List.iter (fun (rs,regx) -> if rs <> "" then (
              pos := Str.search_forward regx s !i;
              ms := (Str.matched_string s);
              i := !pos + (strlen !ms)
              )
            ) tl; 
        if (!i) = (strlen s) || 
          (fst (List.nth grxp ((List.length grxp) -1)))  = ""
        then true else (
          false )
      with Not_found -> false
    ) else false;;

(* For testing a string for given shellglob pattern string *)
let globmatch pat s = globtest (globre pat) s;;

let hprglob grxp s = if globtest grxp s then pre (henc s) ;;




(*  
  Preprocess embedded code and produce source for Ocaml, Python, shell.
  All text in the file will be enclosed in :
        Printf.printf format string (Ocaml)
        print string wih % (...) (Python)
        echo 'string'   (shellscript)
  Text inside <#.+?> or <#.+?#> (if we write in Perl style regex)
  will be substituted with %s (Ocaml and Python) and the text will be
  placed in () as the arguments for the Ptintf.printf or print "" % ().
  
  
  For shellscript, tags (<#...> or <#...#>) will be repleced with 
  single quotes. 
  
  <#...> is a short hand and it cannot contain space, newline, or >
  while <#...#> can have anything except the closeing tag.
  
  There are two special cases. if the opening tag is followed by @ or &,
  (ie <#@, <#& ) the first case will be placed before 
  printf/print/echo statement, and the second will placed after.
  
  Shell script Example:
  --- input file ---
  <#@#!/bin/sh>
  Content-type: text/html
  
  <HTML><BODY>Your IP:<#$REMODE_ADDR><BR>
  Date:<#`date`>
  <#&
  echo `date`":$REMOTE_ADDR $HTTP_REFERER$HTTP_USERAGENT >>../logs/test.log
  #>
  --- output ---
  #!/bin/sh
  echo 'Content-type: text/html
  
  <HTML><BODY>Your IP:'$REMOTE_ADDR'<BR>
  '`date`'
  
  echo `date`":$REMOTE_ADDR $HTTP_REFERER$HTTP_USERAGENT#>
  
*)


let optres = "[-0+ ]?[0-9]*\\([dinNuxXosScCfFeEgGBt]\\|[lnL][diuxXo]\\)?:";;
let optre = Str.regexp optres;;


let prerr e = if dbg then pre (Printexc.to_string e);;

let htcontext = ref 'H' ;;
let csuffix = ref "" ;;
let slen = ref 0;;

let escape_qb s =
    let qb = ref [] in
    let ei = strlen s in
    for i = 0 to ei -1 do
        match s.[i] with
        '"' | '\\'  -> (* '"' *) qb := (true,i)::!qb
(*         | '%' -> qb := (false,i)::!qb *)
        |_ -> ()
    done;
    let n = ei + (List.length !qb) in
    let rs = String.create n in
    let lasti = ref 0 and rsi = ref 0 in
    List.iter (fun (bl,i) -> String.blit s !lasti rs (!lasti + !rsi) (i - !lasti);
       lasti := i; rs.[i + !rsi] <- (if bl then '\\' else '%') ;incr rsi;rs.[i + !rsi] <- s.[i];  
      ) (List.rev !qb);
    String.blit s !lasti rs (!lasti + !rsi) (ei - !lasti);
    rs;;

let htcf = ref (fun s -> print_string (escape_qb s));;

let check_context f s i lasti =
   let hc = s.[!i+2] in
   if (match hc with | 'H' | 'T' | 'W' | 'N' -> true | _ -> false)
       && s.[!i+3] = '#' && s.[!i+4] = '>' then (
    !htcf (slice s !lasti !i);
    f !csuffix;
    htcontext := hc;
(* f ("[CHK=" ^(String.make 1 hc) ^ ":" ^ (slice s !i (!i+8)) ^ "]"); *)
    (match hc with
      | 'H' -> csuffix := ""; htcf := (fun s -> f (escape_qb s));
      | 'T' -> csuffix := "";
        f "<pre>"; htcf := (fun s -> f (escape_qb (henc s))); 
        csuffix := "</pre>";
      | 'N' -> csuffix := ""; htcf := (fun s -> f (escape_qb (henc s)));
      | 'W' -> csuffix := ""; htcf := (fun s -> f (escape_qb s));
      | _ -> ()
      );
    lasti := (!i+5);
    i := !lasti;
    false
  ) else true;;

  
let hcodeq3 f s i lasti bp =
  let addbp = Buffer.add_string bp in
  addbp " (";
  let slen3 = !slen -3 in
  let is_tag = s.[!lasti] = '<' in
  let paren = ref 0 in
  lasti := !i ;
  (try while !i < !slen do
    if is_tag then (
      if s.[!i] = '#' && s.[!i+1] = '>' then (
        if s.[!i-1] <> '\\' then (
          addbp (slice s !lasti !i);
          i := !i +2; lasti := !i; failwith "END"
        ) else(
          addbp (slice s !lasti (!i-1));
          lasti := !i; i := !i +2;
        )
      ) else incr i
    ) else (
      if s.[!i] = ')' then (
        if s.[!i-1] <> '\\' then (
          if !paren = 0 then (
            addbp (slice s !lasti !i);
            incr i; lasti := !i; failwith "END"
          );
          decr paren;
        ) else(
          addbp (slice s !lasti (!i-1)); lasti := !i;
        )
      ) else if s.[!i] = '(' then (
        if s.[!i-1] <> '\\' then (
          incr paren;
        ) else (
          addbp (slice s !lasti (!i-1)); lasti := !i;
        )
      );
      incr i;
    )
    done with Failure "END" ->()|e -> prerr e);
  addbp ")";
  ;;

  

let q3 f s si =
  f "(Printf.sprintf \""; 
  let bp = Buffer.create 256 in
  let i = ref si and lasti = ref si in
  let slenq = !slen -5 in
  (try while !i < !slen do
    if s.[!i] = '"' && s.[!i+1] = '"' && s.[!i+2] = '"' then (
      if s.[!i-1] <> '\\'  then ( (* '"' *)
        failwith "END"
      ) else (
        !htcf (slice s !lasti (!i -1));
        f "\\\"\\\"\\\"";
        i := !i + 3;lasti := !i;
      )
    ) else if !i < slenq &&  s.[!i] = '<' && s.[!i+1] = '#' then (
      if s.[!i-1] <> '\\' then (
        if check_context f s i lasti then (
          !htcf (slice s !lasti !i);
          lasti := !i;
          if Str.string_match optre s (!i+2) then (
            let opts = slice  (Str.matched_string s) 0 ( -1) in
            f ("%" ^ opts ); i := (!i+3+(strlen opts));
            hcodeq3 f s i lasti bp;
          ) else (
            f "%s"; i := (!i+2);
            hcodeq3 f s i lasti bp;
          );
        )
      ) else (
        !htcf (slice s !lasti (!i -1));
        lasti := !i; i := !i + 2
      )
    ) else if s.[!i] = '%' && s.[!i+1] = '(' then (
      if s.[!i-1] <> '\\' then (
        if check_context f s i lasti then (
          incr i; !htcf (slice s !lasti !i);
          incr i; hcodeq3 f s i lasti bp;
        )
      ) else (
        !htcf (slice s !lasti (!i -1));
        lasti := !i; i := !i + 2
      )
    ) else (
     incr i;
    )
  done with Failure "END" ->()| e -> prerr e);
  !htcf (slice s !lasti !i); incr i;
  f "\""; f (Buffer.contents bp); f " ) ";
  !i + 2;;

let hcode f s si =
  let i = ref si and lasti = ref si in
  let subcode = ref 0 in
  let slen3 = !slen -3 in
  (try while  !i < !slen do
    if s.[!i] = '#' && s.[!i+1] = '>'  then (
      if s.[!i-1] <> '\\' then ( 
        decr subcode;
        if !subcode < 0 then failwith "END";
      ) else (
        f (slice s !lasti (!i -1)); lasti := !i
      );
      i := !i + 2
    ) else if s.[!i] = '<' && s.[!i+1] = '#' then (
      if  s.[!i-1] <> '\\' then ( 
        incr subcode;
      ) else (
        f (slice s !lasti (!i -1)); lasti := !i
      );
      i := !i + 2
    ) else if !i < slen3 && s.[!i] = '"' && s.[!i+1] = '"' && s.[!i+2] = '"' then ( (* '"' *)
      if s.[!i-1] <> '\\'  then (
        f (slice s !lasti !i);
        lasti := q3 f s (!i+3); i := !lasti;
      ) else (
        f (slice s !lasti (!i -1));
        lasti := !i; i := !i+3
      )
    ) else (
      incr i;
    )
    done with Failure "END" -> () 
       | e -> prerr e; pre "Possibly missing closing tag \"#>\" or \")\" ");
  f (slice s !lasti !i);
  !i + 2;;

let create_ml_ml f s  =
  slen := strlen s;
  htcf := (fun s -> f (escape_qb s));
  let i = ref 0 and lasti = ref 0 in
  let subcode = ref 0 in
  let slen3 = !slen -3 in
  f "open Easycgi;;
        
(* This file is generated by OcamlEditor preprocessor *)\n";
  (try while !i < !slen do
    if !i < slen3 && s.[!i] = '"' && s.[!i+1] = '"' && s.[!i+2] = '"' then ( (* '"' *)
      if s.[!i-1] <> '\\'  then (
        f (slice s !lasti !i);
        lasti := q3 f s (!i+3); i := !lasti;
      ) else (
        f (slice s !lasti (!i -1));
        lasti := !i; i := !i+3
      )
    ) else (
      incr i;
    )
    done with Failure "END" -> () 
       | e -> prerr e);
(* Printf.printf "create_ml_ml lasti=%d i=%d\n" !lasti !i; *)
  f (slice s !lasti !i);
  ;;

let slice_ending s si ei = 
  let i = ref (ei -1) in
  try while !i >= si do
    (match s.[!i] with
    ' ' | '\t' | '\n' -> ()
    |';' when s.[!i-1] = ';' -> failwith "OK"
    | _ -> raise Not_found );
    decr i;
  done; true with Failure "OK" -> false | _ -> true;;


let create_ml f s =
  slen := strlen s;
  let lasti = ref 0 and i = ref 0 in
  htcf := (fun s -> f (escape_qb s));
  f "open Easycgi;;

(* This file is generated by OcamlEditor preprocessor *)\n";
  if !slen > 1 && s.[0] = '<' && s.[1] = '#' then ( 
    if check_context f s i lasti then (
      if Str.string_match optre s (!i+2) then (
        let opts = slice  (Str.matched_string s) 0 ( -1) in
        f ("Printf.printf \"%" ^ opts ^ "\" (");
        lasti := hcode f s (!i+3+(strlen opts)); f ")";
      ) else (
        lasti := hcode f s (!i+2);
      );
      if slice_ending s !i (!lasti-2) then f ";;";
      f "\nprint_string \""; i := !lasti;
    );
  ) else ( 
    f "print_string \"";
    incr i;
  );
  let slen5 = !slen - 5 in
  (try while !i < slen5 do
    if s.[!i] = '<' && s.[!i+1] = '#' then (
      if s.[!i-1] <> '\\' then (
        if check_context f s i lasti then (
          !htcf (slice s !lasti !i); f "\";;\n";
          if Str.string_match optre s (!i+2) then (
            let opts = slice  (Str.matched_string s) 0 ( -1) in
            f ("Printf.printf \"%" ^ opts ^ "\" (");
            lasti := hcode f s (!i+3+(strlen opts)); f ")";
          ) else (
            lasti := hcode f s (!i+2);
          );
          if slice_ending s !i (!lasti-2) then f ";;";
          f "\nprint_string \""; i := !lasti;
        );
      ) else (
         !htcf (slice s !lasti (!i -1));
         lasti := !i; i := !i + 2
      )
    )else(
      incr i;
    );
  done with e -> prerr e);
  if !lasti < (!slen-1) then ( !htcf (slice s !lasti !slen) );
  f "\";;\n"
  ;;
    
        
let init_preprocess name  =
  let na = (false, (fun f (s:string) -> f;()), "") in
if dbg then (pre "init_preprocess ..."; pre name);
  if (extension name) = "html" then (
    let outname = slice name 0 (-5) in
    try 
      match (extension outname) with
      | "ml" -> (true, create_ml, outname)
(*       | "py" -> (true, create_py, outname) *)
(*       | "sh" -> (true, create_sh, outname) *)
      | _ ->  na
    with _ -> na 
  ) else if (extension name) = "ml" then (
    let outname = slice name 0 (-3) in
    if (extension outname) = "ml" then (true, create_ml_ml, outname)
    else na
  ) else na;;


(* Print header and menu *)
let header _ =
  let paramfn = param ^ "&fn=" ^ efn in
  pre ("""<HTML><HEAD>
<TITLE>Ocaml Editor ver.<#s:oced_version#></TITLE></HEAD>
<BODY bgcolor="#eaeae7">
<center><B>Ocaml Editor</B>&nbsp;
[ <<#s:slink#>list<#s:param#><#s:paramfn#>">List</a> | """);
if itexists then  pre """<<#s:slink#>menu<#s:paramfn#>">Menu</a> | """ ;
  pre """<<#s:slink#>edit<#s:param#>">New File</a> | 
<<#s:slink#>open<#s:paramfn#>">Open</a> | 
<<#s:slink#>sh<#s:param#>">Shell</a> | 
<<#s:slink#>help<#s:paramfn#>&#<#s:form "cmd"#>">Help</a> | 
<<#s:slink#>tools<#s:paramfn#>">Tools</a> 
]&nbsp;&nbsp;ver. <#s:oced_version#> &nbsp;at <#s:env "HTTP_HOST"#>
</center><hr>
""";;

header ();;


let shelllinks = "<FORM method=GET action=\"http://freebsd.org/cgi/man.cgi?\" target=_blank>
FreeBSD  Mannual page (external jump): 
<INPUT name=query value=\"\"> <INPUT type=submit value=\"Search Manpage\">
<a href=\"http://freebsd.org/cgi/man.cgi?\">or from here</a>
</FORM>
<a href=\"http://forum.powweb.com/search.php?q=shellscript\">
Search PowWeb Forum with 'shellscript'</a>" ;;

(* Open File screen *)
let openform _ = 
  pre ("<H2 align=center>Please enter the path</H2>
<center><table><tr><td align=right>
<form action=\"" ^ script ^ "\" method=\"POST\">
<input type=hidden name=\"cwd\" value=\"" ^ hfcwd ^ "\">
Path: <input type=text size=80 name=\"fn\" value=\"" ^ habsfn ^ "\">
</td></tr>
<tr><td align=right>
<input type=hidden name=\"cmd\" value=\"open\">"
  ^ paramform ^
"
<input type=submit name=act value=\"Open (auto)\">
<input type=submit name=act value=\"List\">
<input type=submit name=act value=\"Menu\">
  For a file:
<input type=submit name=act value=\"Shellscript\">
<input type=submit name=act value=\"Edit\">
</form></td></tr></table></center>
");;




(* Help Screen *)
let help _ = 
  pr("""<H2 align=center>Help & How-to info</H2>
<Font size=+1><pre>Please be very careful with this tool.
Protect it (and any other powerfull tools) with at least password protection,
and I recommend using IP (or IP range) protection, as well.

You should NEVER let this tool in publicly accessible area.

If you don't know how to do password protection,
you can install DomainManager in the same directory.
It will auto-protect itself and anything in the same directory.

<hr>

Ocaml Editor is a simple Web based editor with Ocaml native code compiler interface 
and light CGI library buit in.
It can create compiled small&rapid stand alone CGI program very easily.

Also it comes with Shell command/script tester/editor to manage your site
and create shellscript CGI.

Later, I may add support for editing/checking other CGI language like
Perl/Python/PHP into this program.

This program itself is written in Ocaml and created/updated using itself.

<hr>
<a name="list"></a>
With <a href="<#s:script#>?cmd=list<#s:param#>">List</a> menu, you can browse your entire site.
You can sort the listing by Name or Time, in both ascending and descending order.

Also, you can enter shell glob pattern (Wild cards and character class)
to filter the output.
Directories will be shown regardless of the filtering to allow navigation.
  
  
By clicking on the permission, you can change it (chmod).

* [edit] link will let you edit any text file.
* [list] link will let you browse that directory.
* [del] link will let you delete any file or directory and its contents,
if you click on 'Yes' in the confirmation screen.
* [dl] link is for downloading. However, certain types of file can be
viewed in the browser just like normal web contents.
Downloading requires "dl.cgi", which should be copied in the same
directory as this program by automatic installer.
If you did manula installation, copy "dl.cgi" from 
'lib/ocaml/dl.cgi' and put into '<#s:(dirname script)#>'.

By clicking file/directory name, you can access to the file/directory,
providing it's accessible by browser in normal manner.
(You can't use this only under /htdoc and Rewriterule/Redirect may
prevent you from accessing the file in some cases.)

In case of simlink, you can do operations on the target, too.

<hr>
<a name="menu"></a>

Menu screem will let you do multitude of operations.
For files, it can show first or last 50 lines, or all of it,
and it lets you edit as simple text file, Ocaml source, or shellscript.
You can download the file from here, too.

Also, clicking on the pathname shown as the title will let you access it
just like in the "List" screen.

For both file and directory,
It lets you delete, chmod, copy. rename/move, symlink, and use Unix commands.

Please be careful with powerful commands ....
Don't use "Skip confirmation" feature often.


<hr>
<a name="edit"></a>
<a name="open"></a>
Like <<#s: slink #>list<#s:param#>">List</a> menu, you can open/edit Ocaml script (extension ".ml") 
and then save the file, and complie it to a binary standalone CGI program,
with <<#s:slink#>edit<#s:param #>">New File</a>, or <<#s:slink#>open<#s:param#>">Open File</a> menu, 

Currectly, no backup is made. So, please be careful.
I plan to implement simple version control, in future.

You can use the editor to edit any text file, as well.
Integrated test/debug support for Perl/Python/PHP isn't ready yet.

<H3>Ocaml specific details:</H3>
By default "Unix" and "Str" modules, as well as "Easycgi" library are
linked to your script.

"Easycgi" library send "Content-type" header,
decode GET or POST form, and defines some helper functions.

How to use:
1. Use one of menu to open/create a file with .ml extension.
  ex. Use <<#s:slink#>edit<#s:param#>">"New File</a> and enter 'hello.ml' as the filename.
2. Enter the code.
  ex. enter 'pre "Hello!";;' in the textarea.
3. Push 'Save & Compile' button. It will be compiled and the link for
  test-run the binary cgi will be shown.
4. Test it (by opening it in another tab).

Usually compilation takes less than a few seconds and even less than a second.
(In some cases, it may take longer.)

As 'Easycgi' library takes care of sending 'HTTP header' and form decoding,
even a novice person can create simple CGI programs.

But it will take time to learn Ocaml if you are new to programming,
or you don't have experience with many languages.


<H3>HTML with embedded Ocaml code</H3>
When you use file name with ".ml.html" extension,
it will be treated as HTML document with embedded Ocaml code (inside \<# #> tags).
OcamlEditor will save the file, then preprocess and generate Ocaml source code,
which will be saved with ".ml" extension. And finally it will be compiled.

The \<# #> tag acts similar to <? ?> of PHP.
   ex.  \<# let x = 123 #>  --> let x = 123;;

\<#s: #> acts similar to <?= ?>.
  ex.   \<#s: env "REMOTE_ADDR" #> --> 'Printf.printf "%%s" (env "REMOTE_ADDR");;

In addition to this, you can use any of Ocaml's standard format string.
  ex.   \<#05d: x #>  --> Printf.printf "%%05d" (x);;

Note: If you want to use literal "#>", escape with a backslash.  ex. "\#>"


Also, inside the \<# #> tags (in the 'code' context),
you can use Python style \"""string\""" that can, in turn, 
contain other tags \<# #> or Python style %\%(code)s type of format string.

Note: If you want to use literal \<#, escape with a backslash.  ex. \\<#
      If you want to use literal %% escape with another %%.
      Also, escape \""" by prefixing backslashe \  inside \"""string\""".

(Python allows only variables, unless you use special object that exec the code on the fly.)

In short, you can make small script in ASP/PHP style embedded coding.
Although it's considered as a bad practice, for a small ocde (of less than a few thousands lines),
it's a very convenient way of making web pages.


You can also start your script in the code context, if you name the script with ".ml.ml" extension.
In this case, \"""string\""" will be converted to Printf.sprintf expression.




Handy links:
1. Ocaml official manual and library references.
<a href="http://caml.inria.fr/pub/docs/manual-ocaml/index.html">http://caml.inria.fr/pub/docs/manual-ocaml/index.html</a>
  Library references are 'dictionary' to read and write Ocaml language.

2. <a href="http://www.csc.vill.edu/~dmatusze/resources/ocaml/ocaml.html">http://www.csc.vill.edu/~dmatusze/resources/ocaml/ocaml.html</a>

3. <a href="http://caml.inria.fr/">http://caml.inria.fr/</a>

4. Ocaml newbie mailing list. <a href="http://groups.yahoo.com/group/ocaml_beginners/">http://groups.yahoo.com/group/ocaml_beginners/</A>

5. Usually, quickest way to get info is to use the Google search with 'Ocaml' + whatever.

<#s: shelllinks#>

<a name="easy"></a>

Functions defined in "Easycgi":<#N#>

pr : an alias of print_strng. ex. pr "<h1>Hello!</h1>\n";;
pre : an alias of print_endline. Similar to "pr" but out put "\n", too.
env : an alias of Unix.getenv. ex. pre (env "REQUEST_URI");;
prenv : print an env variable. ex. prenv "REQUEST_URI";;
form : Returns decoded form. ex pr (form "abc");;
decode : Decodes urlencoded string ex decode "%%31%%62%%OD%%OA";;
  It will also convert "\r\n" to "\n", and "+" to " ".
encode : Opposit of "decode". Urlencode the string.
  Use it on uri, filenames, or path you put in href="".
henc : html escaping. "<" to "&lt;", ">" to "&gt;", "&" to "&amp;".
  (Other escaping may added later...)
filesave filename string: save the string into a file.
fileread filename : Returns string read from the file.
filecopy src dest : copy the file and its permission
<#H#>
prsystem shell_cmd : Execute shell command and show the output in &lt;pre> tags.  
  ex. prsystem "hostname";;
systemf func shell_cmd : Execute shell command and apply the 'func' to
  each output line. ex. systemf encode "pwd";;

find string substring : Search substring in the string. 
  Returns the position found. Returns -1 if not found.
rfind string substring : Silimar to "find", but searches from the end.
find_all string substring : find all occurance of substring in the string
  and return the list of matched positions.
  ex. find_all "abcabfabg" "ab";; --> [0;3;6]
replace string substring1 substring2 : replace all occurance of substring1
  with substring2. ex. reaplce "abcabg" "ab" "XY";; --> "XYcXYg"

extension path : Returns the extension of the path string.
  ex. pr (extension "../abc.html");;  ==> This will print 'html'

Variables defined in "Easycgi":

home : "/www/U/USER" on PowWeb.
user : username.
cwd : current directory.
script : The pathname for the script you can use in "a href" or "form action".


<hr>
<a name="sh"></a>

<<#s:slink#>sh<#s:param#>">Shell</a> menu let you edit/execute/save
shell command/script.

If you enter the filename, the content of the form will be saved 
with proper shebang line attached and correct permission (0700) set.
Then, the code will be executed.

If you don't enter the filename, the content will be executed without being saved.

Please be VERY CAREFUL with shell command, as it can harm your ego,
account, and even the server if misued.
<B>You are warned.</B>

<hr>
<a name="tools"></a>

Tools link will show some links to other tools.

<hr>

Future of this tool:

I'll add more security feature like auto-password protection,
and other checks to keep the user out of problems.

Also, I'll make this tool into mini-integrated developpement environment for
several languages.

I will definitely integrate Camlmix or similar basic template processing,
and wiki or structured text processing engine, too.

I have already experimented some of these idea with Python,
and I just have to sit and write them in Ocaml code.

<hr>
<a name="license"></a>

License info:  

This program (oced.ml.cgi) is a stand alone binary program created by Ocaml,
and it's distributed under it's own license with "Easycgi" library.

The CGI you created with this program and compiled with Ocaml compiler
can be distributed under any license of your choice.

However, if you make modifications/improvements to this program
and/or easycgi library, you must send it to me.
          ocamleditor AT check-these.info

Ocaml native code compiler and library are Licensed under LGPL/QPL type license.
Please read "LICNESE" in the library directory or this link:
<a href="http://caml.inria.fr/ocaml/license.en.html">http://caml.inria.fr/ocaml/license.en.html</a>

You can obtain full source code from:
<a href="http://caml.inria.fr/">http://caml.inria.fr/</a>

""");; (* '"' *)


let edit_mess = ref "Please enter the file name and the shell code."
let edit_cwdmess = ref "Cwd"
let edit_namemess = ref "Name"
let edit_row = ref "8"
let edit_cmd = ref "sh"
let edit_extbutton = ref "Execute"
let edit_under = ref ""
let compile = ref true (* ref (((form "saveexec") ^ (form "exec")) <> "") *)
let comp_prefix = "exec 2>&1;cd " ^ (quote safecwd) ^ ";hostname;uptime;echo -n 'Compiling ... ';"
let comp_sufix = ";ls -alt " ^ (quote !fn) ^ "* "
let edit_cwd = ref (henc safecwd)
let edit_fn = ref (henc !fn)
let submit = (form "submit") <> ""

let editform _ =
  if submit && (not fcwdexists) then (
     pre "<h2 align=center><font color=red>The specified directory doesn't exists. Please try again.</font></h2>";
     compile := false
    );
(*  pre ("<H2 align=center>" ^ !edit_mess ^ "</H2>"); *)
  pre ("<center><table><tr><td align=right>
<form action=\"" ^ script ^ "\" method=\"POST\">
  " ^ !edit_cwdmess ^ ":<input size=47 name=\"cwd\" value=\"" ^ !edit_cwd ^ "\">
  " ^ !edit_namemess ^ ":<input size=20 name=\"fn\" value=\"" ^ !edit_fn ^ "\">
</td></tr><tr><td>
  <textarea cols=80 rows=" ^ !edit_row ^ " name=\"ct\" >" ^ (henc !ct) ^ "</textarea>
</td></tr><tr><td align=right>
" ^ paramform ^ "
  <input type=hidden name=\"cmd\" value=\"" ^ !edit_cmd ^ "\">
  <input type=hidden name=\"submit\" value=\"yes\">
  <input type=hidden name=\"pfn\" value=\"" ^ !edit_fn ^ "\">"
^ !edit_under ^
"  <input type=submit name=\"save\" value=\"Save\">" ^(
if !edit_extbutton = "" then "" else
"  <input type=submit name=\"saveexec\" value=\"Save & " ^ !edit_extbutton ^ "\">
  <input type=submit name=\"exec\" value=\"" ^ !edit_extbutton ^ "\">"

 ) ^ "</form></td></tr></table></center>
");;



(* Edit File screen *)
let editfile _ = 
  let ml = if (extension !fn) = "ml" then true else false in
  let dopre, prefun, outname = init_preprocess !fn in
if dbg then pre """dopre = %(dopre)B,  outname=%(outname)s""";
  edit_mess :=  "Please enter the file name and the code." ;
  edit_namemess := "Name";
  edit_row :=  "18";
  edit_cmd :=  "edit";
  edit_extbutton := if ml || dopre then "Compile" else "";
  let easy = ref "easycgi.cmxa " in
  let noeasy = ref (if (form "noeasy") = "" || dopre
       then ( easy := "" ; "") else "checked") in 
if dbg then pre """easy=%(!easy)s, noeasy=%(!noeasy)s""";  
  let ostr = "open Easycgi;;" in
  if !fn = "easycgi.ml" then (easy := "";noeasy := "");

  let sfn = if !fn <> "" then (if dopre then quote outname else quote !fn ) 
    else "SOURCEFILE" in
  (* bring this to just before compiling  *)
  let sourcename = (if dopre then outname else !fn) in
if dbg then pre ((form "pfn") ^ "=pfn, " ^ !fn ^ "=fn  <BR>");    
  let cmpcmd = (replace (replace (form "cmpcmd") "SOURCEFILE" (quote sourcename)) 
                   (quote (form "pfn"))  (quote sourcename)) in
let ocamlstd = if Sys.file_exists "/usr/bin/ocamlopt.opt" then true else false in
let ocamlhome = if ocamlstd then "/usr" else home in
let camllib = if ocamlstd then "" else "export CAMLLIB=" ^ ocamlhome ^ "/lib/ocaml;" in
if dbg then pre (cmpcmd ^ "=cmpcmd, <br>");    
  let compilecmd =  (camllib ^ "time " ^ ocamlhome ^ "/bin/ocamlopt.opt unix.cmxa str.cmxa easycgi.cmxa " ^ sfn ^ " -o " ^ sfn ^ ".cgi")  in
  let compilecmd =  if cmpcmd = "" || cmpcmd = compilecmd || dopre then compilecmd
      else cmpcmd in

  let runfn = ref (wpath absfn) in  
  if  !fn = "" || ml || dopre then (
    (runfn := sourcename ^ ".cgi");
    runfn := henc !runfn;
    edit_under := ("<input type=text size=80 name=cmpcmd value=\"" ^ 
      (henc compilecmd) ^ 
      "\"></td></tr><tr><td align=right><input type=checkbox name=noeasy " ^ 
      !noeasy ^ ">Don't use Easycgi&nbsp;&nbsp;")
  );
  editform ();
  if !fn <> "" && !runfn <> "/ERROR/" then pre ("<center><a href=\"" ^ !runfn ^ "\">Test-Run-Access " ^ !runfn ^ "</a></center>"); 
  let added = ref 0 in
if dbg then pre (string_of_bool !compile);  
  if !compile && !fn <> ""  then (
    if (form "exec") = "" then (
      pr "Saving ...";
      let out = open_out absfn in
      if  (!fn <> "easycgi.ml" && !ct <> "" && ml && !noeasy = "" &&
        (find !ct ostr) <> 0) then 
        (output_string out (ostr ^ "\n"); pre ("  'open Easycgi;;' added");added := 1 );
      output_string out !ct;
      close_out out);
(*pre (string_of_bool dopre);  *)
      if dopre then (
        pr ("Creating source code:"^ outname ^" ...");
        let out = open_out (path_join fcwd outname) in
        prefun (output_string out) !ct;
        close_out out);
    if (form "save") = "" then ( 
      pr "<pre>";
      let r = systemf (fun s -> pre (henc s);
        if Str.string_match (Str.regexp ".*File +\"[^\"]+\"[^0-9]+\\([0-9]+\\)[^0-9]+\\([0-9]+\\)-\\([0-9]+\\)" ) s 0 then
          (
          let source = if dopre then fileread (path_join fcwd outname) else !ct in
          let c1 =  (int_of_string (Str.matched_group 2 s)) 
               and c2 =  (int_of_string (Str.matched_group 3 s)) in
          let ln = (int_of_string (Str.matched_group 1 s)) in
          let slen = (strlen s) in
          let eline = ref "" and elen = ref 0 in
          let i = ref 0 in
          let lnum = if dopre then ln - 1  else ln - !added -1 in
          while !elen < c2 do
            eline := !eline ^ (nth_line source (lnum + !i)) ^ "\n";
            incr i; elen := (strlen !eline);
          done;
          pr "<font color=blue>";
          (try
            hpr (substr !eline 0 c1);
            pr "<font color=red size=+1><U>";
            hpr (substr !eline c1 (c2 - c1));
            pr "</U></font>";
            if c2 < !elen then hpr (substr !eline c2 (!elen - c2 ));
          with _ -> pre " ### Error code output failed ###");
          pre "</font></U>"
          ) 
        ) (comp_prefix ^ compilecmd ^ comp_sufix) in
      if r <> "" then pre(r);
      pr "</pre>";
    );
    pre ("\"" ^ (form "save") ^ (form "saveexec") ^ (form "exec") ^ "\"&nbsp;&nbsp;done");
  );;



(* Shell screen *)
let shellform _ = 
  let noshbang = if (form "noshbang") <> "" then "checked" else "" in
  edit_under := ("<input type=checkbox name=noshbang " ^ noshbang ^ 
">Don't add shbang+echo&nbsp;&nbsp;");
  editform ();
  let wfn = (wpath absfn) in
  if !fn <> "" && wfn <> "/ERROR/" then pre ("<center><a href=\"" ^ (encode wfn) ^ "\">Run " ^ (henc wfn) ^ "</a></center>"); 
  if !compile && !fn <> ""  then (
    if (form "exec") = "" then (
      pr "Saving ..."; 
      let out = open_out absfn in
      let ostr = "#!/bin/sh\necho ''" in
      if noshbang = "" && (find !ct "#!") != 0 then (
        (output_string out (ostr ^ "\n"));
        pr " Adding #1/bin/sh + echo '' "
      );
      output_string out !ct;
      close_out out;
      try Unix.chmod absfn 0o700
      with Unix.Unix_error (a, b, c) -> 
         pre ("(" ^(Unix.error_message a)^ ")," ^ b ^ ", " ^ c)
    );
  );
  if !compile &&  (form "save") = "" then 
       prsystem ("exec 2>&1;cd " ^ (quote safecwd) ^ ";hostname;uptime;ps -uxww;export  HOME='" ^ home ^ "';echo ------;" ^ !ct );
  pre ("<HR><center>
"^ shelllinks ^"
</center>") ;;



(* list screem *)
let listdir _ = 
  let lcwd = encode (safedirname (rdirname absfn )) in
  let lscwd = safedirname (rdirname absfn ) in
  
  let sortx = match sort with 
       "s" -> ">oecd.Tmp; sort -n +4 oecd.Tmp; rm oecd.Tmp" 
      | "sr" -> ">oecd.Tmp; sort -r -n +4 oecd.Tmp; rm oecd.Tmp" 
      | _ -> "" in
  let glob = form "glob" in
  let globon = glob <> "" in
  let glrel = if globon then globre glob else [] in
(*  let globon = if (form "globon")<>"" then " checked" else "" in *)
(*  let ls_cmd = ("exec 2>&1;cd "^lcwd^";ls -al" ^ sort ^ 
       " " ^ glob ^ sortx) in *)
  let ls_cmd = ("exec 2>&1;cd "^lscwd^";ls -al" ^ sort ^ " " ^ sortx) in
  let ic = Unix.open_process_in ls_cmd in
  let s = ref "" in
  let cmd = ref "edit" in
  let ef = (encode !fn) in
  let slink = "a href=\"" ^ script ^ "?cwd=" ^ lcwd ^ "&cmd=" in
  let llink = slink ^ "list&fn=" ^ eabsfn in
  pr ("""<form action="<#s:script#>">cwd=<input type=text size=40 name=cwd value="<#s:henc lscwd#>">
<input type=hidden name=cmd value="list">
<input type=hidden name=sort value="<#s:sort#>">
<input type=submit value="ChangeDirectory"><#s:
(* UseGlob<input type=checkbox name=globon " ^ globon ^"> *) ""
#>&nbsp; <input type=text size=10 name=glob value="<#s:henc glob#>">
<input type=submit value="Filter(glob)"><BR>
 <<#s:slink#>list&fn=<#s:encode home#><#s:param#>"><#s:henc home#></a>
 <<#s:slink#>list&fn=<#s:encode docroot#><#s:param#>"><#s:henc (Filename.basename docroot)#></a>
 <<#s:slink#>list&fn=<#s:encode cwd#><#s:param#>">StartingDir</a>
&nbsp;
<<#s:slink#>list&fn=<#s:encode (path_join lcwd "..")#><#s:param#>">Up (parent dir)</a>
 &nbsp;Sorted by: 
<#s: (if sort="" then ">>" else "")#><<#s:llink#>&glob=<#s:glob#>">Name</a>,
<#s: (if sort="r" then ">>" else "")#><<#s:llink#>&sort=r&glob=<#s:glob#>">reverse</a>
 or 
<#s: (if sort="t" then ">>" else "")#><<#s:llink#>&sort=t&glob=<#s:glob#>">Time</a>,
<#s: (if sort="tr" then ">>" else "")#><<#s:llink#>&sort=tr&glob=<#s:glob#>">reverse</a>
</form>
<pre>""");

(* or
<" ^ llink ^ "&sort=s\">Size</a>,
<" ^ llink ^ "&sort=sr\">reverse</a>" *)
  let dslink = ref slink in
  let fl = ref (-1) in
  let flipspace fl = incr fl; if !fl = 5 then 
     (pr "<font color=#345678>") in
  let flipend fl = if !fl = 5 then (fl:= 0;pr "</font>") in
  let show_link = (find fcwd docroot) = 0 in 
  let dlok = ref true in
  let dllink = "<a href=\"" ^ (dirname script) ^ "/dl.cgi?" in
(*  let show_link = false in  Always let them download *)
  try
    while true do
      let sl = input_line ic in
(*      s := henc (input_line ic); 
      pre !s; *)
      let s = ref sl in
      let l = Array.of_list (List.map (fun x -> match x with
         Str.Text s|Str.Delim s -> s) 
         (Str.full_split (Str.regexp " +") !s)) in
      let len = (Array.length l) - 1 in
      if len > 15 then 
      begin
        if ((not globon) || (l.(0).[0] = 'd' || l.(0).[0] = 'l') 
           || globtest glrel l.(16)) then 
        (
        let perm = l.(0) in
        cmd := (match perm.[0] with 
          'd' | 'l' -> dlok :=false; "list"  | _ -> dlok :=true;"edit" );
        for i = 0 to len do 
         (match i with
            0 ->
             flipspace fl;
             pr ("<" ^ !dslink ^ "chmod&fn=" ^ (encode l.(16) ) ^ param ^ "\">"  ^ perm ^ "</a>" )
           |16 | 20 -> 
             if i = 20 && l.(18).[0] <> '-' then  pr  l.(i)  else
               let fnn = l.(i)  in
               let efnn = encode fnn in
               let fnx = encode (wpath (if fnn.[0] <> '/' then (path_join lcwd fnn) else fnn) )in 
               let hfnn = henc fnn in
               pr (" <" ^ !dslink  ^ !cmd ^ "&fn=" ^ efnn ^ param ^ 
               "\">[" ^ !cmd ^"]</a>  <" ^ !dslink ^ "menu&fn=" ^ 
               efnn ^ param ^ "\">[menu]</a>  " ^ 
               (if !dlok then (path_join dllink 
               (encode (path_join fcwd fnn))) ^ "\">[dl]</a> " 
               else "[na] " )
               ^ 
               (if show_link then ("<a href=\"" ^ fnx ^ "\">" ^ hfnn ^ "</a> " ) 
               else hfnn )
                ) 
           
            | _ -> pr l.(i)  )
        done;  flipend fl; pre "" )
      end
      else (if sl <> "" && sl.[(strlen sl) -1] = ':' then 
           dslink := "a href=\"" ^ script ^ "?cwd=" ^ 
           (path_join lcwd (encode (slice sl 0 (-1)))) ^ "&cmd="  ; 
           flipspace fl;pre (henc sl); flipend fl )
    done
  with _ -> ignore(Unix.close_process_in ic);
  pre "</pre>" 
;;

let doshx s = prsystem ("exec 2>&1;" ^ (quote s) ) ;;


(* del operation *)
let del_item _ =
   let ef = efn in
   let edn = (encode (Filename.dirname !fn)) in
   if (form "doit") = "" then
      pre("<h2>Do you really want to delete <font color=blue size=-1>" ^
 (henc absfn) ^ " </font><BR>
(and everything it contains in case of directory) ? 
<" ^ slink ^ "del&fn=" ^ efn ^ "&doit=yes" ^ param ^ "\">Yes</a> &nbsp; <" ^ slink ^ "list" ^ param ^ "\">No</a></h2>")
   else
      (prsystem ("exec 2>&1;rm -vrf " ^ (quote absfn));
       pre (habsfn ^ " removed. If you want to get it back, try <a href=\"/+sitemanager\">sitemanager</a><BR><BR>
<center><" ^ slink ^ "list" ^ param ^ "\">Go back to directory listing </a></center>") )


(* Tools Menu *)
let tools _ = pre ("<h2 align=center>Links for other tools</h2>
<font size=+1><pre>
<a href=extratools.php>Extratools</a> Automatic installer/updater for more tools.   <a href=http://check-these.info/tools/extratools_php.txt>Get it from here!</a>

To install other tools, please use <a href=extratools.php>Extratools</a>. 

<a href=domain.cgi>Domain Manager</a> Python based subdomain/pointed domain management tool.

<a href=phpini.php>phpini Control Center</a> php.ini editor controller.
  It will let you setup custom php.ini, your own session directory with
  automatic clean up cronjob, your own upload tmp directory, and so on.

<a href=cronaid.php>CronAid</a> Crontab editor/checker/tester tool.

<a href=easylogtool.cgi>EasyLogTool</a> For raw log related tasks and diagnostic.

<a href=http://check-these.info/tools>http://check-these.info/tools</a> Tool depot. There are some other tools.


")
     
let chmod_check _ =
  exist_check ();
  if is_link absfn then 
     exitmess ("<h2>Target '" ^ habsfn ^ "' is a symlink. </h2>
The permission of symlink shows always \"777\" 
and the privilege depends on the linked file/directory."  ^ backlink);;
     

let chmod_form _ =
  chmod_check ();
  let sv = Unix.lstat absfn in
  let permoct = sv.Unix.st_perm in
  let permval = Printf.sprintf "%03o" permoct in
(*  pre permval; *)
  let perm = Array.make 9 "" in
  for pi = 0 to 8 do
    if ((int_of_float (2. ** (float_of_int pi))) land permoct) <> 0 then 
      Array.set perm pi "checked"
(*      ;print_int pi;pr "=";
      print_int ((int_of_float (2. ** (float_of_int pi))) land permoct);
      pr ", " *)
  done;

  let formhead = "<form action=\"" ^ script ^ "\">
<input type=hidden name=cwd value=\"" ^ hfcwd ^ "\">
<input type=hidden name=cmd value=\"chmodset\">
" ^ paramform ^ "
<input type=hidden name=fn value=\"" ^ hfn ^ "\">" in

  pre ("<center><font size=+2><B>Current permission = " ^ permval ^ "</B></font>");
  if itsfile then prsystem ("ls -l " ^ (quote absfn)) else pr (absfn ^ "<BR>");
  pre (formhead ^ "
<font size=+2><B>Choose one of 'Predefined Permission Values' </B></font>
<table border=2>
<th>Type</th><th>Description</th><th>chomod !</th>");
  if itsfile then pre ("
<tr><td>
File type #1<BR>
&nbsp;'HTML'
</td><td>
html file, .htaccess, and password file for .htaccess auth
</td><td>
Set to <input type=submit name=setit value=640>
</td></tr><tr><td>File type #2<BR>&nbsp;'CGI'</td><td>
CGI script/program (.cgi .pl .sh ....)
</td><td>
Set to <input type=submit name=setit value=700>
</td></tr><tr><td>File type #3 <BR>&nbsp;'PHP/Data/Module'</td><td>
php script and CGI module/subroutine (.php .php5 .pl ....),<BR>
and any other data files
</td><td>
Set to <input type=submit name=setit value=600>
</td></tr>")

   else pr ("
<tr><td>Directory #A<BR>&nbsp;'Apache'</td><td>
Directory with 'HTML' files (including .htaccess, password file)<BR>
or main CGI/PHP script in it or in a subdirectory
</td><td>
Set to <input type=submit name=setit value=710>
</td></tr><tr><td>Directory #B<BR>&nbsp;'Index'</td><td>
Similar to \"Directory A\" but using Apache's Directory Index.
</td><td>
Set to <input type=submit name=setit value=750>
</td></tr><tr><td>Directory #C<BR>&nbsp;'Data'</td><td>
Any other directory. ex. Data, module, subroutine, include ...
</td><td>
Set to <input type=submit name=setit value=700>
</td></tr>");

  pr ("</table></form><BR>
<font size=+2><B>or set whatever the value you want using one of these.</B></font>
" ^ formhead ^ "
<table border=2><tr>
<td align=center>Enter octal permission number.
<input type=text size=5 name=setit value=\"" ^ permval ^ "\"> 
<input type=submit value=\"'chmod' it\">
</tr><tr><th>Note: '2', '6' or '7' in 2nd/3rd digit will cause error<BR>
 on PowWeb server. (777, 666, ...)</th>
</tr></table></form>
" ^ formhead ^ "
<table border=2><tr>
<th colspan=3>Owner (CGI/PHP script)</th><th colspan=3>Group (Apache)</th><th colspan=3>Other (Useless)</th>
</tr><tr><th colspan=9>Note: Above descriptions in () are specific to PowWeb (SuExeced CGI/PHP)</th>
</tr><tr>
<td>Read<input type=checkbox name=or " ^ perm.(8) ^ "></td>
<td>Write<input type=checkbox name=ow " ^ perm.(7) ^ "></td>
<td>Execute<input type=checkbox name=ox " ^ perm.(6) ^ "></td>
<td>Read<input type=checkbox name=gr " ^ perm.(5) ^ "></td>
<td>Write<input type=checkbox name=gw " ^ perm.(4) ^ "></td>
<td>Execute<input type=checkbox name=gx " ^ perm.(3) ^ "></td>
<td>Read<input type=checkbox name=nr " ^ perm.(2) ^ "></td>
<td>Write<input type=checkbox name=nw " ^ perm.(1) ^ "></td>
<td>Execute<input type=checkbox name=nx " ^ perm.(0) ^ "></td>
</tr><tr><td colspan=9 align=center>
<input type=submit name=px value=\"'chmod' it\">
</td>
</tr></table>
</center></form>
<H2 align=center><" ^ slink ^ "list&fn=" ^ efcwd ^ param ^ "\">Abort and go back to the list</a></h2>
")

let chmodset _ =
  chmod_check ();
  let setit = form "setit" in
  let permoct, permval = (if (form "px") <> "" then
      let tv = ref (if (form "nx") <> "" then 1 else 0) in
      tv := !tv + (if (form "nw") <> "" then 2 else 0);
      tv := !tv + (if (form "nr") <> "" then 4 else 0);
      tv := !tv + (if (form "gx") <> "" then 8 else 0);
      tv := !tv + (if (form "gw") <> "" then 16 else 0);
      tv := !tv + (if (form "gr") <> "" then 32 else 0);
      tv := !tv + (if (form "ox") <> "" then 64 else 0);
      tv := !tv + (if (form "ow") <> "" then 128 else 0);
      tv := !tv + (if (form "or") <> "" then 256 else 0);
      !tv , Printf.sprintf "%03o" !tv
    else( try int_of_string ("0o" ^ setit), setit
          with _ -> -1, setit
  )) in
  let ext = extension !fn in 
  begin
  try
    if permoct < 0 then failwith "The permission must have 3 octal (0 - 7) digits";
    if permoct > (int_of_string "0o777") then failwith "The value you entered is too big";
    (match permval.[0] with 
       '7' -> (match ext with 
          "cgi" | "pl" | "sh" -> ()
          | _ when itsfile -> pr "<center><font color=blue>NOTICE: Other than main CGI script, you don't need to set executable permission of '7'.</font></center>"
          | _ -> () )
       | _ -> if itsdir then pr ("<center><font color=red>WARNING: For a directory, you should set permission of '7' for 'Owner'.</font></center>") 
    );
    let sixseven = "You shouldn't use '2', '6' or '7' in 2nd/3rd octet" in
    (match permval.[1] with '0' | '1' | '3' .. '5' -> ()
       | _ -> failwith sixseven);
    (match permval.[2] with '0' -> ()
         | '1' | '3' .. '5' -> pr "<center><font color=blue>NOTICE: Setting anything other than '0' on the 3rd digit (for Others) reduces the security.</font></center>"
         | _ -> failwith sixseven); 
    pre("<center><font size=+2>Setting permission of " ^ permval ^ " to '"
^ hfn ^ "'</font>");
    Unix.chmod absfn permoct
  with Failure s  ->  pre ("<center><font size=+2 color=red>Invalid value : " ^ permval ^ " for '"
^ hfn ^ "'</font><BR>" ^ s ^ "<BR><H2 align=center><" ^ slink ^ "chmod&fn=" ^ efn ^ param ^ "\">Go back to the chmod screen</a></h2> <center>or</center>")
  end;
  pre ("<H2 align=center><" ^ slink ^ "list" ^ "&fn=" ^ efcwd ^ param ^ "\">Go back to the list</a></h2>");;


(* menu screem *)
let menu _ =
  exist_check ();
  let param = "&fn=" ^ efn ^ "&back=menu" ^ param in
  let ropt = if itsdir then "r" else "" in
  let aclink = if (find absfn docroot) = 0 then ("<a href=\"" ^ 
   (slice absfn (strlen docroot) 0) ^ "\">" ^ habsfn ^ "</a>") else habsfn in
  pre ("<H2 align=center>Menu for " ^ aclink ^  "</H2>
<center>
[" ^ (if itsfile then ( 
  let paramsp = param ^ "&doit=yes&spath=" ^ absfn ^ "&fn=" ^ hfn in
  " Show
<" ^ slink ^ "fileop&act=head -50" ^ paramsp ^ "\">Head</a> | 
<" ^ slink ^ "fileop&act=cat" ^ paramsp ^ "\">All(cat)</a> | 
<" ^ slink ^ "fileop&act=tail -50" ^ paramsp ^ "\">Tail</a> ] - [ " 
      )  else "" ) ^ 
"<" ^ slink ^ "del" ^ param ^ "\">Delete</a> | 
<" ^ slink ^ "chmod" ^ param ^ "\">Chmod</a> | 
<" ^ slink ^ "open" ^ param ^ "\">Open</a> "
  ^ (if itsfile  then ( 
"| <a href=\"/" ^ (dirname script) ^ 
"/dl.cgi?" ^ eabsfn ^ "\">Download</a> |
<" ^ slink ^ "sh" ^ param ^ "\">Shell</a> |
<" ^ slink ^ "edit" ^ param ^ "\">Edit</a>  " 
        ) else "" ) ^
"]
<BR><BR>
<form action=\"" ^ script ^ "\" method=\"POST\">
<table><tr><td>
Source: 
<font size=+1>" ^ habsfn ^ "</font><BR>
Target:
<input type=hidden name=\"cwd\" value=\"" ^ hfcwd ^ "\">
<input type=hidden name=\"fn\" value=\"" ^ hfn ^ "\">

<input type=text size=80 name=\"dfn\" value=\"" ^ habsfn ^ "\">
</td></tr><tr><td colspan=4 align=right>
<input type=hidden name=\"cmd\" value=\"fileop\">
<input type=hidden name=\"back\" value=\"menu\">
" ^ paramform ^ 
 ( if ropt = "" then "<input type=submit name=act value=\"Copy\">"
     else "\tCopying a directory and everything in it can be done with 'cp -vr' in Unix command interface<BR>"
        )
^
"<input type=submit name=act value=\"Rename/Move\">
<input type=submit name=act value=\"Symlink\">&nbsp
</td></tr></table></form>
<HR>
        
<h2>Unix command interface</h2>
<form action=\"" ^ script ^ "\" method=\"POST\">
<table><tr><td align=right>
Execute the command without confirmation (If you are sure ...):
<input type=checkbox  name=\"doit\">
</td></tr><tr><td>
Source: 
<input type=text size=80 name=\"spath\" value=\"" ^ habsfn ^ "\">
<!-- <font size=+1>" ^ habsfn ^ "</font> --><BR>
Target:
<input type=hidden name=\"cwd\" value=\"" ^ hfcwd ^ "\">
<input type=hidden name=\"fn\" value=\"" ^ hfn ^ "\">

<input type=text size=80 name=\"dfn\" value=\"" ^ habsfn ^ "\">
</td></tr><tr><td colspan=4 align=right>
<input type=hidden name=\"cmd\" value=\"fileop\">
<input type=hidden name=\"back\" value=\"menu\">
" ^ paramform ^ "
<input type=submit name=act value=\"cp -v" ^ ropt ^ "\">
<input type=submit name=act value=\"mv -v\">
<input type=submit name=act value=\"ln -sv\">&nbsp;&nbsp;
<input type=submit name=act value=\"Other (specify)\">
<input type=text size=15 name=\"ucmd\" value=\"" ^ (henc (form "ucmd")) ^ "\">
&nbsp;&nbsp;
Options
<input type=text size=10 name=\"opts\" value=\"" ^ (henc (form "opts")) ^ "\">

</td></tr></table></form>
   <HR>
<FORM method=GET action=\"http://freebsd.org/cgi/man.cgi?\" target=_blank>
FreeBSD Mannual page (external jump): 
<INPUT name=query value=\"\"> <INPUT type=submit value=\"Search Manpage\"></FORM>

</center>
");;

let fileop _ =
  exist_check ();
  let dfn = form "dfn" in
  let dabsfn = if dfn <> "" && dfn.[0] <> '/' then (path_join fcwd dfn) else dfn in
  let dparam = ref ("&back=" ^ (form "back") ^ param) in
  let sdlink = ref slink in
  let ucmd =form "ucmd" in      
  let mess =  (form "act") in
  if mess = "" then (
    dparam := "&fn=" ^ efn ^  !dparam;
    pre "<h2><font color=red>Error : invalid action</font></h2>" 
  ) else (
    let rmess = if (slice mess 0 2)= "Ot" then ucmd else mess in
    let fromto =  "From:<font color=blue>" ^ habsfn ^ 
         "&nbsp; </font>To:<font color=blue>" ^ (henc dabsfn) ^ "</font><BR>" in
    if (form "doit") = "" then (
      dparam := "&fn=" ^ efn ^  !dparam;
      pr ("<h2>Do you really want to Execute '" ^ rmess ^ "' ? " ^
         " <" ^ !sdlink ^ "fileop&doit=yes&act=" ^ mess );
      match slice mess 0 2 with
        "Sy" | "Co" | "Re" -> 
           pr ("&dfn=" ^ (encode dfn) ^ !dparam ^ "\">Yes</a></h2>" ^ fromto )
        | _  -> 
           pr ("&spath=" ^ (encode (form "spath")) ^ 
             "&opts=" ^ (encode (form "opts")) ^
             "&ucmd=" ^ (encode ucmd) ^
             "&dfn=" ^ (encode dfn) ^ !dparam ^ "\">Yes</a></h2>" ^
             rmess ^ (form "opts") ^ " " ^ (henc (form "spath")) ^ " " ^ (henc dabsfn) )
    ) else(
      pre ("<h2>Executing '" ^ rmess ^ "':</h2>\t" );
      sdlink := "a href=\"" ^ script ^ "?cwd=" ^ 
        "&fn=" ^(encode dabsfn) ^ "&cmd=";
      try
       (match slice mess 0 2 with
        "Sy" ->  Unix.symlink absfn dabsfn
        | "Co" -> filecopy absfn dabsfn
        | "Re" -> Sys.rename absfn dabsfn
        | "cp" | "mv" | "ln"  -> 
          prsystem (mess ^ (form "opts") ^ " " ^ 
             (quote (form "spath")) ^ " " ^ (quote dabsfn) )
        | "he" | "ca" | "ta" -> 
          prsystem (mess ^ (form "opts") ^ " " ^ (quote (form "spath") ));
          sdlink := "a href=\"" ^ script ^ "?cwd=" ^ "&fn=" ^ eabsfn ^ "&cmd="
        | "Ot" -> 
          if ucmd = "" then 
             pre "<H2 align=center><font color=red>Error: No command given</font></h2>" 
          else let p1 = (quote (form "spath")) and p2 = (quote dabsfn) in
           let p1 = if p1 ="''" then "" else p1  and p2 = if p2 ="''" then "" else p2 in
           pre (ucmd ^ " " ^ p1 ^ " " ^ p2 ^ "<BR>");
           prsystem (ucmd ^ " " ^ p1 ^ " " ^ p2 )
        | _ -> pre ("mess=" ^ mess);());
       pre ("<H2 align=center>Done !</h2>")
      with _ -> 
       pre ("<H2 align=center>Error !</h2>")
    );
      pre ("<H2 align=center>
<" ^ !sdlink ^ "list" ^ !dparam ^ "\">Go to Listing</a>
<" ^ !sdlink ^ "menu" ^ !dparam ^ "\">Go to Menu</a></h2>")
  );;

let ctread _ =
     if !ct = "" then ( compile :=false;
       try ct := fileread absfn with _ -> () );;
let editmenu _ =    
    ctread ();
    if (find !ct "#!/bin/sh") = 0 then (compile :=false;shellform () )  
    else editfile ();;

let shx = (form "sh");;
let docmd cmd =
  match cmd with
  "" when shx <> "" -> doshx shx
  | "" | "help" -> help ()
  | "edit" -> editmenu ()
  | "open" -> let act = form "act" in if act = "" then openform ()
         else begin match slice act 0 3 with
           "Edi" -> editmenu ()
           | "She" -> ctread (); shellform ()
           | "Lis" -> listdir ()
           | "Menu" -> menu ()
           | _ -> if itsdir then listdir () else menu ()
           end
  | "sh" -> ctread (); shellform ()
  | "list" -> listdir ()
  | "menu" -> menu ()
  | "del" -> del_item ()
  | "tools" -> tools ()
  | "chmod" -> chmod_form ()
  | "chmodset" -> chmodset ()
  | "fileop" -> fileop ()
  | _ -> pre ("Command:'" ^ (henc cmd) ^ "' not supported (yet?)")
  ;;
           
docmd cmd;;
footer ();;