open Unix;;

(* analyse des arguments *)

let options = ref false;;
let file_list = ref [];;
let max_depth = ref max_int;;
let filter_list = ref [];;
let stat_function = ref lstat;;

let usage_string  =
  ("Usage: " ^ Sys.argv.(0) ^ " [files...] [options...]");;

let prerr_usage () =
  prerr_string usage_string;
  prerr_newline ();;

let maxdepth_opt n =
  options := true;
  max_depth := n;;

let type_opt t =
  let f = fun t n s -> s.st_kind = t in
  match t with
    "f" -> filter_list := (f S_REG) :: !filter_list
  | "l" -> filter_list := (f S_LNK) :: !filter_list
  | "d" -> filter_list := (f S_DIR) :: !filter_list
  | "b" -> filter_list := (f S_BLK) :: !filter_list
  | "c" -> filter_list := (f S_CHR) :: !filter_list
  | "s" -> filter_list := (f S_SOCK) :: !filter_list
  | "p" -> filter_list := (f S_FIFO) :: !filter_list
  | _ -> raise (Arg.Bad t) ;;

let atime_opt d =
  let f = fun n s ->
    let access_time = int_of_float (Unix.time() -. s.st_atime) in
    (d + 1) * 86400 > access_time  && access_time > d * 86400 in
  filter_list := f ::!filter_list;;

let follow_opt () =
  stat_function := stat;;

let regex_opt r =
  let regexp = Str.regexp r in
  let f n s = Str.string_match regexp n 0 in
  filter_list := f :: !filter_list;;

let file_arg name =
  if !options then prerr_usage ()
  else file_list := name :: !file_list;;

(* fonctions auxilaires *)

let filter filename filestat filters =
  List.for_all (fun f -> f filename filestat) filters;;

let iter_dir f d =
  let dir_handle = opendir d in
  try while true do f (readdir dir_handle) done with
    End_of_file -> closedir dir_handle
  | x -> closedir dir_handle; raise x;;

let errors = ref false;;
let allow_unix_error f x =
  try f x
  with Unix_error (e,b,c) ->
    errors := true;
    prerr_string (Sys.argv.(0)^": " ^c^ ": " ^(error_message e));
    prerr_newline();;

(* fonction principale *)
let rec find depth filename =
  let filestat = !stat_function filename in
  if filter filename filestat !filter_list then print_endline filename;
  if depth < !max_depth && filestat.st_kind = S_DIR then
    let process_child child =
      if (child <> Filename.current_dir_name &&
          child <> Filename.parent_dir_name) then
        let child_name = Filename.concat filename child in
        let childstat = !stat_function child_name in
        find (depth+1) child_name
    in
    (* process_child et iter_dir peuvent générer des erreurs *)
    (* et doivent donc être protégées *)
    allow_unix_error
      (iter_dir (allow_unix_error process_child))
      filename;;

(* le programme *)
let mon_find () =
  let opt_list =
    [ ("-maxdepth", Arg.Int maxdepth_opt, "max depth search");
      ("-type", Arg.String type_opt, "file type");
      ("-atime", Arg.Int atime_opt, "file accessed n*24 hours ago");
      ("-follow", Arg.Unit follow_opt, "follow symlinks");
      ("-regex", Arg.String regex_opt, "file name matches regexp") ] in
  Arg.parse opt_list file_arg usage_string;
  filter_list := List.rev !filter_list;
  begin match !file_list with
    [] -> find 0 Filename.current_dir_name
  | _ -> List.iter (find 0) (List.rev !file_list)
  end;
  if !errors then exit 1;;

handle_unix_error mon_find();;