(* $Id: filesys.ml 16166 2008-01-17 22:59:55Z gerd $ *)

(* File system tool *)

open Printf
open Seqdb_fsys_ht


let itype_of_string s =
  match s with
    | "plain" -> `Plain
    | "stored_hashes" -> `Stored_hashes
    | _ -> raise(Arg.Bad("bad index type: " ^ s))

let parse_time t =
  Netdate.since_epoch (Netdate.parse t)

let cmd_create pgm_name =
  let fsysn = ref None in
  let index_size = ref 1000 in
  let index_type = ref `Plain in
  let have_dups = ref false in
  let ao = ref None in
  Arg.parse
    [ "-index-size", Arg.Set_int index_size, "<n>  Set the size of the index";
      "-index-type", (Arg.String (fun s ->
				    index_type := itype_of_string s)),
      "(plain|stored_hashes)  Set the index type";
      "-have-dups", Arg.Set have_dups,
      "   Allow duplicate entries in data files";

      "-ao", (Arg.Int (fun n -> ao := Some n)),
      "<n>  Set append-only with a distance between time marks of <n> seconds";
    ]
    (fun s ->
       match !fsysn with
         | None -> fsysn := Some s
         | Some _ ->
             raise(Arg.Bad("Unexpected arg: " ^ s)))
    (sprintf "usage: %s create [options] fsys" pgm_name);

  let fsysn =
    match !fsysn with
      | Some f -> f 
      | None -> failwith "Argument expected" in
  
  let p =
    { ht_inode_size = 512;
      ht_table_size = !index_size;
      ht_hash_algo = `MD5;
      ht_index_type = !index_type;
      ht_have_dups = !have_dups;
    } in

  let base = new_base (Filename.dirname fsysn) in
  let fsys = 
    match !ao with
      | None ->
	  create_filesys base (Filename.basename fsysn) p 
      | Some n ->
	  let aop =
	    { Seqdb_fsys_ao.ao_time_mark_period = n } in
	  Seqdb_fsys_ao.create_ao_filesys base (Filename.basename fsysn) p aop
  in
  fsys#checkpoint();
  fsys#dispose();

  print_endline "Created"
;;


let cmd_reindex pgm_name =
  let fsysn = ref None in
  let index_size = ref None in
  let index_type = ref None in
  let tolerant = ref false in
  let index_iteration = ref false in
  let fully_buffered_index = ref false in
  Arg.parse
    [ "-index-size", Arg.Int (fun k -> index_size := Some k), "<n>  Change the size of the index";
      "-index-type", (Arg.String (fun s ->
				    index_type := Some(itype_of_string s))),
      "(plain|stored_hashes)  Change the index type";

      "-fault-tolerant", Arg.Set tolerant, "  Try to ignore some errors";

      "-index-iteration", Arg.Set index_iteration,
      "   Create the new index by iterating over the old index and checking";

      "-fully-buffered-index", Arg.Set fully_buffered_index,
      "   Keep the whole index in memory while it is built";
    ]
    (fun s ->
       match !fsysn with
         | None -> fsysn := Some s
         | Some _ ->
             raise(Arg.Bad("Unexpected arg: " ^ s)))
    (sprintf "usage: %s reindex [options] fsys" pgm_name);

  let fsysn =
    match !fsysn with
      | Some f -> f 
      | None -> failwith "Argument expected" in
  
  let base = new_base (Filename.dirname fsysn) in
  let fsys = get_filesys base (Filename.basename fsysn) in
  let old_params = filesys_params base (Filename.basename fsysn) in
  let params =
    match !index_size with
      | None -> old_params
      | Some s -> { old_params with ht_table_size = s } in
  let params =
    match !index_type with
      | None -> params
      | Some it -> { params with ht_index_type = it } in
  let itype = if !index_iteration then `Index else `Data in
  let success =
    reindex
      ~fault_tolerant:!tolerant ~itype 
      ~fully_buffered_index:!fully_buffered_index
      base (Filename.basename fsysn) params in
  fsys#dispose();

  if success then
    print_endline "Reindexed"
  else
    print_endline "Failure"
;;


