Permalink
Browse files

[repo-server] read/write OPAM server can now be used as a repository …

…pluggin.

* all tests pass
* To use this kind of repo: 'opam init --kind server <name> <address>' or 'opam remote -add --kind server <name> <address>'
* the default is still the read-only 'rsync' kind
  • Loading branch information...
1 parent 8c038b3 commit bd3a03394f5553e5704098c9368a01a7afcef69d @samoht samoht committed May 16, 2012
View
@@ -74,7 +74,7 @@ let load_state () =
let ocaml_version = File.Config.ocaml_version config in
let compiler = Path.C.create global ocaml_version in
let repositories = File.Config.repositories config in
- let repositories = List.map (fun r -> r, Path.R.create global r) repositories in
+ let repositories = List.map (fun r -> r, Path.R.create r) repositories in
let repo_index = File.Repo_index.safe_read (Path.G.repo_index global) in
let installed = File.Installed.safe_read (Path.C.installed compiler) in
let reinstall = File.Reinstall.safe_read (Path.C.reinstall compiler) in
@@ -99,7 +99,7 @@ let update () =
log "update";
let t = load_state () in
(* first update all the repo *)
- List.iter (fun (r,p) -> Repositories.update p r) t.repositories;
+ List.iter (fun (r,_) -> Repositories.update r) t.repositories;
(* then update $opam/repo/index *)
let repo_index =
List.fold_left (fun repo_index (r,p) ->
@@ -180,13 +180,13 @@ let init repo =
let ocaml_version = OCaml_V.of_string Sys.ocaml_version in
let config = File.Config.create opam_version [repo] ocaml_version in
let compiler = Path.C.create root ocaml_version in
- let repo_p = Path.R.create root repo in
+ let repo_p = Path.R.create repo in
(* Create (possibly empty) configuration files *)
File.Config.write config_f config;
File.Installed.write (Path.C.installed compiler) File.Installed.empty;
File.Repo_index.write (Path.G.repo_index root) N.Map.empty;
File.Repo_config.write (Path.R.config repo_p) repo;
- Repositories.init repo_p repo;
+ Repositories.init repo;
Dirname.mkdir (Path.G.opam_dir root);
Dirname.mkdir (Path.G.descr_dir root);
Dirname.mkdir (Path.G.archive_dir root);
@@ -438,7 +438,7 @@ let get_archive t nv =
let repo = N.Map.find name t.repo_index in
let repo_p = find_repository_path t repo in
let repo = find_repository t repo in
- Repositories.download repo_p repo nv;
+ Repositories.download repo nv;
let src = Path.R.archive repo_p nv in
let dst = Path.G.archive t.global nv in
Filename.link src dst;
@@ -461,6 +461,7 @@ let contents_of_variable t v =
(* Substitute the file contents *)
let substitute_file t f =
+ let f = Filename.of_basename f in
let src = Filename.add_extension f "in" in
let contents = File.Subst.read src in
let newcontents = File.Subst.replace contents (contents_of_variable t) in
@@ -477,12 +478,12 @@ let proceed_tochange t nv_old nv =
Dirname.rmdir p_build;
Filename.extract (get_archive t nv) p_build;
- (* OPAM files should be read in the right directory to get the
- correct absolute path for the substitution files *)
- Dirname.chdir (Path.C.build t.compiler nv);
let opam = File.OPAM.read (Path.G.opam t.global nv) in
- (* Substitute the configuration files *)
+ (* Substitute the configuration files. We should be in the right
+ directory to get the correct absolute path for the substitution
+ files (see [substitute_file] and [Filename.of_basename]. *)
+ Dirname.chdir (Path.C.build t.compiler nv);
List.iter (substitute_file t) (File.OPAM.substs opam);
(* Call the build script and copy the output files *)
@@ -684,7 +685,7 @@ let upload upload repo =
Filename.copy upload.opam upload_opam;
Filename.copy upload.descr upload_descr;
Filename.copy upload.archive upload_archives;
- Repositories.upload repo_p repo;
+ Repositories.upload repo;
Filename.remove upload_opam;
Filename.remove upload_descr;
Filename.remove upload_archives
View
@@ -282,7 +282,7 @@ module OPAM = struct
name : N.t;
version : V.t;
maintainer : string;
- substs : filename list;
+ substs : basename list;
build : string list list;
depends : Debian.Format822.vpkgformula;
conflicts : Debian.Format822.vpkglist;
@@ -372,7 +372,7 @@ module OPAM = struct
items = [
Variable (s_version, String (V.to_string t.version));
Variable (s_maintainer, String t.maintainer);
- Variable (s_substs, make_list (Filename.to_string |> make_string) t.substs);
+ Variable (s_substs, make_list (Basename.to_string |> make_string) t.substs);
Variable (s_build, make_list (make_list make_string) t.build);
Variable (s_depends, make_or_formula t.depends);
Variable (s_conflicts, make_and_formula t.conflicts);
@@ -396,7 +396,7 @@ module OPAM = struct
let version = assoc s s_version (parse_string |> V.of_string) in
let maintainer = assoc s s_maintainer parse_string in
let substs =
- assoc_list s s_substs (parse_list (parse_string |> Filename.of_string)) in
+ assoc_list s s_substs (parse_list (parse_string |> Basename.of_string)) in
let build =
assoc_default Globals.default_build_command
s s_build (parse_list (parse_list parse_string)) in
View
@@ -68,7 +68,7 @@ module OPAM: sig
val maintainer: t -> string
(** File substitutions *)
- val substs: t -> filename list
+ val substs: t -> basename list
(** List of command to run for building the package *)
val build: t -> string list list
View
@@ -258,15 +258,11 @@ let parse_or_formula = function
| x -> bad_format "Expecting list, got %s" (kind x)
let make_constraint = function
- | name, None -> [String name]
- | name, Some (r,v) -> [String name; Group [Symbol r; String v]]
+ | name, None -> String name
+ | name, Some (r,v) -> Option (String name, [Symbol r; String v])
let make_and_formula_aux l =
- let l = List.map make_constraint l in
- List.fold_right (fun elt -> function
- | [] -> elt
- | accu -> accu @ elt
- ) l []
+ List.map make_constraint l
let make_and_formula l =
List (make_and_formula_aux l)
View
@@ -150,7 +150,7 @@ let config = {
-> Variable (Full_variable.of_string (List.hd names))
| Some `Var ->
bad_argument "config" "-var takes exactly one parameter"
- | Some `Subst -> Subst (List.map Filename.of_string names)
+ | Some `Subst -> Subst (List.map Basename.of_string names)
| None -> mk names in
Client.config config
}
View
@@ -105,8 +105,8 @@ module R = struct
type t = dirname (* [$opam/repo/$repo/] *)
- let create global r =
- G.root global / "repo" / Repository.name r
+ let create r =
+ Dirname.of_string !Globals.root_path / "repo" / Repository.name r
let of_path path = path
@@ -135,10 +135,16 @@ module R = struct
let upload t = t / "upload"
- let upload_opam t nv = upload t / "opam" // (NV.to_string nv ^ ".opam")
+ let upload_opam_dir t = upload t / "opam"
- let upload_descr t nv = upload t / "descr" // NV.to_string nv
+ let upload_descr_dir t = upload t / "descr"
- let upload_archives t nv = upload t / "archives" // (NV.to_string nv ^ ".tar.gz")
+ let upload_archives_dir t = upload t / "archives"
+
+ let upload_opam t nv = upload_opam_dir t // (NV.to_string nv ^ ".opam")
+
+ let upload_descr t nv = upload_descr_dir t // NV.to_string nv
+
+ let upload_archives t nv = upload_archives_dir t // (NV.to_string nv ^ ".tar.gz")
end
View
@@ -128,7 +128,7 @@ module R : sig
type t
(** Create a repository path *)
- val create: G.t -> repository -> t
+ val create: repository -> t
(** Transform a directory name into a repository path *)
val of_path: dirname -> t
@@ -177,6 +177,18 @@ module R : sig
val upload: t -> dirname
(** Return the upload folder for OPAM files:
+ {i $opam/repo/$repo/upload/opam/}*)
+ val upload_opam_dir: t -> dirname
+
+ (** Return the upload folder for descr files:
+ {i $opam/repo/$repo/upload/descr/} *)
+ val upload_descr_dir: t -> dirname
+
+ (** Return the upload folder for archive files:
+ {i $opam/repo/$repo/upload/archives/} *)
+ val upload_archives_dir: t -> dirname
+
+ (** Return the upload folder for OPAM files:
{i $opam/repo/$repo/upload/opam/$NAME.$VERSION.opam}*)
val upload_opam: t -> NV.t -> filename
@@ -17,6 +17,8 @@ open Unix
open Protocol
open Types
+let log fmt = Globals.log "CLIENT" fmt
+
let rpc host =
let addr = ADDR_INET (host, default_port) in
process_client (open_connection addr)
View
@@ -26,6 +26,14 @@ type t = {
available: NV.Set.t
}
+let init () =
+ log "init server state";
+ let global = Path.G.create (Dirname.of_string !Globals.root_path) in
+ Dirname.mkdir (Path.G.opam_dir global);
+ Dirname.mkdir (Path.G.descr_dir global);
+ Dirname.mkdir (Path.G.archive_dir global);
+ Dirname.mkdir (Key.hashes_dir ())
+
let load_state () =
let global = Path.G.create (Dirname.of_string !Globals.root_path) in
let available = Path.G.available global in
@@ -36,14 +44,18 @@ let get_file n v fn =
let nv = NV.create (N.of_string n) (V.of_string v) in
Run.read (Filename.to_string (fn t.global nv))
+let global_mutex = Mutex.create ()
+
let write_files n v o d a =
let t = load_state () in
let nv = NV.create (N.of_string n) (V.of_string v) in
let write fn c =
Run.write (Filename.to_string (fn t.global nv)) c in
+ Mutex.lock global_mutex;
write Path.G.opam o;
write Path.G.descr d;
- write Path.G.archive a
+ write Path.G.archive a;
+ Mutex.unlock global_mutex
let process_request id = function
| ClientVersion v ->
@@ -72,16 +84,21 @@ let process_request id = function
log "NewPackage (%s,%s,%s,%s,_)" n v o d;
write_files n v o d a;
let key = Key.create () in
- Key.write (N.of_string n) key;
+ Key.write_hash (N.of_string n) (Key.hash key);
Key (Key.to_string key)
| NewVersion (n,v,o,d,a,k) ->
- log "NewVersion (%s,%s,%s,%s,_,%s)" n v o d k;
- let key = Key.read (N.of_string n) in
- if key = (Digest.string k) then (
- write_files n v o d a;
- OK
- ) else
- Error "Wrong key"
+ log "NewVersion (%s,%s,%s,%s,_,_)" n v o d;
+ let key = Key.of_string k in
+ let name = N.of_string n in
+ if Key.exists_hash name then
+ let hash = Key.read_hash name in
+ if hash = Key.hash key then (
+ write_files n v o d a;
+ OK
+ ) else
+ Error (n ^ ": wrong key")
+ else
+ Error (n ^ ": unknown package")
let process (stdin, stdout) fn =
process_server (stdin, stdout) fn
@@ -17,6 +17,9 @@
open Protocol
+(** Initialize the server state *)
+val init: unit -> unit
+
(** Main request processing function. [process_request id req]
processes the client request [req] and procuces a server
answer. Eventual log messages are tagged with [id]. *)
@@ -1,4 +1,23 @@
(* Download script for OPAM server repositories *)
let _ =
- failwith "TODO"
+ if Array.length Sys.argv <> 3 then (
+ Printf.eprintf "Usage: %s <remote-address> <package>" Sys.argv.(0);
+ exit 1
+ )
+
+open Types
+open Protocol
+open Unix
+
+let local_path = Path.R.of_path (Dirname.of_string (Run.cwd ()))
+let remote_address =
+ try inet_addr_of_string Sys.argv.(1)
+ with _ ->
+ (gethostbyname Sys.argv.(1)).h_addr_list.(0)
+
+let package = NV.of_string Sys.argv.(2)
+
+let () =
+ let archive = Client.get_archive remote_address package in
+ Filename.write (Path.R.archive local_path package) archive
View
@@ -2,33 +2,12 @@
let _ =
if Array.length Sys.argv <> 2 then (
- Printf.eprintf "Usage: opam-git-init <remote-address>";
+ Printf.eprintf "Usage: %s <remote-address>" Sys.argv.(0);
exit 1
)
-open Types
-open Protocol
-open Unix
-
-let local_path = Path.R.of_path (Dirname.of_string (Run.cwd ()))
-let remote_address =
- try inet_addr_of_string Sys.argv.(1)
- with _ ->
- (gethostbyname Sys.argv.(1)).h_addr_list.(0)
-
let () =
- let s = Client.get_list remote_address in
- let opams =
- NV.Set.fold (fun nv accu ->
- (nv, Client.get_opam remote_address nv) :: accu
- ) s [] in
- let descrs =
- NV.Set.fold (fun nv accu ->
- (nv, Client.get_descr remote_address nv) :: accu
- ) s [] in
- List.iter (fun (nv,c) ->
- File.OPAM.write (Path.R.opam local_path nv) c
- ) opams;
- List.iter (fun (nv,c) ->
- File.Descr.write (Path.R.descr local_path nv) c
- ) descrs
+ Run.mkdir "opam";
+ Run.mkdir "descr";
+ Run.mkdir "archives";
+ Run.mkdir "keys"
Oops, something went wrong.

0 comments on commit bd3a033

Please sign in to comment.