(* Le principe des tests pour un seul fichier est de faire la même opération 
dans le fichier "/" de notre système de fichier et dans le fichier 
"Dirfs.ref". *)

open Common
module type USERFS = Dirfs.USERFS;;
module type ROOT = sig val root : string end;;
module type SCRIPT = functor (U : USERFS) -> functor (F : ROOT) -> sig end;;

(* On rend le module Unix compatible avec USERFS *)
module Munix : USERFS = struct 
  module C = Common
  module Flag = struct type open_flag = O_RDWR | O_CREAT end
      (* Tmp est utilisé pour cacher le type open_flag, car il faut le redéfinir *)
  module Tmp :  sig
    type file_descr
    type file_perm = int
    val openfile : string -> Flag.open_flag list -> file_perm -> file_descr
    val close : file_descr -> unit
    type seek_command = SEEK_SET | SEEK_CUR | SEEK_END
    val lseek : file_descr -> int -> seek_command -> int
    val read : file_descr -> string -> int -> int -> int
    val write : file_descr -> string -> int -> int -> int
    val ftruncate : file_descr -> int -> unit
    val stat : string -> stats
    val sync : unit -> unit
    val umount : unit -> unit
    type dir_handle
    val opendir : string -> dir_handle
    val readdir : dir_handle -> string
    val closedir : dir_handle -> unit
    val mkdir : string -> file_perm -> unit
    val unlink : string -> unit 
  end = struct
    include Unix 
    let stat name = 
      let st = stat name in { 
      C.st_dev = st.st_dev; 
      C.st_nlink = st.Unix.st_nlink; 
      C.st_size = st.Unix.st_size; 
      C.st_ino = st.Unix.st_ino; 
      C.st_kind = 
      match st.st_kind with S_DIR -> C.S_DIR | _ -> C.S_REG; 
    }
    let openfile name flags = 
      let convert = function
          Flag.O_RDWR -> O_RDWR | Flag.O_CREAT -> O_CREAT in
      Unix.openfile name (List.map convert flags)
        
    let sync() = () 
    let umount () = () 
  end
  include Tmp 
  type open_flag = Flag.open_flag = O_RDWR | O_CREAT
end;;

type res = Val of string | Size of int;;
type tree = 
    Dir of (string * tree) list 
  | File of string
;;
module RunScript (S : SCRIPT) (U : USERFS) (F : ROOT) = 
  struct
    module Run = S (U) (F)
    open U
    exception Size_error of string * int
        
    let list_of_dir name = 
      let desc = opendir name in
      let rec find () = 
        try let entry = readdir desc in entry :: find()
        with End_of_file -> closedir desc; [] in
      List.sort compare (find ())
        
    let string_of_file name = 
      let size = (stat name).st_size in 
      let file = String.create size in
      let desc = openfile name  [ O_RDWR; O_CREAT; ] 0o666  in
      (* On recopie le fichier dans une chaîne *)
      let rec copy_loop len =
        if len > 0 then
          let r = read desc file (size - len) len in
          if r = 0 then raise (Size_error (name, len))
          else copy_loop (len - r)
        else 
          if read desc "#" 0 1 = 0 then file
          else raise (Size_error (name, (0 - len))) in
      let _ = Misc.try_finalize copy_loop size close desc in
      file
        
    let rec tar name = 
      let path = F.root ^ name in 
      name, 
      match (stat path).st_kind with
      | S_DIR ->
          let tardir entry = tar (Filename.concat name entry) in
          let all = list_of_dir path in
          let nodots = List.filter (fun s -> s <> "." && s <> "..") all in
          Dir (List.map tardir nodots)
      | S_REG -> 
          File (string_of_file path) 
    let res = tar ""
  end;;

let errors = ref 0
let failed s = incr errors; "FAILED: " ^s 
                                           