let cmd_compact pgm_name =
  let fsysn = ref None in
  let index_type = ref None in
  let index_size = ref None in
  let index_iteration = ref false in
  let tolerant = ref false in
  let fully_buffered_index = ref false in
  Arg.parse
    [ "-index-size", Arg.Int (fun k -> index_size := Some k), "<n>  Set the size of the index";

      "-index-type", (Arg.String (fun s ->
				    index_type := Some(itype_of_string s))),
      "(plain|stored_hashes)  Change the index type";

      "-fault-tolerant", Arg.Set tolerant, "  Try to ignore some errors";

      "-index-iteration", Arg.Set index_iteration,
      "   Create the new index by iterating over the old index and checking";

      "-fully-buffered-index", Arg.Set fully_buffered_index,
      "   Keep the whole index in memory while it is built";
    ]
    (fun s ->
       match !fsysn with
         | None -> fsysn := Some s
         | Some _ ->
             raise(Arg.Bad("Unexpected arg: " ^ s)))
    (sprintf "usage: %s compact [options] fsys" pgm_name);

  let fsysn =
    match !fsysn with
      | Some f -> f 
      | None -> failwith "Argument expected" in
  
  let base = new_base (Filename.dirname fsysn) in
  let fsys = get_filesys base (Filename.basename fsysn) in
  let old_params = filesys_params base (Filename.basename fsysn) in
  let params =
    match !index_size with
      | None -> old_params
      | Some s -> { old_params with ht_table_size = s } in
  let params =
    match !index_type with
      | None -> params
      | Some it -> { params with ht_index_type = it } in
  let itype = if !index_iteration then `Index else `Data in
  let success = 
    compact
      ~fault_tolerant:!tolerant ~itype
      ~fully_buffered_index:!fully_buffered_index
      base (Filename.basename fsysn) params in
  fsys#dispose();

  if success then
    print_endline "Compacted"
  else 
    print_endline "Failure"
;;


