(*
 * Utilities on filenames.
 *)

type pathname = string list

(*
 * Tests for whether a file is executable.
 *)
let euid =
   try Unix.geteuid () with
      Unix.Unix_error _ ->
         0

let groups =
   try Array.to_list (Unix.getgroups ()) with
      Unix.Unix_error _ ->
         []

let unix_is_executable s =
   let flag =
      try
         let { Unix.LargeFile.st_kind = kind;
               Unix.LargeFile.st_perm = perm;
               Unix.LargeFile.st_uid = uid;
               Unix.LargeFile.st_gid = gid; _
             } = Unix.LargeFile.stat s
         in
            (kind = Unix.S_REG)
            && ((perm land 0o001) <> 0
                || (List.mem gid groups && (perm land 0o010) <> 0)
                || (uid = euid && (perm land 0o100) <> 0))
      with
         Unix.Unix_error _ ->
            false
   in
      if flag then
         Some s
      else
         None

(*
 * On Windows, the file does not have the be executable,
 * it just has to exist.
 *)
let win32_suffixes =
   [""; ".com"; ".exe"; ".bat"; ".cmd"]

let win32_is_executable =
   let rec search_win32 suffixes name =
      match suffixes with
         suffix :: suffixes ->
            let name' = name ^ suffix in
               if Sys.file_exists name' then
                  Some name'
               else
                  search_win32 suffixes name
       | [] ->
            None
   in
      search_win32 win32_suffixes

(*
 * Cygwin is weird. See http://cygwin.com/cygwin-ug-net/using-specialnames.html#id4745135
 * and http://bugzilla.metaprl.org/show_bug.cgi?id=496#c11
 *)
let cygwin_is_executable name =
   match unix_is_executable (name ^ ".exe") with
      Some _ as res -> res
    | None ->
         begin match unix_is_executable name with
            Some _ as res' -> res'
          | None -> None
         end

(*
 * System-dependent config.
 * On win32, use lowercase names, and watch for drive letters.
 *)
let has_drive_letters,
    normalize_string,
    normalize_path,
    search_separator_char,
    is_executable =
   match Sys.os_type with
   | "Win32" ->
       true, String.lowercase_ascii, List.map String.lowercase_ascii, ';', win32_is_executable
   | "Cygwin" ->
       false, String.lowercase_ascii, List.map String.lowercase_ascii, ':', cygwin_is_executable
   | "Unix" ->
       false, (fun s -> s), (fun s -> s),  ':', unix_is_executable
   | s ->
         raise (Invalid_argument ("Omake_node: unknown system type " ^ s))
         
let separator_string = Filename.dir_sep

(* TODO Mantis ticket to *)
let separator_char = separator_string.[0]
let search_separator_string = String.make 1 search_separator_char

(*
 * Utilities for splitting paths.
 *)
(* %%MAGICBEGIN%% *)
type root =
  | NullRoot
  | DriveRoot of char

type 'a path =
  | RelativePath of 'a
  | AbsolutePath of root * 'a
(* %%MAGICEND%% *)

let null_root = NullRoot

(*
 * Windows sucks.  Here are some utilities to
 * analyze drve letters.
 *)
let is_drive_letter c =
   match c with
   |'a'..'z'
   |'A'..'Z' -> true
   | _ -> false

let drive_skip name =
   let len = String.length name in
      if has_drive_letters && len >= 2 && is_drive_letter name.[0] && name.[1] = ':' then
         2
      else
         0

let is_slash c =
   match c with
      '/'
    | '\\' ->
         true
    | _ ->
         false

let is_absolute name =
   let len = String.length name in
      (len >= 3 && is_drive_letter name.[0] && name.[1] = ':' && is_slash name.[2]) || (len >= 1 && is_slash name.[0])

(*
 * Print the drive letter.
 *)
let string_of_root = function
   NullRoot ->
      separator_string
 | DriveRoot c ->
      let s = Bytes.make 3 c in
      Bytes.set s 1 ':';
      Bytes.set s 2 separator_char;
      Bytes.to_string s

(*
 * Unescape a possibly quoted filename.
 * The only things we unquote are quotations.
 *)
