<commit_before>(* Copyright (C) 2008 <NAME> <<EMAIL>> http//eigenclass.org
 * See README.txt and LICENSE for the redistribution and modification terms *)

open Printf
open Unix
open Folddir
open Util

let debug = ref false
let verbose = ref false
let use_mtime = ref false
let use_xattrs = ref false
let magic = "Ometastore"
let version = "1.0.0"

type xattr = { name : string; value : string }

type entry = {
  path : string;
  owner : string;
  group : string;
  mode : int;
  mtime : float;
  kind : Unix.file_kind;
  xattrs : xattr list;
}

type whatsnew = Added of entry | Deleted of entry | Diff of entry * entry

external utime : string -> int -> unit = "perform_utime"
external llistxattr : string -> string list = "perform_llistxattr"
external lgetxattr : string -> string -> string = "perform_lgetxattr"
external lsetxattr : string -> string -> string -> unit = "perform_lsetxattr"

let user_name = memoized (fun uid -> (getpwuid uid).pw_name)
let group_name = memoized (fun gid -> (getgrgid gid).gr_name)

let int_of_file_kind = function
    S_REG -> 0 | S_DIR -> 1 | S_CHR -> 2 | S_BLK -> 3 | S_LNK -> 4 | S_FIFO -> 5
  | S_SOCK -> 6

let kind_of_int = function
    0 -> S_REG | 1 -> S_DIR | 2 -> S_CHR | 3 -> S_BLK | 4 -> S_LNK | 5 -> S_FIFO
  | 6 -> S_SOCK | _ -> invalid_arg "kind_of_int"

let entry_of_path path =
  let s = lstat path in
  let user = user_name s.st_uid in
  let group = group_name s.st_gid in
  let xattrs = match !use_xattrs with
      false -> []
    | true ->
        List.map
          (fun attr -> { name = attr; value = lgetxattr path attr; })
          (List.sort compare (llistxattr path))
  in
    { path = path; owner = user; group = group; mode = s.st_perm;
      kind = s.st_kind; mtime = s.st_mtime; xattrs = xattrs }

module Entries(F : Folddir.S) =
struct
  let get_entries ?(debug=false) ?(sorted=false) path =
    let aux l name stat =
      let fullname = join path name in
      let entry = { (entry_of_path fullname) with path = name } in
        match stat.st_kind with
          | S_DIR -> begin
              try access (join fullname ".git") [F_OK]; Prune (entry :: l)
              with Unix_error _ -> Continue (entry :: l)
            end
          | _ -> Continue (entry :: l)
    in List.rev (F.fold_directory ~debug ~sorted aux [] path "")
end

let write_int os bytes n =
  for i = bytes - 1 downto 0 do
    output_char os (Char.chr ((n lsr (i lsl 3)) land 0xFF))
  done

let read_int is bytes =
  let r = ref 0 in
  for i = 0 to bytes - 1 do
    r := !r lsl 8 + Char.code (input_char is)
  done;
  !r

let write_xstring os s =
  write_int os 2 (String.length s);
  output_string os s

let read_xstring is =
  let len = read_int is 2 in
  let s = String.create len in
    really_input is s 0 len;
    s

let common_prefix_chars s1 s2 =
  let rec loop s1 s2 i max =
    if s1.[i] = s2.[i] then
      if i < max then loop s1 s2 (i+1) max else i + 1
    else i
  in
    if String.length s1 = 0 || String.length s2 = 0 then 0
    else loop s1 s2 0 (min (String.length s1 - 1) (String.length s2 -1))

let dump_entries ?(verbose=false) ?(sorted=false) l fname =
  let dump_entry os prev e =
    if verbose then printf "%s\n" e.path;
    let pref = common_prefix_chars prev e.path in
    write_int os 2 pref;
    write_xstring os (String.sub e.path pref (String.length e.path - pref));
    write_xstring os e.owner;
    write_xstring os e.group;
    write_xstring os (string_of_float e.mtime);
    write_int os 2 e.mode;
    write_int os 1 (int_of_file_kind e.kind);
    write_int os 2 (List.length e.xattrs);
    List.iter
      (fun t -> write_xstring os t.name; write_xstring os t.value)
      e.xattrs;
    e.path
  in do_finally (open_out_bin fname) close_out begin fun os ->
    output_string os (magic ^ "\n");
    output_string os (version ^ "\n");
    let l = if sorted then List.sort compare l else l in
      ignore (List.fold_left (dump_entry os) "" l)
  end

