3 module Array = ArrayLabels
4 module List = ListLabels
5 module StrSet = Set.Make(String)
6 module Unix = UnixLabels
11 val create : (unit -> 'a option) -> 'a t
13 val iter : 'a t -> f:('a -> unit) -> unit
15 val map : 'a t -> f:('a -> 'b) -> 'b t
17 val filter : 'a t -> f:('a -> bool) -> 'a t
19 val concat : ('a t) list -> 'a t
24 {mutable streams : ('a S.t) list}
27 {streams = [S.from (fun _ -> f ())]}
35 | exception Stream.Failure ->
46 | Some x -> Some (f x)
62 List.iter t.streams ~f:(S.iter f)
65 {streams = List.concat (List.map ts ~f:(fun {streams} -> streams))}
68 module In_channel : sig
69 val lines : in_channel -> string Stream.t
72 Stream.create (fun () ->
73 match input_line ic with
74 | exception End_of_file ->
87 val find : string -> t Stream.t
88 (** Find all files in the directory tree, starting from the given root path *)
90 val lookup : string Stream.t -> t Stream.t
91 (** Lookup file info for given paths *)
93 module Set : sig include Set.S with type elt := t end
100 let compare {path=p1; _} {path=p2; _} =
104 Stream.map paths ~f:(fun path ->
105 let {Unix.st_size = size; _} = Unix.lstat path in
110 let dirs = Queue.create () in
111 let files = Queue.create () in
113 Array.iter (Sys.readdir parent) ~f:(fun child ->
114 let path = Filename.concat parent child in
115 let {Unix.st_kind = file_kind; st_size; _} = Unix.lstat path in
118 let file = {path; size = st_size} in
132 match Queue.is_empty files, Queue.is_empty dirs with
133 | false, _ -> Some (Queue.take files)
134 | true , true -> None
136 explore (Queue.take dirs);
141 module Set = Set.Make(struct
144 let compare = compare
150 | Directories of string list
154 | Directory of string
159 ; ignore : Str.regexp option
164 { considered : int ref
167 ; unique_size : int ref
168 ; unique_sample : int ref
172 let make_input_stream input ignore count =
176 File.lookup (In_channel.lines stdin)
177 | Directories paths ->
178 let paths = StrSet.elements (StrSet.of_list paths) in
179 Stream.concat (List.map paths ~f:File.find)
181 Stream.filter input ~f:(fun {File.path; size} ->
182 incr count.considered;
183 let empty = size = 0 in
186 | Some regexp when (Str.string_match regexp path 0) ->
191 if empty then incr count.empty;
192 if ignored then incr count.ignored;
193 (not empty) && (not ignored)
196 let make_output_fun = function
198 fun digest n_files files ->
199 printf "%s %d\n%!" (Digest.to_hex digest) n_files;
200 List.iter (File.Set.elements files) ~f:(fun {File.path; _} ->
201 printf " %S\n%!" path
204 fun digest _ files ->
205 let digest = Digest.to_hex digest in
206 let dir = Filename.concat dir (String.sub digest 0 2) in
207 Unix.mkdir dir ~perm:0o700;
208 let oc = open_out (Filename.concat dir digest) in
209 List.iter (File.Set.elements files) ~f:(fun {File.path; _} ->
210 output_string oc (sprintf "%S\n%!" path)
214 let sample path ~len =
215 let buf = Bytes.make len ' ' in
216 let ic = open_in_bin path in
217 let rec read pos len =
222 let chunk_size = input ic buf pos len in
223 if chunk_size = 0 then (* EOF *)
226 read (pos + chunk_size) (len - chunk_size)
233 let main {input; output; ignore; sample = sample_len} =
234 let t0 = Sys.time () in
239 ; unique_size = ref 0
241 ; unique_sample = ref 0
244 let output = make_output_fun output in
245 let input = make_input_stream input ignore count in
246 let files_by_size = Hashtbl.create 1_000_000 in
247 let files_by_sample = Hashtbl.create 1_000_000 in
248 let files_by_digest = Hashtbl.create 1_000_000 in
249 let process tbl ~group ~file =
251 match Hashtbl.find_opt tbl group with
257 Hashtbl.replace tbl group (count + 1, File.Set.add file files)
259 Stream.iter input ~f:(fun ({File.size; _} as file) ->
260 process files_by_size ~group:size ~file
264 (* Skip files with unique sizes *)
267 (fun ({File.path; _} as file) ->
270 ~group:(sample path ~len:sample_len)
275 incr count.unique_size;
280 (* Skip files with unique samples *)
283 (fun ({File.path; _} as file) ->
285 process files_by_digest ~group:(Digest.file path) ~file
289 incr count.unique_sample;
298 let t1 = Sys.time () in
299 eprintf "Time : %f seconds\n%!" (t1 -. t0);
300 eprintf "Considered : %d\n%!" !(count.considered);
301 eprintf "Hashed : %d\n%!" !(count.hashed);
302 eprintf "Skipped due to 0 size : %d\n%!" !(count.empty);
303 eprintf "Skipped due to unique size : %d\n%!" !(count.unique_size);
304 eprintf "Skipped due to unique sample : %d\n%!" !(count.unique_sample);
305 eprintf "Ignored due to regex match : %d\n%!" !(count.ignored)
307 let get_opt () : opt =
308 let assert_ test x msg =
309 if not (test x) then begin
310 eprintf "%s\n%!" msg;
314 let assert_file_exists path =
315 assert_ Sys.file_exists path (sprintf "File does not exist: %S" path)
317 let assert_file_is_dir path =
318 assert_ Sys.is_directory path (sprintf "File is not a directory: %S" path)
320 let input = ref Stdin in
321 let output = ref Stdout in
322 let ignore = ref None in
323 let sample = ref 256 in
326 , Arg.String (fun path ->
327 assert_file_exists path;
328 assert_file_is_dir path;
329 output := Directory path
331 , " Output to this directory instead of stdout."
334 , Arg.String (fun regexp -> ignore := Some (Str.regexp regexp))
335 , " Ignore file paths which match this regexp pattern (see Str module)."
339 , (sprintf " Byte size of file samples to use. Default: %d" !sample)
346 assert_file_exists path;
347 assert_file_is_dir path;
350 input := Directories [path]
351 | Directories paths ->
352 input := Directories (path :: paths)
358 (sprintf "Sample size cannot be negative: %d" !sample);