1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
(** *)
open Unix
type filter =
| Maxdepth of int
| Type of Unix.file_kind
| Follow
| Regexp of Str.regexp
| Atime of interval
| Predicate of (string -> bool)
and interval =
Le of int | Eq of int | Ge of int
type mode =
| Ignore
| Stderr
| Failure
| Custom of (Unix.error * string * string -> unit)
type inode = int * int
let inode st = st.st_dev, st.st_ino
type status =
{ maxdepth : int;
follow : bool;
filters : (string -> stats -> bool) list;
stat_function : string -> stats;
action : string -> unit;
handler : (error * string * string -> unit)
}
exception Hide of exn
let hide_exn f x = try f x with exn -> raise (Hide exn)
let reveal_exn f x = try f x with Hide exn -> raise exn
let stderr_handler (e, b, c) =
prerr_endline ("find: " ^ c ^": " ^ (error_message e))
let ignore_handler _ = ()
let failure_handler (e,b,c) = raise (Hide (Unix_error (e, b, c)))
let handler = function
| Stderr -> stderr_handler
| Ignore -> ignore_handler
| Failure -> failure_handler
| Custom h -> hide_exn h
let treat_unix_error h f x =
try f x with Unix_error (e, b, c) -> h (e, b, c)
let default_status =
{ follow = false;
maxdepth = max_int;
filters = [];
stat_function = lstat;
action = prerr_endline;
handler = handler Stderr;
}
let add_filter status f = { status with filters = f :: status.filters }
let seconds_in_a_day = 86400.
exception Find of string
let parse_option status = function
| Maxdepth n ->
{ status with maxdepth = n }
| Type k ->
add_filter status
(fun name stat -> stat.st_kind = k)
| Follow ->
{ status with follow = true }
| Regexp exp ->
add_filter status
(fun name stat ->
Str.string_match exp name 0 &&
Str.match_beginning () = 0 &&
Str.match_end () = String.length name
)
| Atime n ->
let min, max =
match n with
| Eq d when d > 0 ->
float d *. seconds_in_a_day, float (d-1) *. seconds_in_a_day
| Le d when d > 0 ->
min_float, float (d-1) *. seconds_in_a_day
| Le d when d > 0 ->
min_float, float (d-1) *. seconds_in_a_day
| Ge d when d > 0 ->
float (d) *. seconds_in_a_day, max_float
| _ -> raise (Find "Ill_formed argument")
in
let now = time() in
add_filter status
(fun name stat ->
let time = now -. stat.st_atime in min <= time && time <= max)
| Predicate f ->
add_filter status (fun name stat -> f name)
let parse_options options =
List.fold_left parse_option default_status options
let filter_all 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 rec find_rec status visited depth filename =
let find() =
let filestat =
if status.follow then stat filename else status.stat_function filename in
let id = filestat.st_dev, filestat.st_ino in
if filter_all filename filestat status.filters then status.action filename;
if filestat.st_kind = S_DIR && depth < status.maxdepth &&
(not status.follow || not (List.mem id visited))
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 visited = if status.follow then id :: visited else visited in
find_rec status visited (depth+1) child_name
in
iter_dir process_child filename
in
treat_unix_error status.handler find ()
let find_entry status filename = find_rec status [] 0 filename
let find mode filenames options action =
let status =
{ (parse_options options) with
handler = handler mode;
action = hide_exn action }
in
reveal_exn (List.iter (find_entry status)) filenames
let find_list mode filenames options =
let l = ref [] in
find mode filenames options (fun s -> l := s :: !l);
List.rev !l