Permalink
Browse files

Fix basic functional tests for 0.4

Also, remove the server backend as it is not used anymore.
  • Loading branch information...
1 parent ca32065 commit dd851064614f47d105f5d58a65e37031e1518ca0 @samoht samoht committed Aug 20, 2012
View
@@ -52,9 +52,6 @@ tests:
tests-rsync:
$(MAKE) -C tests rsync
-tests-server:
- $(MAKE) -C tests server
-
tests-git:
$(MAKE) -C tests git
View
@@ -49,47 +49,8 @@ begin program "opam"
requires = [ "opam-lib" ]
end
-(* Repository Scripts *)
-
-(*
-
-(* SERVER *)
-begin library "opam-server-lib"
- files = [
- "src/repo/server/protocol.ml"
- "src/repo/server/key.ml"
- "src/repo/server/client.ml"
- ]
- requires = [ "opam-lib" ]
-end
-
-begin program "opam-server"
- files = [
- "src/repo/server/daemon.ml"
- "src/repo/server/server.ml"
- ]
- comp += [ "-thread" ]
- link += [ "-thread" ]
- requires = [
- "opam-server-lib"
- "threads"
- ]
-end
-
-*)
-
(* Helpers *)
-begin program "opam-mk-config"
- files = [ "src/scripts/opam_mk_config.ml" ]
- requires = [ "opam-lib" ]
-end
-
-begin program "opam-mk-install"
- files = [ "src/scripts/opam_mk_install.ml" ]
- requires = [ "opam-lib" ]
-end
-
begin program "opam-mk-repo"
files = [ "src/scripts/opam_mk_repo.ml" ]
requires = [ "opam-lib" ]
View
@@ -102,22 +102,21 @@ module Urls_txt = struct
let internal = "urls-txt"
- type t = (basename * int * string) list
+ type t = Remote_file.Set.t
- let empty = []
+ let empty = Remote_file.Set.empty
let of_string f s =
let lines = Lines.of_string f s in
- Utils.filter_map (function
- | [] -> None
- | [name;perm;digest] -> Some (Basename.of_string name, int_of_string perm, digest)
- | s ->
- Globals.error_and_exit "%s is not a valid index entry" (String.concat " " s)
- ) lines
+ let rs = Utils.filter_map (function
+ | [] -> None
+ | l -> Some (Remote_file.of_string (String.concat " " l))
+ ) lines in
+ Remote_file.Set.of_list rs
let to_string f t =
let lines =
- List.map (fun (f,p,d) -> [Basename.to_string f; Printf.sprintf "0o%o" p; d]) t in
+ List.map (fun r -> [Remote_file.to_string r]) (Remote_file.Set.elements t) in
Lines.to_string f lines
end
View
@@ -377,7 +377,7 @@ module URL: sig
end
(** {2 urls.txt file *} *)
-module Urls_txt: IO_FILE with type t = (basename * int * string) list
+module Urls_txt: IO_FILE with type t = Remote_file.Set.t
(** List of filenames *)
module Filenames: IO_FILE with type t = Filename.Set.t
View
@@ -157,6 +157,8 @@ module R = struct
Dirname.of_string !Globals.root_path / "repo" / Repository.name r
let of_dirname path = path
+
+ let cwd () = Dirname.cwd ()
let root t = t
View
@@ -180,6 +180,9 @@ module R: sig
(** Transform a directory name into a repository path *)
val of_dirname: dirname -> t
+ (** Create a repository path with the current working directory *)
+ val cwd: unit -> t
+
(** Return the repository folder: {i $opam/repo/$repo} *)
val root: t -> dirname
View
@@ -17,10 +17,9 @@ type state = {
file_digests : (filename * string) list;
}
-let make_state r =
- let remote_path = Repository.address r in
+let make_state remote_path =
let remote_repo = Path.R.of_dirname remote_path in
- let local_repo = Path.R.create r in
+ let local_repo = Path.R.of_dirname (Dirname.cwd ()) in
let local_path = Path.R.root local_repo in
let index_file = remote_path // "urls.txt" in
let local_index_archive = local_path // "index.tar.gz" in
@@ -31,16 +30,20 @@ let make_state r =
| Some local_file ->
let urls = File.Urls_txt.read local_file in
let remote_local, local_remote, locals, perms, digests =
- List.fold_left(fun (rl, lr, locals, perms, digests) (base,perm,digest) ->
+ Remote_file.Set.fold (fun r (rl, lr, locals, perms, digests) ->
+ let base = Remote_file.base r in
+ let perm = match Remote_file.perm r with
+ | None -> 0o640
+ | Some p -> p in
+ let digest = Remote_file.md5 r in
let remote = Filename.create remote_path base in
let local = Filename.create (Dirname.cwd()) base in
Filename.Map.add remote local rl,
Filename.Map.add local remote lr,
Filename.Set.add local locals,
(local, perm) :: perms,
(local, digest) :: digests
- ) (Filename.Map.empty, Filename.Map.empty, Filename.Set.empty, [], [])
- urls in
+ ) urls (Filename.Map.empty, Filename.Map.empty, Filename.Set.empty, [], []) in
remote_local, local_remote, locals, perms, digests in
{
remote_repo; remote_path; local_repo; local_path;
@@ -57,8 +60,8 @@ let is_up_to_date state local_file =
module B = struct
- let init r =
- let state = make_state r in
+ let init address =
+ let state = make_state address in
let warning () =
Globals.msg "Cannot find index.tar.gz on the OPAM repository.\n\
Initialisation might take some time ...\n" in
@@ -77,8 +80,8 @@ module B = struct
Dirname.mkdir local_dir;
Filename.download remote_file local_dir
- let update r =
- let state = make_state r in
+ let update address =
+ let state = make_state address in
log "dir local_dir=%s remote_dir=%s"
(Dirname.to_string state.local_path)
(Dirname.to_string state.remote_path);
@@ -94,7 +97,7 @@ module B = struct
log "new_files: %s" (Filename.Set.to_string new_files);
Filename.Set.iter Filename.remove to_delete;
if Filename.Set.cardinal new_files > 4 then
- init r
+ init address
else
Filename.Set.iter (fun local_file ->
let remote_file = Filename.Map.find local_file state.local_remote in
@@ -104,10 +107,10 @@ module B = struct
end else
Filename.Set.empty
- let download_archive r nv =
- let remote_repo = Path.R.of_dirname (Repository.address r) in
+ let download_archive address nv =
+ let remote_repo = Path.R.of_dirname address in
let remote_file = Path.R.archive remote_repo nv in
- let state = make_state r in
+ let state = make_state address in
if not (Filename.Map.mem remote_file state.remote_local) then
Not_available
else begin
@@ -136,20 +139,18 @@ module B = struct
end
(* XXX: use checksums *)
- let download_file r nv remote_file =
- let root = Path.R.create r in
- let local_dir = Path.R.tmp_dir root nv in
- match Filename.download remote_file local_dir with
+ let download_file nv remote_file =
+ match Filename.download remote_file (Dirname.cwd ()) with
| None -> Not_available
| Some f -> Result f
let not_supported action =
failwith (action ^ " is not supported by CURL backend")
- let download_dir r nv remote_dir =
+ let download_dir r nv =
not_supported "download_dir"
- let upload_dir state remote_dir =
+ let upload_dir ~address remote_dir =
not_supported "upload"
end
View
@@ -35,18 +35,15 @@ let git_diff local_path =
(Dirname.to_string local_path)
)
-let git_init local_path remote_path =
- Dirname.mkdir local_path;
- Dirname.in_dir local_path (fun () ->
- let repo = Dirname.to_string remote_path in
- let err =
- Run.commands [
- [ "git" ; "init" ] ;
- [ "git" ; "remote" ; "add" ; "origin" ; repo ] ;
- ] in
- if err <> 0 then
- Globals.error_and_exit "Cannot clone %s" repo
- )
+let git_init address =
+ let repo = Dirname.to_string address in
+ let err =
+ Run.commands [
+ [ "git" ; "init" ] ;
+ [ "git" ; "remote" ; "add" ; "origin" ; repo ] ;
+ ] in
+ if err <> 0 then
+ Globals.error_and_exit "Cannot clone %s" repo
let check_updates local_path =
if Dirname.exists (local_path / ".git") then begin
@@ -62,13 +59,8 @@ module B = struct
let updates r =
Path.R.root r // "last-git-updates"
- let init r =
- let local_repo = Path.R.create r in
- git_init (Path.R.root local_repo) (Repository.address r);
- File.Filenames.write (updates local_repo) (Filename.Set.empty)
-
- let check_file r file =
- let local_repo = Path.R.create r in
+ let check_file file =
+ let local_repo = Path.R.cwd () in
let updates = File.Filenames.read (updates local_repo) in
if Filename.Set.mem file updates then
Result file
@@ -77,41 +69,47 @@ module B = struct
else
Not_available
- let download_archive r nv =
- let local_repo = Path.R.create r in
+ let init address =
+ let local_repo = Path.R.cwd () in
+ git_init address;
+ File.Filenames.write (updates local_repo) (Filename.Set.empty)
+
+ let download_archive address nv =
+ let local_repo = Path.R.cwd () in
let archive = Path.R.archive local_repo nv in
- check_file r archive
+ check_file archive
- let download_file r nv filename =
- let local_repo = Path.R.create r in
+ let download_file nv filename =
+ let local_repo = Path.R.cwd () in
let basename = Filename.basename filename in
let file = Path.R.tmp_dir local_repo nv // Basename.to_string basename in
- check_file r file
+ check_file file
- let rec download_dir r nv dirname =
- let local_repo = Path.R.create r in
+ let rec download_dir nv dirname =
+ let local_repo = Path.R.cwd () in
let basename = Dirname.basename dirname in
let dir = Path.R.tmp_dir local_repo nv / Basename.to_string basename in
match check_updates dir with
| None ->
- git_init dir dirname;
- download_dir r nv dirname
+ Dirname.mkdir dir;
+ Dirname.in_dir dir (fun () -> git_init dirname);
+ download_dir nv dirname
| Some f ->
if Filename.Set.empty = f then
Up_to_date dir
else
Result dir
- let update r =
- let local_path = Path.R.root (Path.R.create r) in
+ let update address =
+ let local_path = Dirname.cwd () in
match check_updates local_path with
| Some f -> f
| None ->
Globals.error_and_exit
"The repository %s is not initialized correctly"
- (Repository.to_string r)
+ (Dirname.to_string local_path)
- let upload_dir state dirname =
+ let upload_dir ~address dirname =
let files = Filename.rec_list dirname in
let err = Run.commands [
[ "git"; "add"; Dirname.to_string dirname; ];
Oops, something went wrong.

0 comments on commit dd85106

Please sign in to comment.