let read_entries fname =
  let read_entry is prev =
    let pref = read_int is 2 in
    let path = String.sub prev 0 pref ^ read_xstring is in
    let owner = read_xstring is in
    let group = read_xstring is in
    let mtime = float_of_string (read_xstring is) in
    let mode = read_int is 2 in
    let kind = kind_of_int (read_int is 1) in
    let nattrs = read_int is 2 in
    let attrs = ref [] in
      for i = 1 to nattrs do
        let name = read_xstring is in
        let value = read_xstring is in
          attrs := { name = name; value = value } :: !attrs
      done;
      { path = path; owner = owner; group = group; mtime = mtime; mode = mode;
        kind = kind; xattrs = List.rev !attrs }
  in do_finally (open_in_bin fname) close_in begin fun is ->
    if magic <> input_line is then failwith "Invalid file: bad magic";
    let _ = input_line is (* version *) in
    let entries = ref [] in
    let prev = ref "" in
      try
        while true do
          let e = read_entry is !prev in
            entries := e :: !entries;
            prev := e.path
        done;
        assert false
      with End_of_file -> !entries
  end

module SMap = Map.Make(struct type t = string let compare = compare end)

let compare_entries l1 l2 =
  let to_map l = List.fold_left (fun m e -> SMap.add e.path e m) SMap.empty l in
  let m1 = to_map l1 in
  let m2 = to_map l2 in
  let changes =
    List.fold_left
      (fun changes e2 ->
         try
           let e1 = SMap.find e2.path m1 in
             if e1 = e2 then changes else Diff (e1, e2) :: changes
         with Not_found -> Added e2 :: changes)
      [] l2 in
  let deletions =
    List.fold_left
      (fun dels e1 -> if SMap.mem e1.path m2 then dels else Deleted e1 :: dels)
      [] l1
  in List.rev (List.rev_append deletions changes)

let print_changes ?(sorted=false) l =
  List.iter
    (function
         Added e -> printf "Added: %s\n" e.path
       | Deleted e -> printf "Deleted: %s\n" e.path
       | Diff (e1, e2) ->
           let test name f s = if f e1 <> f e2 then name :: s else s in
           let (++) x f = f x in
           let diffs =
             test "owner" (fun x -> x.owner) [] ++
             test "group" (fun x -> x.group) ++
             test "mode" (fun x -> x.mode) ++
             test "kind" (fun x -> x.kind) ++
             test "mtime"
               (if !use_mtime then (fun x -> x.mtime) else (fun _ -> 0.)) ++
             test "xattr" (fun x -> x.xattrs)
           in match List.rev diffs with
               [] -> ()
             | l -> printf "Changed %s: %s\n" e1.path (String.concat " " l))
    (if sorted then List.sort compare l else l)

let print_deleted ?(sorted=false) separator l =
  List.iter
    (function Deleted e -> printf "%s%s" e.path separator
       | Added _ | Diff _ -> ())
    (if sorted then List.sort compare l else l)


let out s = if !verbose then Printf.fprintf Pervasives.stdout s
            else Printf.ifprintf Pervasives.stdout s

let fix_usergroup e =
  out "%s: set owner/group to %S %S\n" e.path e.owner e.group;
  chown e.path (getpwnam e.owner).pw_uid (getgrnam e.group).gr_gid

let fix_xattrs src dst =
  out "%s: fixing xattrs (" src.path;<commit_msg>Always save xattrs (even if no -x), honor -x in comp. mode.<commit_after>(* Copyright (C) 2008 <NAME> <<EMAIL>> http//eigenclass.org
 * See README.txt and LICENSE for the redistribution and modification terms *)