let cmd_repair pgm_name =
  let fsysn = ref None in
  Arg.parse
    [ ]
    (fun s ->
       match !fsysn with
         | None -> fsysn := Some s
         | Some _ ->
             raise(Arg.Bad("Unexpected arg: " ^ s)))
    (sprintf "usage: %s repair [options] fsys" pgm_name);

  let fsysn =
    match !fsysn with
      | Some f -> f 
      | None -> failwith "Argument expected" in
  
  let base = new_base (Filename.dirname fsysn) in
  check_filesys base (Filename.basename fsysn);
  let fsys = get_filesys base (Filename.basename fsysn) in
  let params = filesys_params base (Filename.basename fsysn) in
  let success = 
    reindex ~itype:`Index ~repair:true ~fault_tolerant:true 
      base (Filename.basename fsysn) params in
  fsys#dispose();

  if success then
    print_endline "Repaired"
  else
    print_endline "Failure"
;;


let cmd_list pgm_name =
  let long = ref false in
  let fsysn = ref None in
  let dedup_mode = ref `Off in
  let at_mtime = ref None in
  Arg.parse
    [ "-l", Arg.Set long,
      "  Output more info per file";

      "-dedup-twopass", Arg.Unit(fun ()-> dedup_mode := `Twopass),
      "  Dedup output by performing two passes (if dups are possible)";

      "-dedup-indexcheck", Arg.Unit(fun ()-> dedup_mode := `Indexcheck),
      "  Dedup output by checking with index (if dups are possible)";

      "-at-mtime", Arg.String (fun k -> 
				 at_mtime := Some(Int64.of_float(parse_time k))),
      "<n>  Start listing at mtime <n> (seconds since epoch) - only append-only fsys!"
    ]
    (fun s ->
       match !fsysn with
         | None -> fsysn := Some s
         | Some _ ->
             raise(Arg.Bad("Unexpected arg: " ^ s)))
    (sprintf "usage: %s list [options] fsys" pgm_name);

  let fsysn =
    match !fsysn with
      | Some f -> f 
      | None -> failwith "Argument expected" in
  
  let base = new_base (Filename.dirname fsysn) in
  let fsys = get_filesys base (Filename.basename fsysn) in
  let iter = 
    match !at_mtime with
      | None ->
	  get_iterator ~dedup_mode:!dedup_mode base (Filename.basename fsysn) 
      | Some m ->
	  Seqdb_fsys_ao.get_ao_iterator ~at_mtime:m base
	    (Filename.basename fsysn) in
  ( try
      let iobj = iter # start() in
      while true do
	if !long then (
	  let n = iobj#current_name in
	  let f = iobj#current_file in
	  printf "%c %-36s %9Ld %s\n"
	    (fsys#file_type f)
	    n
	    (fsys#file_size f)
	    (Netdate.format
               "%c %z"
               (Netdate.create ~zone:Netdate.localzone ((Int64.to_float (fsys#file_mtime f)))
	       )
	    )
	)
	else
	  print_endline iobj#current_name;
	iobj # next()
      done
    with
      | End_of_file -> ()
  );
  fsys#dispose()
;;


let cmd_get pgm_name =
  let fsysn = ref None in
  let filen = ref None in
  Arg.parse
    []
    (fun s ->
       match !fsysn with
         | None -> fsysn := Some s
         | Some _ ->
	     ( match !filen with
		 | None -> filen := Some s
		 | Some _ ->
		     raise(Arg.Bad("Unexpected arg: " ^ s))))
    (sprintf "usage: %s get [options] fsys file" pgm_name);

  let fsysn =
    match !fsysn with
      | Some f -> f 
      | None -> failwith "Argument expected" in

  let filen =
    match !filen with
      | Some f -> f 
      | None -> failwith "Argument expected" in

  let base = new_base (Filename.dirname fsysn) in
  let fsys = get_filesys base (Filename.basename fsysn) in
  let file = fsys#open_file_rd filen [] in
  let s = String.create 4096 in
  let k = ref 0L in
  let n = fsys#file_size file in
  while !k < n do
    let m = fsys#read_file file s 0 !k (String.length s) in
    output stdout s 0 m;
    k := Int64.add !k (Int64.of_int m)
  done;
  fsys#dispose()
;;


let cmd_put pgm_name =
  let fsysn = ref None in
  let filen = ref None in
  let ftype = ref 'x' in
  let append = ref false in
  Arg.parse
    [ "-type", Arg.String (fun s -> 
			     if String.length s <> 1 then
			       raise(Arg.Bad("-type must be exactly 1 char"));
			     ftype := s.[0]),
      "<t>  Set the file type to <t> for new files (instead of 'x')";

      "-append", Arg.Set append,
      "  Append to file";
    ]
    (fun s ->
       match !fsysn with
         | None -> fsysn := Some s
         | Some _ ->
	     ( match !filen with
		 | None -> filen := Some s
		 | Some _ ->
		     raise(Arg.Bad("Unexpected arg: " ^ s))))
    (sprintf "usage: %s put [options] fsys file" pgm_name);

  let fsysn =
    match !fsysn with
      | Some f -> f 
      | None -> failwith "Argument expected" in

  let filen =
    match !filen with
      | Some f -> f 
      | None -> failwith "Argument expected" in

  let base = new_base (Filename.dirname fsysn) in
  let fsys = get_filesys base (Filename.basename fsysn) in
  let file,_ = fsys#open_file_wr filen [] (Some !ftype) in
  let s = String.create 4096 in
  let k = ref 0L in
  if !append then k := fsys#file_size file;
  ( try
      while true do
	let n = input stdin s 0 (String.length s) in
	if n=0 then raise End_of_file;
	fsys#write_file file s 0 !k n;
	k := Int64.add !k (Int64.of_int n)
      done
    with End_of_file -> 
      ()
  );
  fsys#truncate file !k;
  fsys#checkpoint();
  fsys#dispose()
;;


let cmd_delete pgm_name =
  let fsysn = ref None in
  let filen = ref None in
  let only_index = ref false in
  Arg.parse
    [ "-only-index", Arg.Set only_index,
      "   Only remove the name from the index, do not delete in data file";
    ]
    (fun s ->
       match !fsysn with
         | None -> fsysn := Some s
         | Some _ ->
	     ( match !filen with
		 | None -> filen := Some s
		 | Some _ ->
		     raise(Arg.Bad("Unexpected arg: " ^ s))))
    (sprintf "usage: %s delete [options] fsys file" pgm_name);

  let fsysn =
    match !fsysn with
      | Some f -> f 
      | None -> failwith "Argument expected" in

  let filen =
    match !filen with
      | Some f -> f 
      | None -> failwith "Argument expected" in

  let base = new_base (Filename.dirname fsysn) in
  let fsys = get_filesys base (Filename.basename fsysn) in
  if !only_index then (
    fsys#delete_name_from_index filen
  ) else (
    let file,_ = fsys#open_file_wr filen [] None in
    fsys#delete_file file;
  );
  fsys#checkpoint();
  fsys#dispose()
;;


let cmd_rename pgm_name =
  let fsysn = ref None in
  let filen_old = ref None in
  let filen_new = ref None in
  Arg.parse
    []
    (fun s ->
       match !fsysn with
         | None -> fsysn := Some s
         | Some _ ->
	     ( match !filen_old with
		 | None -> filen_old := Some s
		 | Some _ ->
		     ( match !filen_new with
			 | None -> filen_new := Some s
			 | Some _ ->
			     raise(Arg.Bad("Unexpected arg: " ^ s)))))
    (sprintf "usage: %s rename [options] fsys oldfile newfile" pgm_name);

  let fsysn =
    match !fsysn with
      | Some f -> f 
      | None -> failwith "Argument expected" in

  let filen_old =
    match !filen_old with
      | Some f -> f 
      | None -> failwith "Argument expected" in

  let filen_new =
    match !filen_new with
      | Some f -> f 
      | None -> failwith "Argument expected" in

  let base = new_base (Filename.dirname fsysn) in
  let fsys = get_filesys base (Filename.basename fsysn) in
  let file,_ = fsys#open_file_wr filen_old [] None in
  fsys#rename_file file filen_new;
  fsys#checkpoint();
  fsys#dispose()
;;


let cmd_rollback pgm_name =
  let fsysn = ref None in
  Arg.parse
    [ ]
    (fun s ->
       match !fsysn with
         | None -> fsysn := Some s
         | Some _ ->
             raise(Arg.Bad("Unexpected arg: " ^ s)))
    (sprintf "usage: %s rollback [options] fsys" pgm_name);

  let fsysn =
    match !fsysn with
      | Some f -> f 
      | None -> failwith "Argument expected" in
  
  let base = new_base (Filename.dirname fsysn) in
  check_filesys base (Filename.basename fsysn)
;;




let commands =
  [ "create",   cmd_create,   "Create a filesys";
    "get",      cmd_get,      "Get a file from the filesys";
    "put",      cmd_put,      "Put a file into the filesys";
    "list",     cmd_list,     "List the contents of a filesys";
    "delete",   cmd_delete,   "Delete a file in the filesys";
    "rename",   cmd_rename,   "Rename a file in the filesys";
    "reindex",  cmd_reindex,  "Create a new index for a filesys";
    "compact",  cmd_compact,  "Compact the filesys";
    "rollback", cmd_rollback, "Rollback filesys to last checkpoint";
    "repair",   cmd_repair,   "Rollback & repair filesys";
  ]


let usage pgm_name =
  eprintf "usage: %s <command> <options> <args>\n" pgm_name;
  eprintf "<command> is one of the following:\n";
  List.iter
    (fun (name, _, text) ->
       eprintf "  %s: %s\n" name text
    )
    commands;
  eprintf "<options> and <args> depend on the command you are issuing.\n";
  eprintf "use '%s <command> -help' to get command-specific help.\n" pgm_name;
  flush stderr;
  exit 2
;;


let main() =
  Seqdb_fsys_ao.init();

  let pgm_name = Filename.basename Sys.argv.(0) in
  if Array.length Sys.argv <= 1 then
    usage pgm_name;
  let cmd_name = Sys.argv.(1) in
  let _, cmd, _ =
    try
      List.find (fun (name, _, _) -> name = cmd_name) commands
    with
      | Not_found -> usage pgm_name in
  Arg.current := 1;
  try
    cmd pgm_name
  with
    | Arg.Bad msg
    | Failure msg ->
        prerr_endline (pgm_name ^ ": " ^ msg);
        exit 2
    | Unix.Unix_error(err, _, param) ->
        let prefix =
          if param = "" then
            pgm_name ^ ": "
          else
            pgm_name ^ ": " ^ param ^ ": " in
        prerr_endline (prefix ^ Unix.error_message err);
        exit 2
;;

main()