let unescape_string s =
   let len = String.length s in
   let rec start i =
      if i = len then
         s
      else
         match String.unsafe_get s i with
            '"' ->
               let buf = Buffer.create len in
                  Buffer.add_substring buf s 0 i;
                  dquote buf (succ i)
          | '\'' ->
               let buf = Buffer.create len in
                  Buffer.add_substring buf s 0 i;
                  squote buf (succ i)
          | _ ->
               start (succ i)

   and dquote buf i =
      if i = len then
         Buffer.contents buf
      else
         match String.unsafe_get s i with
            '"' ->
               normal buf (succ i)
          | '\\' when i < len - 1 ->
               (match s.[i + 1] with
                   '"' ->
                      Buffer.add_char buf '"';
                      dquote buf (i + 2)
                 | _ ->
                      Buffer.add_char buf '\\';
                      dquote buf (succ i))
          | c ->
               Buffer.add_char buf c;
               dquote buf (succ i)

   and squote buf i =
      if i = len then
         Buffer.contents buf
      else
         match String.unsafe_get s i with
            '\'' ->
               normal buf (succ i)
          | '\\' when i < len - 1 ->
               (match s.[i + 1] with
                   '\'' ->
                      Buffer.add_char buf '\'';
                      dquote buf (i + 2)
                 | _ ->
                      Buffer.add_char buf '\\';
                      dquote buf (succ i))
          | c ->
               Buffer.add_char buf c;
               dquote buf (succ i)

   and normal buf i =
      if i = len then
         Buffer.contents buf
      else
         match String.unsafe_get s i with
            '"' ->
               dquote buf (succ i)
          | '\'' ->
               squote buf (succ i)
          | c ->
               Buffer.add_char buf c;
               normal buf (succ i)
   in
      start 0

(*
 * Split the path into root part, and the rest.
 *)
let filename_string name =
   let len = String.length name in
      if has_drive_letters && len >= 3 && is_drive_letter name.[0] && name.[1] = ':' && (name.[2] = '/' || name.[2] = '\\') then
         let root = DriveRoot (Char.lowercase_ascii name.[0]) in
         let path = String.sub name 3 (len - 3) in
         AbsolutePath (root, path)
      else if len >= 1 && name.[0] = '/' then
         let root = NullRoot in
         let path = String.sub name 1 (len - 1) in
         AbsolutePath (root, path)
      else
         RelativePath name

(*
 * Be careful not to split on glob characters.
 *)
(* let is_glob_char s i = *)
(*    match String.unsafe_get s i with *)
(*       '{' | '}' | '*' | '?' | '[' | ']' -> *)
(*          true *)
(*     | _ -> *)
(*          false *)

(* let filename_split name = *)
(*    let len = String.length name in *)
(*    let rec collect path off i = *)
(*       if i = len then *)
(*          let path = *)
(*             if i <= succ off then *)
(*                path *)
(*             else *)
(*                String.sub name off (i - off) :: path *)
(*          in *)
(*             List.rev path *)
(*       else *)
(*          let c = String.unsafe_get name i in *)
(*             match c with *)
(*                '/' -> *)
(*                   if i <= succ off then *)
(*                      collect path i (succ i) *)
(*                   else *)
(*                      collect (String.sub name off (i - off) :: path) i (succ i) *)
(*              | '\\' -> *)
(*                   if i < len - 1 && is_glob_char name (succ i) then *)
(*                      collect path off (i + 2) *)
(*                   else if i <= succ off then *)
(*                      collect path i (succ i) *)
(*                   else *)
(*                      collect (String.sub name off (i - off) :: path) i (succ i) *)
(*              | _ -> *)
(*                   collect path off (succ i) *)
(*    in *)
(*       collect [] 0 0 *)

(*
 * Split the rest into parts.
 *)
let filename_path name =
   match filename_string name with
      AbsolutePath (root, path) ->
         AbsolutePath (root, Lm_string_util.split "\\/" path)
    | RelativePath path ->
         RelativePath (Lm_string_util.split "\\/" path)

(*
 * Split a filename into root/suffix.
 *)
let split name =
   try
      let index = String.rindex name '.' in
      let len = String.length name in
      let root = String.sub name 0 index in
      let suffix = String.sub name index (len - index) in
         root, suffix
   with
      Not_found ->
         name, ""

(*
 * Separate this for efficiency.
 *)
let root name =
   try
      let index = String.rindex name '.' in
         String.sub name 0 index
   with
      Not_found ->
         name

let suffix name =
   try
      let index = String.rindex name '.' in
         String.sub name index (String.length name - index)
   with
      Not_found ->
         ""

let strip_suffixes name =
   let start =
      try String.rindex name '/' with
         Not_found ->
            try String.rindex name '\\' with
               Not_found ->
                  0
   in
      try
         let index = String.index_from name start '.' in
            String.sub name 0 index
      with
         Not_found ->
            name