open Printf
open Unix
open Folddir
open Util

let debug = ref false
let verbose = ref false
let use_mtime = ref false
let use_xattrs = ref false
let magic = "Ometastore"
let version = "1.0.0"

type xattr = { name : string; value : string }

type entry = {
  path : string;
  owner : string;
  group : string;
  mode : int;
  mtime : float;
  kind : Unix.file_kind;
  xattrs : xattr list;
}

type whatsnew = Added of entry | Deleted of entry | Diff of entry * entry

external utime : string -> int -> unit = "perform_utime"
external llistxattr : string -> string list = "perform_llistxattr"
external lgetxattr : string -> string -> string = "perform_lgetxattr"
external lsetxattr : string -> string -> string -> unit = "perform_lsetxattr"

let user_name = memoized (fun uid -> (getpwuid uid).pw_name)
let group_name = memoized (fun gid -> (getgrgid gid).gr_name)

let int_of_file_kind = function
    S_REG -> 0 | S_DIR -> 1 | S_CHR -> 2 | S_BLK -> 3 | S_LNK -> 4 | S_FIFO -> 5
  | S_SOCK -> 6

let kind_of_int = function
    0 -> S_REG | 1 -> S_DIR | 2 -> S_CHR | 3 -> S_BLK | 4 -> S_LNK | 5 -> S_FIFO
  | 6 -> S_SOCK | _ -> invalid_arg "kind_of_int"

let entry_of_path path =
  let s = lstat path in
  let user = user_name s.st_uid in
  let group = group_name s.st_gid in
  let xattrs =
    List.map
      (fun attr -> { name = attr; value = lgetxattr path attr; })
      (List.sort compare (llistxattr path))
  in
    { path = path; owner = user; group = group; mode = s.st_perm;
      kind = s.st_kind; mtime = s.st_mtime; xattrs = xattrs }

module Entries(F : Folddir.S) =
struct
  let get_entries ?(debug=false) ?(sorted=false) path =
    let aux l name stat =
      let fullname = join path name in
      let entry = { (entry_of_path fullname) with path = name } in
        match stat.st_kind with
          | S_DIR -> begin
              try access (join fullname ".git") [F_OK]; Prune (entry :: l)
              with Unix_error _ -> Continue (entry :: l)
            end
          | _ -> Continue (entry :: l)
    in List.rev (F.fold_directory ~debug ~sorted aux [] path "")
end

let write_int os bytes n =
  for i = bytes - 1 downto 0 do
    output_char os (Char.chr ((n lsr (i lsl 3)) land 0xFF))
  done

let read_int is bytes =
  let r = ref 0 in
  for i = 0 to bytes - 1 do
    r := !r lsl 8 + Char.code (input_char is)
  done;
  !r

let write_xstring os s =
  write_int os 2 (String.length s);
  output_string os s

let read_xstring is =
  let len = read_int is 2 in
  let s = String.create len in
    really_input is s 0 len;
    s

let common_prefix_chars s1 s2 =
  let rec loop s1 s2 i max =
    if s1.[i] = s2.[i] then
      if i < max then loop s1 s2 (i+1) max else i + 1
    else i
  in
    if String.length s1 = 0 || String.length s2 = 0 then 0
    else loop s1 s2 0 (min (String.length s1 - 1) (String.length s2 -1))

let dump_entries ?(verbose=false) ?(sorted=false) l fname =
  let dump_entry os prev e =
    if verbose then printf "%s\n" e.path;
    let pref = common_prefix_chars prev e.path in
    write_int os 2 pref;
    write_xstring os (String.sub e.path pref (String.length e.path - pref));
    write_xstring os e.owner;
    write_xstring os e.group;
    write_xstring os (string_of_float e.mtime);
    write_int os 2 e.mode;
    write_int os 1 (int_of_file_kind e.kind);
    write_int os 2 (List.length e.xattrs);
    List.iter
      (fun t -> write_xstring os t.name; write_xstring os t.value)
      e.xattrs;
    e.path
  in do_finally (open_out_bin fname) close_out begin fun os ->
    output_string os (magic ^ "\n");
    output_string os (version ^ "\n");
    let l = if sorted then List.sort compare l else l in
      ignore (List.fold_left (dump_entry os) "" l)
  end

