Permalink
Browse files

[opam-mk-repo] new option "-generate-checksums" to automatically inse…

…rt the digest of downloaded archive in the "url" file.

Moreover, if there is already a digest and different than the newly computed :
- if "-generate-checksums" is set, it updates by keeping the newly computed
- otherwise, exit with an error (like the previous behavior).
  • Loading branch information...
1 parent 10fb3e9 commit fff1b3bfc1ae01bdf523df522ec0d77f7ddad530 @tuong tuong committed Sep 19, 2012
Showing with 36 additions and 16 deletions.
  1. +2 −0 src/file.ml
  2. +3 −0 src/file.mli
  3. +21 −11 src/repositories.ml
  4. +5 −2 src/repositories.mli
  5. +5 −3 src/scripts/opam_mk_repo.ml
View
@@ -181,6 +181,8 @@ module URL = struct
let kind t = t.kind
let checksum t = t.checksum
+ let with_checksum t checksum = { t with checksum }
+
let create ?checksum url =
{ url; checksum; kind = None }
View
@@ -401,6 +401,9 @@ module URL: sig
(** Constructor *)
val create: ?checksum:string -> string -> t
+ (** Constructor *)
+ val with_checksum: t -> string option -> t
+
end
(** {2 urls.txt file *} *)
View
@@ -83,14 +83,14 @@ let map fn = function
| Up_to_date x -> Up_to_date (fn x)
| Not_available -> Not_available
-let download_file k nv f c =
+let download_file ~gener_digest k nv f c =
log "download_file %s %s %s" k (NV.to_string nv) (Filename.to_string f);
let module B = (val find_backend_by_kind k: BACKEND) in
let check file = match c with
| None -> true
| Some c -> Filename.digest file = c in
let rename file =
- if !Globals.verify_checksums && not (check file) then
+ if not gener_digest && !Globals.verify_checksums && not (check file) then
Globals.error_and_exit "Wrong checksum for %s (waiting for %s, got %s)"
(Filename.to_string file)
(match c with Some c -> c | None -> "<none>")
@@ -110,11 +110,11 @@ let download_dir k nv d =
B.download_dir nv d
(* Download either a file or a directory in the current directory *)
-let download_one k nv url checksum =
+let download_one ?(gener_digest = false) k nv url checksum =
let f x = F x in
let d x = D x in
if k = "curl" || Run.is_tar_archive url then
- map f (download_file k nv (Filename.raw url) checksum)
+ map f (download_file ~gener_digest k nv (Filename.raw url) checksum)
else
map d (download_dir k nv (Dirname.raw url))
@@ -131,7 +131,7 @@ let download_archive r nv =
let module B = (val find_backend r: BACKEND) in
B.download_archive (Repository.address r) nv
-let make_archive nv =
+let make_archive ?(gener_digest = false) nv =
(* download the archive upstream if the upstream address is
specified *)
let local_repo = Path.R.cwd () in
@@ -145,18 +145,28 @@ let make_archive nv =
let extract_dir = extract_root / NV.to_string nv in
if Filename.exists url_f then begin
- let url = File.URL.read url_f in
- let checksum = File.URL.checksum url in
- let kind = match File.URL.kind url with
- | None -> kind_of_url (File.URL.url url)
+ let url_file = File.URL.read url_f in
+ let checksum = File.URL.checksum url_file in
+ let kind = match File.URL.kind url_file with
+ | None -> kind_of_url (File.URL.url url_file)
| Some k -> k in
- let url = File.URL.url url in
+ let url = File.URL.url url_file in
log "downloading %s:%s" url kind;
- match Dirname.in_dir local_dir (fun () -> download_one kind nv url checksum) with
+ match Dirname.in_dir local_dir (fun () -> download_one ~gener_digest kind nv url checksum) with
| Not_available -> Globals.error_and_exit "Cannot get %s" url
| Up_to_date (F local_archive)
| Result (F local_archive) ->
+ if gener_digest then
+ let digest = Filename.digest local_archive in
+ begin
+ (match checksum with
+ | Some c when c <> digest ->
+ Globals.warning "Wrong checksum for %s (in cache: %s, new downloaded: %s). Update by keeping the downloaded digest..."
+ (Filename.to_string local_archive) c digest
+ | _ -> ());
+ File.URL.write url_f (File.URL.with_checksum url_file (Some digest));
+ end;
log "extracting %s to %s"
(Filename.to_string local_archive)
(Dirname.to_string extract_dir);
View
@@ -80,5 +80,8 @@ type kind = string
val register_backend: kind -> (module BACKEND) -> unit
(** [make_archive repo_kind nv] build ./$nv.tar.gz, assuming the
- repository kind is [repo_kind]. *)
-val make_archive: nv -> unit
+ repository kind is [repo_kind].
+ By default, the digest that appear in
+ {i $NAME.$VERSION/url} is not modified,
+ unless [gener_digest = true] is given. *)
+val make_archive: ?gener_digest:bool -> nv -> unit
@@ -30,20 +30,22 @@ let version () =
Printf.printf "%s: version %s\n" Sys.argv.(0) Globals.version;
exit 1
-let all, index, packages =
+let all, index, packages, gener_digest =
let usage = Printf.sprintf "%s [-all] [<package>]*" (Stdlib_filename.basename Sys.argv.(0)) in
let all = ref true in
let index = ref false in
let packages = ref [] in
+ let gener_digest = ref false in
let specs = Arg.align [
("-v" , Arg.Unit version, " Display version information");
("--version", Arg.Unit version, " Display version information");
("-all" , Arg.Set all , Printf.sprintf " Build all package archives (default is %b)" !all);
("-index", Arg.Set index, Printf.sprintf " Build indexes only (default is %b)" !index);
+ ("-generate-checksums", Arg.Set gener_digest, Printf.sprintf " Generate checksums during the build (default is %b)" !gener_digest);
] in
let ano p = packages := p :: !packages in
Arg.parse specs ano usage;
- !all, !index, NV.Set.of_list (List.map NV.of_string !packages)
+ !all, !index, NV.Set.of_list (List.map NV.of_string !packages), !gener_digest
let () =
let local_path = Dirname.cwd () in
@@ -95,7 +97,7 @@ let () =
) to_remove;
NV.Set.iter (fun nv ->
- try Repositories.make_archive nv
+ try Repositories.make_archive ~gener_digest nv
with _ -> errors := nv :: !errors;
) to_add;
);

0 comments on commit fff1b3b

Please sign in to comment.