Permalink
Browse files

WIP. OPAM backend can now return a folder instead of an archive, on d…

…ownload.

Tests are still broken ...
  • Loading branch information...
1 parent 38c6100 commit c2338e15a68f636aac9c468aec01a41e85548029 @samoht samoht committed Aug 7, 2012
View
@@ -406,9 +406,9 @@ let update_package () =
(* we do not try to upgrade pinned packages *)
let updated =
NV.Set.filter (fun nv -> NV.Set.for_all (fun nvp -> NV.name nvp = NV.name nv) pinned_updated) updated in
+ log "updated=%s" (NV.Set.to_string updated);
NV.Set.union updated accu;
) NV.Set.empty t.repositories in
-
print_updated t updated pinned_updated;
let updated = NV.Set.union pinned_updated updated in
@@ -1441,7 +1441,8 @@ let upload upload repo =
Filename.copy upload.descr upload_descr;
Filename.copy upload.archive upload_archives;
Repositories.upload repo;
- Dirname.rmdir (Path.R.package upload_repo nv)
+ Dirname.rmdir (Path.R.package upload_repo nv);
+ Filename.remove (Path.R.archive upload_repo nv)
(* Return the transitive closure of dependencies *)
let get_transitive_dependencies t names =
@@ -1631,7 +1632,7 @@ let remote action =
let pretty_print r =
Globals.msg "| %-10s| %-40s| %-10s |\n"
(Repository.name r)
- (Repository.address r)
+ (Dirname.to_string (Repository.address r))
(Repository.kind r) in
let line = String.make 68 '-' in
line.[0] <- '|'; line.[12] <- '|'; line.[54] <- '|'; line.[67] <- '|';
View
@@ -101,7 +101,7 @@ module URL = struct
let internal = "url"
- type t = (filename * string) list
+ type t = (filename * string option) list
let empty = []
@@ -111,18 +111,15 @@ module URL = struct
| [] -> None
| [url] ->
let url = Filename.of_string url in
- let kind =
- if Filename.exists url then
- "rsync"
- else
- "curl" in
- Some (url, kind)
- | [url;kind] -> Some (Filename.of_string url, kind)
+ Some (url, None)
+ | [url;kind] -> Some (Filename.of_string url, Some kind)
| h -> Globals.error_and_exit "%s is not a valid url" (String.concat " " h)
) lines
let to_string f t =
- let lines = List.map (fun (f,k) -> [Filename.to_string f; k]) t in
+ let lines = List.map (function
+ | (f,None) -> [Filename.to_string f]
+ | (f,Some k) -> [Filename.to_string f; k]) t in
Lines.to_string f lines
end
@@ -135,6 +132,14 @@ module Installed = struct
let empty = NV.Set.empty
+ let check t =
+ let map = NV.to_map t in
+ N.Map.iter (fun n vs ->
+ if V.Set.cardinal vs <> 1 then
+ Globals.error_and_exit "Multiple versions installed for package %s: %s"
+ (N.to_string n) (V.Set.to_string vs)
+ ) map
+
let of_string f s =
let lines = Lines.of_string f s in
let map = ref empty in
@@ -147,6 +152,7 @@ module Installed = struct
!map
let to_string _ t =
+ check t;
let buf = Buffer.create 1024 in
NV.Set.iter
(fun nv -> Printf.bprintf buf "%s %s\n" (N.to_string (NV.name nv)) (V.to_string (NV.version nv)))
@@ -243,7 +249,7 @@ module Repo_config = struct
filename = Filename.to_string filename;
contents = [
Variable (s_name , String (Repository.name t));
- Variable (s_address, String (Repository.address t));
+ Variable (s_address, String (Dirname.to_string (Repository.address t)));
Variable (s_kind , String (Repository.kind t));
] } in
Syntax.to_string filename s
@@ -316,7 +322,7 @@ module Config = struct
let of_repo r =
Option (String (Repository.name r),
- [ String (Repository.address r);
+ [ String (Dirname.to_string (Repository.address r));
String (Repository.kind r) ])
type t = {
View
@@ -367,7 +367,7 @@ module Subst: sig
end
(** {2 Urls for OPAM repositories *)
-module URL: IO_FILE with type t = (filename * string) list
+module URL: IO_FILE with type t = (filename * string option) list
(** {2 urls.txt file *} *)
module Urls_txt: IO_FILE with type t = (basename * int * string) list
View
@@ -139,6 +139,8 @@ module G = struct
let archive t nv = archives_dir t // (NV.to_string nv ^ ".tar.gz")
+ let archive_dir t nv = archives_dir t / NV.to_string nv
+
let repo_index t = t / "repo" // "index"
let available_aliases t =
@@ -180,6 +182,8 @@ module R = struct
let archive t nv = archives_dir t // (NV.to_string nv ^ ".tar.gz")
+ let archive_dir t nv = archives_dir t / NV.to_string nv
+
let available_archives t =
let d = archives_dir t in
if Dirname.exists d then
View
@@ -161,6 +161,9 @@ module G: sig
(** Archives files folder: {i $opam/archives/} *)
val archives_dir: t -> dirname
+ (** Archive folder *)
+ val archive_dir: t -> nv -> dirname
+
(** Return the repository index: {i $opam/repo/index} *)
val repo_index: t -> filename
@@ -215,6 +218,9 @@ module R: sig
(** Return the archive folder: {i $opam/repo/$repo/archives/} *)
val archives_dir: t -> dirname
+ (** Archive folder *)
+ val archive_dir: t -> nv -> dirname
+
(** Return the list of archive files in {i $opam/repo/$repo/archives *)
val available_archives: t -> Filename.Set.t
View
@@ -2,19 +2,19 @@
let _ =
if Array.length Sys.argv <> 3 then (
- Printf.eprintf "Usage: %s <remote-filename> <force>" Sys.argv.(0);
+ Printf.eprintf "Usage: %s <remote-filename> <nv> <force>" Sys.argv.(0);
exit 1
)
open Types
-open Repo_helpers
+open Repositories
let () =
- let state = Repo_helpers.make_download_state () in
- let basename = Filename.basename state.filename in
+ let d = Repositories.read_download_info () in
+ let basename = Filename.basename d.filename in
let local_file = Filename.create (Dirname.cwd ()) basename in
- if state.force || not (Filename.exists local_file) then
- match Filename.download state.filename (Dirname.cwd ()) with
+ if d.force || not (Filename.exists local_file) then
+ match Filename.download d.filename (Dirname.cwd ()) with
| None -> exit 1
| Some f ->
Printf.printf "%s" (Filename.to_string f)
View
@@ -2,37 +2,41 @@
let _ =
if Array.length Sys.argv <> 3 then (
- Printf.eprintf "Usage: %s <remote_file> <nv> <package>" Sys.argv.(0);
+ Printf.eprintf "Usage: %s <remote_file> <package> <force>" Sys.argv.(0);
exit 1
)
open Types
-open Repo_helpers
+open Repositories
-let git_archive state basename =
- let git_dir = Dirname.cwd () / basename in
- let url = Filename.to_string state.filename in
+let git_clone_or_update local_repo nv url =
+ let git_dir = Path.R.tmp_dir local_repo nv in
(* If the git repo is not already there, then clone it *)
if not (Dirname.exists git_dir) then (
- let err = Run.command [ "git" ; "clone" ; url ; basename ] in
+ let err = Run.command [ "git" ; "clone" ; Filename.to_string url ; NV.to_string nv ] in
if err <> 0 then
- Globals.error_and_exit "%s is not a valid git url" url
- );
- (* Then run git-archive to get a tar.gz *)
+ Globals.error_and_exit "%s is not a valid git url" (Filename.to_string url)
+ ) else (
+ Git.git_fetch git_dir;
+ Git.git_merge git_dir;
+ )
+
+(* (* Then run git-archive to get a tar.gz *)
Dirname.in_dir git_dir (fun () ->
- let tar = basename ^ ".tar" in
+ let tar = NV.to_string nv ^ ".tar" in
let err =
Run.commands [
- [ "git" ; "archive" ; "--format=tar" ; "--prefix="^basename^"/" ; "HEAD" ; "-o" ; tar ] ;
+ [ "git" ; "archive" ; "--format=tar" ; "--prefix="^NV.to_string nv^"/" ; "HEAD" ; "-o" ; tar ] ;
[ "gzip" ; "-f" ; tar ] ;
] in
if err <> 0 then
Globals.error_and_exit "Cannot run git-archive in %s" (Dirname.to_string git_dir)
)
+*)
let () =
- let state = Repo_helpers.make_download_state () in
- let basename = Basename.to_string (Filename.basename state.filename) in
- git_archive state basename;
- let archive = Dirname.cwd () / basename // (basename ^ ".tar.gz") in
- Printf.printf "%s\n%!" (Filename.to_string archive)
+ let local_repo = Path.R.of_dirname (Dirname.cwd ()) in
+ let d = Repositories.read_download_info () in
+ git_clone_or_update local_repo d.nv d.filename;
+ let git_dir = Path.R.tmp_dir local_repo d.nv in
+ Printf.printf "%s\n%!" (Dirname.to_string git_dir)
View
@@ -3,22 +3,22 @@ open Repo_helpers
let log fmt = Globals.log "git" fmt
-let git_fetch state =
- Dirname.in_dir state.local_path (fun () ->
+let git_fetch local_path =
+ Dirname.in_dir local_path (fun () ->
let err = Run.command [ "git" ; "fetch" ; "origin" ] in
if err <> 0 then
Globals.error_and_exit
"Cannot fetch git repository %s"
- (Dirname.to_string state.local_path)
+ (Dirname.to_string local_path)
)
-let git_merge state =
- Dirname.in_dir state.local_path (fun () ->
+let git_merge local_path =
+ Dirname.in_dir local_path (fun () ->
let err = Run.command [ "git" ; "merge" ; "origin/master" ] in
if err <> 0 then
Globals.error_and_exit
"Cannot update git repository %s"
- (Dirname.to_string state.local_path)
+ (Dirname.to_string local_path)
)
(* Return the list of modified files of the git repository located
@@ -44,15 +44,15 @@ module Repo = struct
let make state =
log "make_state";
if Dirname.exists (state.local_path / ".git") then begin
- git_fetch state;
+ git_fetch state.local_path;
get_diff state;
end else
Filename.Set.empty
let sync state =
let diff = make state in
if not (Filename.Set.is_empty diff) then
- git_merge state;
+ git_merge state.local_path;
diff
let upload state dirname =
Oops, something went wrong.

0 comments on commit c2338e1

Please sign in to comment.