Permalink
Browse files

Add --root to ocp-get and ocp-get-server to change the default root p…

…aths
  • Loading branch information...
samoht committed Mar 8, 2012
1 parent bf0895a commit f8dc2211c14be90f281ab3f63bf2e0972b24ac65
Showing with 124 additions and 69 deletions.
  1. +4 −1 Makefile
  2. +0 −3 README.md
  3. +32 −24 src/client.ml
  4. +17 −13 src/file.ml
  5. +8 −2 src/globals.ml
  6. +8 −1 src/ocp_get.ml
  7. +8 −3 src/ocp_get_server.ml
  8. +24 −11 src/path.ml
  9. +6 −4 src/server.ml
  10. +17 −7 tests/Makefile
View
@@ -69,4 +69,7 @@ distclean:
.PHONY: tests
tests:
- make -C tests
+ make -C tests
+
+tests-runserver:
+ make -C tests runserver
View
@@ -28,6 +28,3 @@ is listening to. You can open an other terminal and run:
make tests
```
-WARNING: the tests will remove everything in `~/.opam` and
-`~/.opam-server`.
-
View
@@ -46,11 +46,11 @@ module Client : CLIENT = struct
{ server : url
; home : Path.t (* ~/.opam *) }
- let home = Path.init Globals.opam_path
(* Look into the content of ~/.opam/config to build the client state *)
let load_state () =
- let config = File.Config.find (Path.config home) in
+ let home = Path.init !Globals.root_path in
+ let config = Path.read File.Config.find (Path.config home) in
{ server = File.Config.sources config
; home }
@@ -70,6 +70,7 @@ module Client : CLIENT = struct
let init url =
log "init %s" (string_of_url url);
+ let home = Path.init !Globals.root_path in
let config =
File.Config.create
(Version Globals.opam_version)
@@ -90,39 +91,41 @@ module Client : CLIENT = struct
N_map.modify_def V_set.empty n (V_set.add v) map) N_map.empty l)
let info package =
- log "info %s" (match package with None -> "" | Some p -> Namespace.string_of_name p);
+ log "info %s" (match package with None -> "ALL" | Some p -> Namespace.string_of_name p);
let t = load_state () in
let s_not_installed = "--" in
match package with
| None ->
(* Get all the installed packages *)
- let install_set = NV_set.of_enum (BatList.enum (File.Installed.find (Path.installed t.home))) in
+ let installed = Path.read File.Installed.find (Path.installed t.home) in
+ let install_set = NV_set.of_enum (BatList.enum installed) in
let map, max_n, max_v =
List.fold_left
(fun (map, max_n, max_v) n_v ->
let b = NV_set.mem n_v install_set in
- NV_map.add n_v
- (b, File.Opam.description (File.Opam.find (Path.index_opam t.home (Some n_v))))
- map,
- max max_n (String.length (Namespace.string_user_of_name (fst n_v))),
- if b then max max_v (String.length (Namespace.string_user_of_version (snd n_v))) else max_v)
+ let opam = Path.read File.Opam.find (Path.index_opam t.home (Some n_v)) in
+ let new_map = NV_map.add n_v (b, File.Opam.description opam) map in
+ let new_max_n = max max_n (String.length (Namespace.string_user_of_name (fst n_v))) in
+ let new_max_v =
+ if b then max max_v (String.length (Namespace.string_user_of_version (snd n_v))) else max_v in
+ new_map, new_max_n, new_max_v)
(NV_map.empty, min_int, String.length s_not_installed)
(Path.index_opam_list t.home) in
NV_map.iter (fun n_v (b, description) ->
- Printf.printf "%s %s %s"
+ Printf.printf "%s %s %s\n"
(indent_left (Namespace.string_user_of_name (fst n_v)) max_n)
(indent_right (if b then Namespace.string_user_of_version (snd n_v) else s_not_installed) max_v)
description) map;
Printf.printf "\n"
| Some name ->
let find_from_name = find_from_name name in
-
+ let installed = Path.read File.Installed.find (Path.installed t.home) in
let o_v =
BatOption.map
V_set.choose (* By definition, there is exactly 1 element, we choose it. *)
- (find_from_name (File.Installed.find (Path.installed t.home))) in
+ (find_from_name installed) in
let v_set =
let v_set =
@@ -144,8 +147,9 @@ module Client : CLIENT = struct
) v_set
; "description", "\n" ^
match o_v with None -> ""
- | Some v ->
- File.Opam.description (File.Opam.find (Path.index_opam t.home (Some (name, v))))
+ | Some v ->
+ let opam = Path.read File.Opam.find (Path.index_opam t.home (Some (name, v))) in
+ File.Opam.description opam
]
let confirm msg =
@@ -172,7 +176,7 @@ module Client : CLIENT = struct
f_build t tgz;
- let to_install = File.To_install.find (Path.to_install t.home (name, v)) in
+ let to_install = Path.read File.To_install.find (Path.to_install t.home (name, v)) in
let filename_of_path_relative t path =
Path.R_filename (File.To_install.filename_of_path_relative t.home
@@ -201,7 +205,8 @@ module Client : CLIENT = struct
(File.To_install.misc to_install)
let proceed_todelete t (n, v0) =
- let map_installed = N_map.of_enum (BatList.enum (File.Installed.find (Path.installed t.home))) in
+ let installed = Path.read File.Installed.find (Path.installed t.home) in
+ let map_installed = N_map.of_enum (BatList.enum installed) in
match N_map.Exceptionless.find n map_installed with
| Some v when v = v0 ->
iter_toinstall
@@ -257,8 +262,9 @@ module Client : CLIENT = struct
let l_pkg, map_pkg =
List.fold_left
- (fun (l, map) n_v ->
- let pkg = File.Opam.package (File.Opam.find (Path.index_opam t.home (Some n_v))) in
+ (fun (l, map) n_v ->
+ let opam = Path.read File.Opam.find (Path.index_opam t.home (Some n_v)) in
+ let pkg = File.Opam.package opam in
pkg :: l, PkgMap.add pkg n_v map) ([], PkgMap.empty) l_index in
let l =
BatList.map (Solver.solution_map (fun p -> PkgMap.find p map_pkg)) (Solver.resolve l_pkg request) in
@@ -296,7 +302,8 @@ module Client : CLIENT = struct
let remove name =
log "remove %s" (Namespace.string_of_name name);
let t = load_state () in
- let r = match BatList.Exceptionless.assoc name (File.Installed.find (Path.installed t.home)) with
+ let installed = Path.read File.Installed.find (Path.installed t.home) in
+ let r = match BatList.Exceptionless.assoc name installed with
| None ->
let msg =
Printf.sprintf "Package \"%s\" not found. We will call the solver to see its output."
@@ -317,10 +324,11 @@ module Client : CLIENT = struct
let upgrade () =
log "upgrade";
let t = load_state () in
- resolve t (Path.index_opam_list t.home)
- { Solver.wish_install = []
- ; wish_remove = []
- ; wish_upgrade = BatList.map vpkg_of_nv (File.Installed.find (Path.installed t.home)) }
+ let installed = Path.read File.Installed.find (Path.installed t.home) in
+ resolve t (Path.index_opam_list t.home)
+ { Solver.wish_install = []
+ ; wish_remove = []
+ ; wish_upgrade = BatList.map vpkg_of_nv installed }
(* Upload reads NAME.opam to get the current package version.
Then it looks for NAME-VERSION.tar.gz in the same directory.
@@ -347,7 +355,7 @@ module Client : CLIENT = struct
(* Upload both files to the server and update the client
filesystem to reflect the new uploaded packages *)
let nv = Namespace.Name name, version in
- let local_server = Server.init Globals.opam_path in
+ let local_server = Server.init !Globals.root_path in
RemoteServer.newArchive t.server nv opam archive;
Server.newArchive local_server nv opam archive
View
@@ -15,8 +15,8 @@ struct
(** Return the content of a file as a string *)
val to_string: t -> string
- (** Find a file. Raise [Not_found] is the file does not exists *)
- val find : Path.filename -> t
+ (** Find a file. Return [None] if the file does not exists *)
+ val find : Path.filename -> t option
(** Add a file *)
val add : Path.filename -> t -> unit
@@ -95,7 +95,8 @@ struct
let find f =
log "find %s" (Path.string_of_filename f);
match Path.find_binary f with
- | Path.File (Raw_binary s) -> parse s
+ | Path.File (Raw_binary s) -> Some (parse s)
+ | Path.Not_found _ -> None
| Path.Directory _ -> failwith (Printf.sprintf "%s is a directory" (Path.string_of_filename f))
let add f v =
@@ -153,11 +154,11 @@ struct
let find f =
log "find %s" (Path.string_of_filename f);
match Path.find_binary f with
- | Path.File (Raw_binary s) ->
- (try parse s
- with _ ->
- failwith ("Error while parsing " ^ Path.string_of_filename f))
- | _ -> raise Not_found
+ | Path.File (Raw_binary s) ->
+ (try Some (parse s)
+ with _ -> failwith ("Error while parsing " ^ Path.string_of_filename f))
+ | Path.Not_found _ -> None
+ | _ -> assert false
let add f v =
log "add %s" (Path.string_of_filename f);
@@ -266,8 +267,9 @@ struct
log "find %s" (Path.string_of_filename f);
match Path.find_binary f with
| Path.File (Raw_binary s) ->
- (try parse s
+ (try Some (parse s)
with _ -> failwith ("Error while parsing " ^ Path.string_of_filename f))
+ | Path.Not_found _ -> None
| _ -> raise Not_found
let add f v =
@@ -291,8 +293,9 @@ struct
let find f =
match Path.find_binary f with
- | Path.File (Raw_binary s) -> parse s
- | _ -> empty
+ | Path.File (Raw_binary s) -> Some (parse s)
+ | Path.Not_found _ -> Some empty
+ | _ -> assert false
let to_string =
BatIO.to_string
@@ -422,8 +425,9 @@ struct
let find f =
match Path.find_binary f with
- | Path.File (Raw_binary s) -> parse s
- | _ -> empty
+ | Path.File (Raw_binary s) -> Some (parse s)
+ | Path.Not_found _ -> Some empty
+ | _ -> assert false
let to_string t =
View
@@ -8,8 +8,11 @@ let default_port = 9999
let ocaml_version = Sys.ocaml_version
let opam_version = "1"
-let opam_server_path = ".opam-server"
-let opam_path = ".opam"
+let home = Unix.getenv "HOME"
+let default_opam_server_path = Filename.concat home ".opam-server"
+let default_opam_path = Filename.concat home ".opam"
+
+let root_path = ref default_opam_path
let log section fmt =
Printf.kprintf (fun str ->
@@ -27,3 +30,6 @@ let error_and_exit fmt =
error "%s" str;
exit 1
) fmt
+
+
+
View
@@ -23,9 +23,14 @@ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n"
let port = ref Globals.default_port
let ano_args = ref []
+let () = Globals.root_path := Globals.default_opam_path
+
let args = Arg.align [
"--debug" , Arg.Set Globals.debug, " Print more debug messages";
- "--version", Arg.Unit version, " Display version information";
+ "--version", Arg.Unit version, " Display version information";
+
+ "--root" , Arg.Set_string Globals.root_path,
+ (Printf.sprintf " Change root path (default is %s)" Globals.default_opam_path)
]
let _ = Arg.parse args (fun s -> ano_args := s :: !ano_args) usage
@@ -39,6 +44,8 @@ let filename_of_string s =
(BatString.nsplit (BatString.strip ~chars:"/" s) "/")
*)
let () =
+ Globals.log "CLIENT" "Root path is %s" !Globals.root_path;
+
let error msg =
Printf.eprintf "%s\n" msg;
nice_exit () in
View
@@ -22,22 +22,27 @@ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n"
let port = ref Globals.default_port
let set_port p = port := p
+let _ =
+ Globals.root_path := Globals.default_opam_server_path
let args = Arg.align [
"-p" , Arg.Int set_port , " Set up the listening port (default is 9999)";
"--debug" , Arg.Set Globals.debug, " Print more debug messages";
"--version", Arg.Unit version , " Display version information";
+
+ "--root" , Arg.Set_string Globals.root_path,
+ (Printf.sprintf " Change root path (default is %s)" Globals.default_opam_path)
]
let _ = Arg.parse args (fun s -> Printf.eprintf "%s: Unknown\n" s) usage
let server fn =
let host = (gethostbyname(gethostname ())).h_addr_list.(0) in
let addr = ADDR_INET (host, !port) in
- let state = Server.init Globals.opam_server_path in
+ let state = Server.init !Globals.root_path in
if !Globals.debug then
- Printf.printf "Listening on port %d (%s) ...\n%!"
- !port (string_of_inet_addr host);
+ Printf.printf "Root path is %s.\nListening on port %d (%s) ...\n%!"
+ !Globals.root_path !port (string_of_inet_addr host);
establish_server (fn state) addr
Oops, something went wrong.

0 comments on commit f8dc221

Please sign in to comment.