(* Run external shell functions.
 * $Id: cocanwiki_func_shell.ml,v 1.1 2006/12/08 15:36:44 rich Exp $
 *)

open Printf
open ExtString
open ExtList

open Cocanwiki_extensions

(* This exception is thrown if there is an error during processing.  The
 * string is an error message.
 *)
exception Error of string

let ws_re = Pcre.regexp "\\s+"

(* Disallowed in commands, if path is given. *)
let reserved = [ ".."; "/"; "\\" ]

let shell r dbh hostid arg =
  try
    (* Is this function enabled for this host?  This is a safety feature
     * to ensure that people only turn this feature on if they really
     * mean to.
     *)
    let rows =
      PGSQL(dbh) "select enable_shell_func from hosts where id = $hostid" in
    if rows <> [true] then
      raise (Error "Shell function is disabled on this host.  You have to enable it manually by setting enable_shell_func and optionally set enable_shell_func_path for the relevant row in the hosts table.  This function is dangerous because it allows editors to run arbitrary shell commands on the server.");

    let arg = match arg with
      | None -> raise (Error ("missing command name: try {{shell:command}}"))
      | Some arg -> arg in

    let args = Pcre.split ~rex:ws_re arg in
    let command, args =
      match args with
      | command :: args -> command, args
      | _ -> raise (Error ("missing command name: try {{shell:command}}")) in

    (* If the path is specified, then limit commands to run in this path.
     * Disallow '..', '/' and '\'.
     * If NO PATH is specified, then allow ARBITRARY commands to run (DANGER!)
     *)
    let path =
      List.hd (
	PGSQL(dbh)
	  "select enable_shell_func_path from hosts where id = $hostid"
      ) in
    let command =
      match path with
      | None -> command			(* Any command can run. *)
      | Some path ->
	  (* Disallow reserved characters. *)
	  if List.exists (String.exists command) reserved then
	    raise (Error "command contains reserved characters (eg. '..' or '/').");
	  Filename.concat path command in

    (* Run the command and capture the output. *)
    let cmd =
      command ^ " " ^ String.concat " " (List.map Filename.quote args) in
    prerr_endline cmd;
    let chan = Unix.open_process_in cmd in
    let lines = ref [] in
    let lines =
      try
        while true; do
	  let line = input_line chan in
	  lines := line :: !lines
	done;
	List.rev !lines
      with
	End_of_file -> List.rev !lines in
    let stat = Unix.close_process_in chan in
    (match stat with
     | Unix.WEXITED 0 -> ()
     | Unix.WEXITED i ->
	 raise (Error ("command failed with code " ^ string_of_int i))
     | Unix.WSIGNALED i ->
	 raise (Error ("command killed by signal " ^ string_of_int i))
     | Unix.WSTOPPED i ->
	 raise (Error ("command stopped by signal " ^ string_of_int i)));

    String.concat "\n" lines
  with
    Error msg ->
      "shell: " ^ Cgi_escape.escape_html msg

(* Register function. *)
let () =
  external_functions := ("shell", shell) :: !external_functions