module type RES = sig val res : string end;;
module Apply (S : SCRIPT) : RES = 
  (* ATTENTION! ne pas éditer ce module *)
  struct
    let basename = "Dirfs"
    let res = 
      let unixroot = basename ^ ".tmp" in
      let rmrf = 
        (* ATTENTION! ne pas changer cette fonction... qui fait rm -r *)
        (* Abandonner si par hasard... ou par erreur le fichier existe *)
        try 
          let () = Unix.access unixroot [ Unix.F_OK ] in
          Printf.eprintf "Le répertoire %s ne devrait pas exister:\n%s\n%!" 
            unixroot
            "    Est-ce par hasard ou suite à une erreur? \n    \
                 Détruisez-le manuellement avant de lancer les tests";
          exit 2 
        with Unix.Unix_error (Unix.ENOENT, _,_) -> 
          fun () -> Sys.command (Printf.sprintf "rm -rf %s" unixroot) 
        | Unix.Unix_error (x,y,z) -> 
            Printf.eprintf "%s: %s %s\n%!" y (Unix.error_message x) z;
            exit 2 in
      
      let () = 
        if Sys.command (Printf.sprintf "tar -z -xf %s.tgz" basename) <> 0 then 
          begin
            Printf.eprintf
              "L'extraction de l'archive %s à échoué\n%!" (basename ^ ".tgz");
            exit 2 
          end in
      try 
        let module Fimg = struct let name = basename ^ ".img" end in
        let module U =  Dirfs.Mount (Disk.Opendisk (Fimg)) in
        let module Rdisk = struct let root = "/" end in
        let module Runix = struct let root = basename ^ ".tmp/" end in
        let module B1 = RunScript(S) (U) (Rdisk) in
        let module B2 = RunScript(S) (Munix) (Runix) in
        let () = 
          if rmrf() <> 0 then begin
            Printf.eprintf "Cleaning up of %s failed\n" unixroot;
            exit 2 
          end in
        (* let module D = Disk.Opendisk (Fimg) in *)
        (* let () = D.print(); D.close(); print_newline() in *)
        (* On compare les résultats *)
        let sort = List.sort (fun (n1,_) (n2,_) -> compare n1 n2) in
        let rec diff t1 t2 = 
          match t1, t2 with
          | [], [] -> "OK"
          | (n1, _) :: _, [] ->
              failed (Printf.sprintf "File %s superflous" n1)
          | [], (n2, _) :: _ -> 
              failed (Printf.sprintf "File %s missing" n2)
          | (n1, _) :: r1, (n2, _) :: r2 when n1 < n2 -> 
              failed (Printf.sprintf "File %s superfluous" n1)
          | (n1, _) :: r1, (n2, _) :: r2 when n1 > n2 -> 
              failed (Printf.sprintf "File %s missing" n2)
          | (n1, File s1) :: _, (n2, Dir s2) :: _ -> 
              failed (Printf.sprintf "File %s should be a Dir" n1)
          | (n1, Dir s1) :: _, (n2, File s2) :: _ -> 
              failed (Printf.sprintf "Dir %s should be a File" n1)
          | (n1, File s1) :: r1, (n2, File s2) :: r2 when s1 <> s2 -> 
              failed (Printf.sprintf 
                        "File %s content differs\n[%s]\n[%s]" n1 s1 s2)
          | (n1, File s1) :: r1, (n2, File s2) :: r2 -> 
              diff r1 r2
          | (n1, Dir d1) :: r1, (n2, Dir d2) :: r2 ->
              let s = diff (sort r1) (sort r2) in
              if s = "OK" then diff (sort r1) (sort r2) 
              else s
        in
        diff [ B1.res ] [ B2.res ]
        with exn -> 
          "Exception: " ^ (Printexc.to_string exn)
  end ;;


module Dir (U : USERFS) (F : ROOT) = 
  struct
    open U
    let desc = openfile F.root [ O_RDWR; O_CREAT; ] 0o666
    let n = lseek desc 500 SEEK_END
    let _ = close desc
  end;;

(* Vous pouvez peut ajouter d'autres tests ici *)
(* Attention, les chemins doivent être préfixés par ! comme ci-dessous *)
module Nothing (U : USERFS) (F : ROOT) = 
  struct
  end;;


module Mkdir1 (U : USERFS) (F : ROOT) = 
  struct
    open U
    let (!) x = F.root ^ "." ^ x 
    let _ = mkdir !"/home" 0o777
  end;;

module Mkdir2 (U : USERFS) (F : ROOT) = 
  struct
    open U
    let (!) x = F.root ^ "." ^ x 
    let _ = mkdir !"/home" 0o777
    let _ = mkdir !"/home/foo" 0o777
  end;;

module CreateFile1 (U : USERFS) (F : ROOT) = 
  struct
    open U
    let (!) x = F.root ^ "." ^ x 
    let desc = openfile !"/log" [ O_RDWR; O_CREAT; ] 0o666
    let _ = close desc
  end;;

module Unlink (U : USERFS) (F : ROOT) = 
  struct
    open U
    let (!) x = F.root ^ "." ^ x 
    let _ = unlink !"/tmp/foo" 
  end;;

module All (U : USERFS) (F : ROOT) = 
  struct
    open U
    let (!) x = F.root ^ "." ^ x 
    let _ = mkdir !"/tmp/home" 0o777
    let _ = mkdir !"/tmp/home/foo" 0o777
    let _ = mkdir !"/tmp/home/bar" 0o777
    let _ = unlink !"/tmp/foo" 
    let _ = mkdir !"/tmp/gnu" 0o777
    let _ = mkdir !"/tmp/foo" 0o777
    let desc = openfile !"/tmp/foo/log" [ O_RDWR; O_CREAT; ] 0o666 
    let () = 
      let str =  "On écrit un petit bout de texte dans /home/user/tmp" in
      let _ = write desc str  0 (String.length str) in
      let str =  "qui ne loge pas sur un bloc" in
      let _ = write desc str  0 (String.length str) in
      ()
    let _ = close desc
  end;;

let () = 
  (* on effectue les test en série *)
  let run q r = Printf.printf "%s: %s\n%!" q r in
  run "nothing (initial state)" 
    (let module R = Apply(Nothing) in R.res); 
  run "mkdir1 (Cree un repertoire)" 
    (let module R = Apply(Mkdir1) in R.res); 
  run "mkdir2 (Cree repertoire et sous-repertoires)" 
    (let module R = Apply(Mkdir2) in R.res); 
  run "CreateFile1 (Cree un fichier simple) " 
    (let module R = Apply(CreateFile1) in R.res); 
  run "Unlink (detruit un fichier)" 
    (let module R = Apply(Unlink) in R.res); 
  run "All (un peu de tout)" 
    (let module R = Apply(All) in R.res); 
  ();;


let () = if !errors > 0 then exit 1 else exit 0