Skip to content
Newer
Older
100644 393 lines (339 sloc) 14.2 KB
aa67aa9 @samoht Big refactoring work.
samoht authored Oct 4, 2012
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 open OpamTypes
17 open OpamMisc.OP
18 open OpamFilename.OP
19
ee6583e @tuong [cosmetic] update names
tuong authored Oct 8, 2012
20 let log fmt = OpamGlobals.log "REPOSITORY" fmt
aa67aa9 @samoht Big refactoring work.
samoht authored Oct 4, 2012
21
22 type t = repository
23
24 let to_string r =
25 Printf.sprintf "%s(%s %s)"
26 r.repo_name
27 (OpamFilename.Dir.to_string r.repo_address)
28 r.repo_kind
29
30 let of_string _ =
31 failwith "Use Repository.create instead"
32
33 let default = {
34 repo_name = OpamGlobals.default_repository_name;
35 repo_kind = OpamGlobals.default_repository_kind;
36 repo_address = OpamFilename.raw_dir OpamGlobals.default_repository_address;
37 }
38
39 let create = create_repository
40
41 let with_kind r repo_kind = { r with repo_kind }
42
43 module O = struct
44 type tmp = repository
45 type t = tmp
46 let compare = compare
47 let to_string = to_string
48 end
49
50 module Set = OpamMisc.Set.Make(O)
51
52 module Map = OpamMisc.Map.Make(O)
53
54 module type BACKEND = sig
55 val init: address -> unit
56 val update: address -> OpamFilename.Set.t
57 val download_archive: address -> package -> filename download
58 val download_file: package -> filename -> filename download
59 val download_dir: package -> ?dst:dirname -> dirname -> dirname download
60 val upload_dir: address:address -> dirname -> OpamFilename.Set.t
61 end
62
63 exception Unknown_backend
64
65 let backends = Hashtbl.create 8
66
67 let find_backend r =
68 try
69 Hashtbl.find backends r.repo_kind
70 with Not_found -> raise Unknown_backend
71
72 let find_backend_by_kind k =
73 try
74 Hashtbl.find backends k
75 with Not_found -> raise Unknown_backend
76
77 let register_backend name backend =
78 Hashtbl.replace backends name backend
79
80 let local_repo () =
81 OpamPath.Repository.raw (OpamFilename.cwd ())
82
83 let remote_repo remote_address =
84 OpamPath.Repository.raw remote_address
85
86 let repo r =
87 OpamPath.Repository.create (OpamPath.default ()) r
88
89 (* initialize the current directory *)
90 let init r =
91 log "init %s" (to_string r);
92 let module B = (val find_backend r: BACKEND) in
93 let open OpamPath.Repository in
94 let repo = repo r in
95 OpamFilename.mkdir (root repo);
96 OpamFile.Repo_config.write (config repo) r;
97 OpamFilename.mkdir (packages_dir repo);
98 OpamFilename.mkdir (archives_dir repo);
99 OpamFilename.mkdir (compilers_dir repo);
100 OpamFilename.mkdir (upload_dir repo);
101 OpamFilename.in_dir (root repo) (fun () -> B.init r.repo_address)
102
103 let nv_set_of_files files =
104 OpamPackage.Set.of_list
105 (OpamMisc.filter_map
106 OpamPackage.of_filename
107 (OpamFilename.Set.elements files))
108
109 let read_tmp dir =
110 let files = if OpamFilename.exists_dir dir then
111 OpamFilename.Set.of_list (OpamFilename.list_files dir)
112 else
113 OpamFilename.Set.empty in
114 OpamPackage.Set.of_list (OpamMisc.filter_map OpamPackage.of_filename (OpamFilename.Set.elements files))
115
116 (* upload the content of ./upload to the given OPAM repository *)
117 let upload r =
118 log "upload %s" (to_string r);
119 let repo = repo r in
120 let local_dir = OpamPath.Repository.root repo in
121 let upload_dir = OpamPath.Repository.upload_dir repo in
122 let address = r.repo_address in
123 let module B = (val find_backend r: BACKEND) in
124 let files = OpamFilename.in_dir local_dir (fun () -> B.upload_dir ~address upload_dir) in
125 let packages = nv_set_of_files files in
126 OpamGlobals.msg "The following packages have been uploaded:\n";
127 OpamPackage.Set.iter (fun nv ->
128 OpamGlobals.msg " - %s\n" (OpamPackage.to_string nv)
129 ) packages
130
131 (* Download file f in the current directory *)
132 let map fn = function
133 | Result x -> Result (fn x)
134 | Up_to_date x -> Up_to_date (fn x)
135 | Not_available -> Not_available
136
137 let download_file ~gener_digest k nv f c =
138 log "download_file %s %s %s" k (OpamPackage.to_string nv) (OpamFilename.to_string f);
139 let module B = (val find_backend_by_kind k: BACKEND) in
140 let check file = match c with
141 | None -> true
142 | Some c -> OpamFilename.digest file = c in
143 let rename file =
144 if not gener_digest && !OpamGlobals.verify_checksums && not (check file) then
145 OpamGlobals.error_and_exit "Wrong checksum for %s (waiting for %s, got %s)"
146 (OpamFilename.to_string file)
147 (match c with Some c -> c | None -> "<none>")
148 (OpamFilename.digest file);
149 if k = "curl" && not (OpamSystem.is_tar_archive (OpamFilename.to_string f)) then
150 let new_file = OpamFilename.raw_file (OpamFilename.to_string file ^ ".tar.gz") in
151 OpamFilename.move file new_file;
152 new_file
153 else
154 file in
155 map rename (B.download_file nv f)
156
157 (* Download directory d in the current directory *)
158 let download_dir k nv ?dst d =
159 log "download_dir %s %s %s" k (OpamPackage.to_string nv) (OpamFilename.Dir.to_string d);
160 let module B = (val find_backend_by_kind k: BACKEND) in
161 B.download_dir nv ?dst d
162
163 (* Download either a file or a directory in the current directory *)
164 let download_one ?(gener_digest = false) k nv url checksum =
165 let f x = F x in
166 let d x = D x in
167 if k = "curl" || OpamSystem.is_tar_archive url then
168 map f (download_file ~gener_digest k nv (OpamFilename.raw_file url) checksum)
169 else
170 map d (download_dir k nv (OpamFilename.raw_dir url))
171
172 (* Infer the url kind: when the url is a local directory, use the
173 rsync backend, otherwise use the curl one. This function is only
174 used when the user hasn't specified a repository kind. *)
175 let kind_of_url url =
176 if Sys.file_exists url then
177 "rsync"
178 else
179 "curl"
180
181 let download_archive r nv =
182 let module B = (val find_backend r: BACKEND) in
183 B.download_archive r.repo_address nv
184
185 (* Copy the file in local_repo in current dir *)
186 let copy_files local_repo nv =
578c460 @samoht Fix repositories which do not contain archive files
samoht authored Oct 8, 2012
187 let local_dir = OpamFilename.cwd () in
aa67aa9 @samoht Big refactoring work.
samoht authored Oct 4, 2012
188 (* Eventually add the <package>/files/* to the extracted dir *)
189 log "Adding the files to the archive";
190 let files = OpamFilename.list_files (OpamPath.Repository.files local_repo nv) in
191 if files <> [] then (
192 if not (OpamFilename.exists_dir local_dir) then
193 OpamFilename.mkdir local_dir;
194 List.iter (fun f ->
195 let dst = local_dir // OpamFilename.Base.to_string (OpamFilename.basename f) in
196 if OpamFilename.exists dst then
197 OpamGlobals.warning
198 "Skipping %s as it already exists in %s"
199 (OpamFilename.to_string f)
200 (OpamFilename.Dir.to_string local_dir)
201 else
202 OpamFilename.copy_in f local_dir) files;
203 );
204 OpamFilename.Set.of_list files
205
206 let make_archive ?(gener_digest=false) ?local_path nv =
207 (* download the archive upstream if the upstream address is
208 specified *)
209 let local_repo = local_repo () in
210 let local_dir = OpamPath.Repository.root local_repo in
211 let url_f = OpamPath.Repository.url local_repo nv in
212
213 let download_dir = OpamPath.Repository.tmp_dir local_repo nv in
214 OpamFilename.mkdir download_dir;
215
216 OpamFilename.with_tmp_dir (fun extract_root ->
217 let extract_dir = extract_root / OpamPackage.to_string nv in
218
219 if local_path = None && OpamFilename.exists url_f then (
220 let url_file = OpamFile.URL.read url_f in
221 let checksum = OpamFile.URL.checksum url_file in
222 let kind = match OpamFile.URL.kind url_file with
223 | None -> kind_of_url (OpamFile.URL.url url_file)
224 | Some k -> k in
225 let url = OpamFile.URL.url url_file in
226 log "downloading %s:%s" url kind;
227
228 match OpamFilename.in_dir local_dir (fun () -> download_one ~gener_digest kind nv url checksum) with
229 | Not_available -> OpamGlobals.error_and_exit "Cannot get %s" url
230 | Up_to_date (F local_archive)
231 | Result (F local_archive) ->
232 if gener_digest then (
233 let digest = OpamFilename.digest local_archive in
234 begin match checksum with
235 | Some c when c <> digest ->
236 OpamGlobals.msg
237 "Wrong checksum for %s (waiting: %s, got: %s)\nFixing %s ...\n"
238 (OpamFilename.to_string local_archive) c digest (OpamFilename.to_string url_f);
239 | _ -> ();
240 end;
241 OpamFile.URL.write url_f (OpamFile.URL.with_checksum url_file digest);
242 );
243 log "extracting %s to %s"
244 (OpamFilename.to_string local_archive)
245 (OpamFilename.Dir.to_string extract_dir);
246 OpamFilename.extract local_archive extract_dir
247 | Up_to_date (D dir)
248 | Result (D dir) ->
249 log "copying %s to %s"
250 (OpamFilename.Dir.to_string dir)
251 (OpamFilename.Dir.to_string extract_dir);
252 if dir <> extract_dir then
253 OpamFilename.copy_dir download_dir extract_dir
254 );
255
256 let extract_dir = match local_path with
257 | None -> extract_dir
258 | Some p -> p in
259
260 (* Eventually add the <package>/files/* to the extracted dir *)
261 let files =
262 if not (OpamFilename.exists_dir extract_dir) then
263 OpamFilename.mkdir extract_dir;
264 OpamFilename.in_dir extract_dir (fun () -> copy_files local_repo nv) in
265
266 (* And finally create the final archive *)
267 if local_path <> None || not (OpamFilename.Set.is_empty files) || OpamFilename.exists url_f then (
268 OpamFilename.mkdir (OpamPath.Repository.archives_dir local_repo);
269 let local_archive = OpamPath.Repository.archive local_repo nv in
270 OpamGlobals.msg "Creating the archive file in %s\n" (OpamFilename.to_string local_archive);
271 OpamFilename.exec extract_root [
272 [ "tar" ; "czf" ; OpamFilename.to_string local_archive ; OpamPackage.to_string nv ]
273 ]
274 );
275 )
276
277 (* Download the archive on the OPAM server.
278 If it is not there, then:
279 * download the original archive upstream
280 * add eventual patches
281 * create a new tarball *)
282 let download r nv =
283 log "download %s %s" (to_string r) (OpamPackage.to_string nv);
284 let repo = repo r in
285 let dir = OpamPath.Repository.root repo in
286 (* If the archive is on the server, download it directly *)
287 match OpamFilename.in_dir dir (fun () -> download_archive r nv) with
288 | Up_to_date local_file ->
289 OpamGlobals.msg "The archive for %s is in the local cache.\n" (OpamPackage.to_string nv);
290 log "The archive for %s is already downloaded and up-to-date"
291 (OpamPackage.to_string nv)
292 | Result local_file ->
293 log "Downloaded %s successfully" (OpamFilename.to_string local_file)
294 | Not_available ->
295 log "The archive for %s is not available, need to build it"
296 (OpamPackage.to_string nv);
297 OpamFilename.in_dir dir (fun () -> make_archive nv)
298
299 let check_version repo =
300 let repo_version =
301 try
302 (OpamPath.Repository.version |>
303 OpamFilename.read |>
304 OpamMisc.strip |>
305 OpamPackage.Version.of_string
306 ) repo
307 with e ->
308 OpamPackage.Version.of_string "0.7.5" in
309 let current_version = OpamPackage.Version.of_string OpamGlobals.version in
310 if OpamPackage.Version.compare repo_version current_version >= 0 then
311 OpamGlobals.error_and_exit
312 "\nThe current version of OPAM cannot read the repository. \
313 You should upgrade to at least the version %s.\n" (OpamPackage.Version.to_string repo_version)
314
315 let update r =
316 log "update %s" (to_string r);
317 let repo = repo r in
318 let dir = OpamPath.Repository.root repo in
319 let module B = (val find_backend r: BACKEND) in
320 let updated_files = OpamFilename.in_dir dir (fun () -> B.update r.repo_address) in
321
322 check_version repo;
323
324 let updated_packages = nv_set_of_files updated_files in
325
326 (* Clean-up archives and tmp files on URL changes *)
327 OpamPackage.Set.iter (fun nv ->
328 let url_f = OpamPath.Repository.url repo nv in
329 if OpamFilename.Set.mem url_f updated_files then begin
330 let tmp_dir = OpamPath.Repository.tmp_dir repo nv in
331 OpamFilename.rmdir tmp_dir;
332 OpamFilename.remove (OpamPath.Repository.archive repo nv);
333 end
334 ) updated_packages;
335
336 (* For each package in the cache, look at what changed upstream *)
337 let cached_packages = read_tmp (OpamPath.Repository.tmp repo) in
338 let updated_cached_packages = OpamPackage.Set.filter (fun nv ->
339 let url_f = OpamPath.Repository.url repo nv in
340 let url = OpamFile.URL.read url_f in
341 let kind = match OpamFile.URL.kind url with
342 | None -> kind_of_url (OpamFile.URL.url url)
343 | Some k -> k in
344 let checksum = OpamFile.URL.checksum url in
345 let url = OpamFile.URL.url url in
346 log "updating %s:%s" url kind;
347 match OpamFilename.in_dir dir (fun () -> download_one kind nv url checksum) with
348 | Not_available -> OpamGlobals.error_and_exit "Cannot get %s" url
349 | Up_to_date _ -> false
350 | Result _ -> true
351 ) cached_packages in
352
353 let updated = OpamPackage.Set.union updated_packages updated_cached_packages in
354 OpamFile.Updated.write (OpamPath.Repository.updated repo) updated
355
356 let find_backend = find_backend_by_kind
357
358 let packages r =
359 let dir = OpamPath.Repository.packages_dir r in
360 if OpamFilename.exists_dir dir then (
361 let all = OpamFilename.list_dirs dir in
362 let basenames = List.map OpamFilename.basename_dir all in
363 OpamPackage.Set.of_list
364 (OpamMisc.filter_map
365 (OpamFilename.Base.to_string |> OpamPackage.of_string_opt)
366 basenames)
367 ) else
368 OpamPackage.Set.empty
369
370 let versions r n =
371 OpamPackage.versions_of_packages
372 (OpamPackage.Set.filter
373 (fun nv -> OpamPackage.name nv = n)
374 (packages r))
375
376 let archives r =
377 let d = OpamPath.Repository.archives_dir r in
378 if OpamFilename.exists_dir d then
379 OpamFilename.Set.of_list (OpamFilename.list_files d)
380 else
381 OpamFilename.Set.empty
382
383 let compilers r =
384 OpamVersion.Compiler.list (OpamPath.Repository.compilers_dir r)
385
386 let files r nv =
387 let l =
388 if OpamFilename.exists_dir (OpamPath.Repository.files r nv) then
389 OpamFilename.list_files (OpamPath.Repository.files r nv)
390 else
391 [] in
392 OpamFilename.Set.of_list l
Something went wrong with that request. Please try again.