let read_entries fname =
  let read_entry is prev =
    let pref = read_int is 2 in
    let path = String.sub prev 0 pref ^ read_xstring is in
    let owner = read_xstring is in
    let group = read_xstring is in
    let mtime = float_of_string (read_xstring is) in
    let mode = read_int is 2 in
    let kind = kind_of_int (read_int is 1) in
    let nattrs = read_int is 2 in
    let attrs = ref [] in
      for i = 1 to nattrs do
        let name = read_xstring is in
        let value = read_xstring is in
          attrs := { name = name; value = value } :: !attrs
      done;
      { path = path; owner = owner; group = group; mtime = mtime; mode = mode;
        kind = kind; xattrs = List.rev !attrs }
  in do_finally (open_in_bin fname) close_in begin fun is ->
    if magic <> input_line is then failwith "Invalid file: bad magic";
    let _ = input_line is (* version *) in
    let entries = ref [] in
    let prev = ref "" in
      try
        while true do
          let e = read_entry is !prev in
            entries := e :: !entries;
            prev := e.path
        done;
        assert false
      with End_of_file -> !entries
  end

module SMap = Map.Make(struct type t = string let compare = compare end)

let compare_entries l1 l2 =
  let to_map l = List.fold_left (fun m e -> SMap.add e.path e m) SMap.empty l in
  let m1 = to_map l1 in
  let m2 = to_map l2 in
  let changes =
    List.fold_left
      (fun changes e2 ->
         try
           let e1 = SMap.find e2.path m1 in
             if e1 = e2 then changes else Diff (e1, e2) :: changes
         with Not_found -> Added e2 :: changes)
      [] l2 in
  let deletions =
    List.fold_left
      (fun dels e1 -> if SMap.mem e1.path m2 then dels else Deleted e1 :: dels)
      [] l1
  in List.rev (List.rev_append deletions changes)

let print_changes ?(sorted=false) l =
  List.iter
    (function
         Added e -> printf "Added: %s\n" e.path
       | Deleted e -> printf "Deleted: %s\n" e.path
       | Diff (e1, e2) ->
           let test name f s = if f e1 <> f e2 then name :: s else s in
           let (++) x f = f x in
           let diffs =
             test "owner" (fun x -> x.owner) [] ++
             test "group" (fun x -> x.group) ++
             test "mode" (fun x -> x.mode) ++
             test "kind" (fun x -> x.kind) ++
             test "mtime"
               (if !use_mtime then (fun x -> x.mtime) else (fun _ -> 0.)) ++
             test "xattr"
               (if !use_xattrs then (fun x -> x.xattrs) else (fun _ -> []))
           in match List.rev diffs with
               [] -> ()
             | l -> printf "Changed %s: %s\n" e1.path (String.concat " " l))
    (if sorted then List.sort compare l else l)

let print_deleted ?(sorted=false) separator l =
  List.iter
    (function Deleted e -> printf "%s%s" e.path separator
       | Added _ | Diff _ -> ())
    (if sorted then List.sort compare l else l)


let out s = if !verbose then Printf.fprintf Pervasives.stdout s
            else Printf.ifprintf Pervasives.stdout s

let fix_usergroup e =
  out "%s: set owner/group to %S %S\n" e.path e.owner e.group;
  chown e.path (getpwnam e.owner).pw_uid (getgrnam e.group).gr_gid

let fix_xattrs src dst =
  out "%s: fixing xattrs (" src.path;
{'fraction_non_alphanumeric': 0.10488777008600797, 'fraction_numerical': 0.012726382770435633, 'mean_word_length': 2.2690285714285716, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 118, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4388340', 'n_tokens_mistral': 5091, 'n_tokens_neox': 4964, 'n_words': 1832}