Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 304 lines (230 sloc) 8.178 kb
aa67aa9 @samoht Big refactoring work.
samoht authored
1 (***********************************************************************)
2 (* *)
3 (* Copyright 2012 OCamlPro *)
4 (* Copyright 2012 INRIA *)
5 (* *)
6 (* All rights reserved. This file is distributed under the terms of *)
7 (* the GNU Public License version 3.0. *)
8 (* *)
9 (* OPAM is distributed in the hope that it will be useful, *)
10 (* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
11 (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
12 (* GNU General Public License for more details. *)
13 (* *)
14 (***********************************************************************)
15
16 module Base = OpamMisc.Base
17
ee6583e @tuong [cosmetic] update names
tuong authored
18 let log fmt = OpamGlobals.log "FILENAME" fmt
aa67aa9 @samoht Big refactoring work.
samoht authored
19
20 module Dir = struct
21
22 include OpamMisc.Base
23
24 let of_string dirname =
25 if not (Filename.is_relative dirname) then
26 dirname
27 else
28 OpamSystem.real_path dirname
29
30 let to_string dirname =
31 if dirname.[String.length dirname - 1] = Filename.dir_sep.[0] then
32 Filename.concat (Filename.dirname dirname) (Filename.basename dirname)
33 else
34 dirname
35
36 end
37
38 let raw_dir s = s
39
40 let with_tmp_dir fn =
41 OpamSystem.with_tmp_dir (fun dir -> fn (Dir.of_string dir))
42
43 let rmdir dirname =
44 log "rmdir %s" (Dir.to_string dirname);
45 OpamSystem.remove (Dir.to_string dirname)
46
47 let cwd () =
48 Dir.of_string (Unix.getcwd ())
49
50 let mkdir dirname =
51 OpamSystem.mkdir (Dir.to_string dirname)
52
53 let list_dirs d =
54 let fs = OpamSystem.directories_with_links (Dir.to_string d) in
55 List.map Dir.of_string fs
56
57 let in_dir dirname fn =
58 if Sys.file_exists dirname then
59 OpamSystem.in_dir dirname fn
60 else
61 OpamGlobals.error_and_exit "%s does not exist!" dirname
62
63 let exec dirname ?(add_to_env=[]) ?(add_to_path=[]) cmds =
64 OpamSystem.in_dir (Dir.to_string dirname)
65 (fun () ->
66 OpamSystem.commands
67 ~add_to_env
68 ~add_to_path:(List.map Dir.of_string add_to_path)
69 cmds)
70
71 let move_dir src dst =
72 OpamSystem.command [ "mv"; Dir.to_string src; Dir.to_string dst ]
73
74 let copy_dir src dst =
75 with_tmp_dir (fun tmp ->
76 OpamSystem.command [ "rsync"; "-a"; Filename.concat (Dir.to_string src) "/"; Dir.to_string tmp ];
77 match list_dirs tmp with
78 | [f] ->
79 rmdir dst;
80 move_dir f dst
81 | _ -> OpamGlobals.error_and_exit "Error while copying %s to %s" (Dir.to_string src) (Dir.to_string dst)
82 )
83
84 let link_dir src dst =
85 rmdir dst;
86 let tmp_dst = Filename.concat (Filename.basename src) (Filename.basename dst) in
87 let base = Filename.dirname dst in
88 mkdir base;
89 if dst = tmp_dst then
90 in_dir base (fun () -> OpamSystem.command [ "ln"; "-s"; src])
91 else
92 in_dir base (fun () ->
93 OpamSystem.commands [
94 ["ln"; "-s"; src];
95 ["mv"; (Filename.basename src); (Filename.basename dst) ];
96 ])
97
98 let basename_dir dirname =
99 Base.of_string (Filename.basename (Dir.to_string dirname))
100
101 let dirname_dir dirname =
102 Dir.to_string (Filename.dirname (Dir.of_string dirname))
103
104 let exists_dir dirname =
105 Sys.file_exists (Dir.to_string dirname)
106
107 let (/) d1 s2 =
108 let s1 = Dir.to_string d1 in
109 raw_dir (Filename.concat s1 s2)
110
111 type t = {
112 dirname: Dir.t;
113 basename: Base.t;
114 }
115
116 let create dirname basename =
117 let b1 = Filename.dirname (Base.to_string basename) in
118 let b2 = Base.of_string (Filename.basename (Base.to_string basename)) in
119 if basename = b2 then
120 { dirname; basename }
121 else
122 { dirname = dirname / b1; basename = b2 }
123
124 let of_basename basename =
125 let dirname = Dir.of_string "." in
126 { dirname; basename }
127
128 let raw_file str =
129 let dirname = raw_dir (Filename.dirname str) in
130 let basename = Base.of_string (Filename.basename str) in
131 create dirname basename
132
133 let to_string t =
134 Filename.concat (Dir.to_string t.dirname) (Base.to_string t.basename)
135
136 let digest t =
137 Digest.to_hex (Digest.file (to_string t))
138
139 let touch t =
140 OpamSystem.write (to_string t) ""
141
142 let chmod t p =
143 Unix.chmod (to_string t) p
144
145 let of_string s =
146 let dirname = Filename.dirname s in
147 let basename = Filename.basename s in
148 {
149 dirname = Dir.of_string dirname;
150 basename = Base.of_string basename;
151 }
152
153 let dirname t = t.dirname
154
155 let basename t = t.basename
156
157 let read filename =
158 OpamSystem.read (to_string filename)
159
160 let write filename raw =
161 OpamSystem.write (to_string filename) raw
162
163 let remove filename =
164 OpamSystem.remove_file (to_string filename)
165
166 let exists filename =
167 Sys.file_exists (to_string filename)
168
169 let with_contents fn filename =
170 fn (read filename)
171
172 let check_suffix filename s =
173 Filename.check_suffix (to_string filename) s
174
175 let add_extension filename suffix =
176 of_string ((to_string filename) ^ "." ^ suffix)
177
178 let chop_extension filename =
179 of_string (Filename.chop_extension (to_string filename))
180
181 let list_files d =
182 let fs = OpamSystem.rec_files (Dir.to_string d) in
183 List.map of_string fs
184
185 let copy src dst =
186 OpamSystem.copy (to_string src) (to_string dst)
187
188 let move src dst =
189 OpamSystem.command [ "mv"; to_string src; to_string dst ]
190
191 let link src dst =
192 if OpamGlobals.os = OpamGlobals.Win32 then
193 copy src dst
194 else
195 OpamSystem.link (to_string src) (to_string dst)
196
197 let process_in fn src dst =
198 let src_s = to_string src in
199 let dst = Filename.concat (Dir.to_string dst) (Filename.basename src_s) in
200 fn src (of_string dst)
201
202 let copy_in = process_in copy
203
204 let link_in = process_in link
205
206 let extract filename dirname =
207 OpamSystem.extract (to_string filename) (Dir.to_string dirname)
208
209 let extract_in filename dirname =
210 OpamSystem.extract_in (to_string filename) (Dir.to_string dirname)
211
212 let starts_with dirname filename =
213 OpamMisc.starts_with (Dir.to_string dirname) (to_string filename)
214
215 let remove_prefix ~prefix filename =
216 let prefix =
217 let str = Dir.to_string prefix in
218 if str = "" then "" else Filename.concat str "" in
219 let dirname = to_string filename in
220 OpamMisc.remove_prefix ~prefix dirname
221
222 let download filename dirname =
223 mkdir dirname;
224 let file = OpamSystem.download ~filename:(to_string filename) ~dirname:(Dir.to_string dirname) in
225 of_string file
226
227 let download_iter filenames dirname =
228 let rec aux = function
229 | [] ->
230 OpamSystem.internal_error "Cannot download %s" (String.concat ", " (List.map to_string filenames))
231 | h::t ->
232 try download h dirname
233 with _ -> aux t in
234 aux filenames
235
236 let patch filename dirname =
237 in_dir dirname (fun () -> OpamSystem.patch (to_string filename))
238
239 module O = struct
240 type tmp = t
241 type t = tmp
242 let compare x y = compare (to_string x) (to_string y)
243 let to_string = to_string
244 end
245
246 module Map = OpamMisc.Map.Make(O)
247 module Set = OpamMisc.Set.Make(O)
248
249 module OP = struct
250
251 let (/) = (/)
252
253 let (//) d1 s2 =
254 let d = Filename.dirname s2 in
255 let b = Filename.basename s2 in
256 if d <> "." then
257 create (d1 / d) (Base.of_string b)
258 else
259 create d1 (Base.of_string s2)
260
261 end
262
263 module Attribute = struct
264
265 type t = {
266 base: Base.t;
267 md5 : string;
268 perm: int option;
269 }
270
271 let base t = t.base
272
273 let md5 t = t.md5
274
275 let perm t = t.perm
276
277 let create base md5 perm =
278 { base; md5; perm=Some perm }
279
280 let to_string t =
281 let perm = match t.perm with
282 | None -> ""
283 | Some p -> Printf.sprintf " 0o%o" p in
284 Printf.sprintf "%s %s%s" (Base.to_string t.base) t.md5 perm
285
286 let of_string s =
287 match OpamMisc.split s ' ' with
288 | [base; md5] -> { base=Base.of_string base; md5; perm=None }
289 | [base;md5; perm] -> { base=Base.of_string base; md5; perm=Some (int_of_string perm) }
290 | k -> OpamGlobals.error_and_exit "Remote_file: %s" (String.concat " " k)
291
292 module O = struct
293 type tmp = t
294 type t = tmp
295 let to_string = to_string
296 let compare = compare
297 end
298
299 module Set = OpamMisc.Set.Make(O)
300
301 module Map = OpamMisc.Map.Make(O)
302
303 end
Something went wrong with that request. Please try again.