let separators = "/\\"


(*  Path separator. *)
let pathsep =
   if Sys.os_type = "Win32" then
      ";"
   else
      ":"

(*
 * Split a pathname.
 *)
let split_path = Lm_string_util.split separators

(*
 * Put it back together.
 *)
let concat_path = String.concat separator_string

(*
 * Basic file operations.
 *)
let basename s =
   try
      let i = Lm_string_util.rindex_set s separators + 1 in
         String.sub s i (String.length s - i)
   with
      Not_found ->
         s

let replace_basename s1 s2 =
   try
      let i = Lm_string_util.rindex_set s1 separators in
         Filename.concat (String.sub s1 0 i) s2
   with
      Not_found ->
         s2

(*
 * Simplify, remove leading directory.
 *)
let simplify_path path =
   let rec simplify path' = function
     | dir::tl ->
         if dir = "" || dir = "." then
            simplify path' tl
         else if dir = ".." then
            match path' with
               [] ->
                  simplify path' tl
             | _::path'' ->
                  simplify path'' tl
         else
            simplify (dir :: path') tl
    | [] ->
         List.rev path'
   in
      simplify [] path

(*
 * Path searching.
 *)
let search_table = Hashtbl.create 19

(*
 * Get the system path.
 *)
let search_path =
   let path =
      try Sys.getenv "PATH" with
         Not_found ->
            "."
   in
   let path = Lm_string_util.split search_separator_string path in
      List.filter (fun name -> not (Filename.is_relative name)) path

(*
 * Search for the file in the path.
 * Win32 files do not need to be executable.
 *)
let search_command name =
   let rec search dirs name =
      match dirs with
         dir :: dirs ->
            let pathname = Filename.concat dir name in
               (match is_executable pathname with
                   Some pathname ->
                      pathname
                 | None ->
                      search dirs name)
       | [] ->
            raise Not_found
   in
      search search_path name

(*
 * Figure out where in the path the commands comes from.
 *)
let which name =
   if Filename.is_relative name then
      if Lm_string_util.contains_any name separators then
         let name = Filename.concat (Sys.getcwd ()) name in
            match is_executable name with
               Some fullname ->
                  fullname
             | None ->
                  raise Not_found
      else
         try Hashtbl.find search_table name with
            Not_found ->
               let fullname = search_command name in
                  Hashtbl.add search_table name fullname;
                  fullname
   else
      match is_executable name with
         Some fullname ->
            fullname
       | None ->
            raise Not_found

(*
 * Use the directory as the starting point for relative names.
 *)
let which_dir dir name =
   if Filename.is_relative name then
      if Lm_string_util.contains_any name separators then
         let name = Filename.concat dir name in
            match is_executable name with
               Some fullname ->
                  fullname
             | None ->
                  raise Not_found
      else
         try Hashtbl.find search_table name with
            Not_found ->
               let fullname = search_command name in
                  Hashtbl.add search_table name fullname;
                  fullname
   else
      match is_executable name with
         Some fullname ->
            fullname
       | None ->
            raise Not_found

(*
 * Figure out where in the path the commands comes from.
 * Return all matches in order.
 *)
let where name =
   if Lm_string_util.contains_any name separators then
      raise (Invalid_argument "Lm_filename_util.where");
   let path =
      try Sys.getenv "PATH" with
         Not_found ->
            "."
   in
   let path = Lm_string_util.split search_separator_string path in
   let find dir = is_executable (Filename.concat dir name) in
      Lm_list_util.some_map find path

(*
 * Make a directory hierarchy.
 *)
let mkdirhier dir mode =
   let rec mkdir dir path =
      match path with
      | head :: path ->
          let dir = Filename.concat dir head in
          let () =
            try
                  let s = Unix.LargeFile.stat dir in
                     if s.st_kind <> S_DIR then
                        raise (Unix.Unix_error (Unix.ENOTDIR, "Lm_filename_util.mkdirhier", dir))
               with
                  Unix.Unix_error (Unix.ENOENT, _, _) ->
                     try Unix.mkdir dir mode with
                        Unix.Unix_error (Unix.EEXIST, _, _) ->
                           ()
            in
               mkdir dir path
       | [] ->
            ()
   in
   let path = filename_path dir in
   let top, path =
      match path with
         AbsolutePath (root, path) ->
            string_of_root root, path
       | RelativePath path ->
            ".", path
   in
      mkdir top path


