Merge branch 'master' of github.com:OCamlPro/opam

Makefile

@@ -4,6 +4,7 @@ OCAMLC=ocamlc
 SRC_EXT=src_ext
 TARGETS = opam opam-server \
 	  opam-rsync-init opam-rsync-update opam-rsync-download opam-rsync-upload \
+	  opam-curl-init opam-curl-update opam-curl-download opam-curl-upload \
 	  opam-git-init opam-git-update opam-git-download opam-git-upload \
 	  opam-server-init opam-server-update opam-server-download opam-server-upload \
 	  opam-mk-config opam-mk-install opam-mk-repo

opam.ocp

@@ -69,6 +69,33 @@ begin program "opam-rsync-upload"
   requires = [ "opam-lib" ]
 end
 
+(* CURL *)
+begin program "opam-curl-init"
+  files = [ "src/repo/curl/init.ml" ]
+  requires = [ "opam-lib" ]
+end
+
+begin program "opam-curl-update"
+  files = [
+    "src/repo/curl/misc.ml"
+    "src/repo/curl/update.ml"
+  ]
+  requires = [ "opam-lib" ]
+end
+
+begin program "opam-curl-download"
+  files = [
+    "src/repo/curl/misc.ml"
+    "src/repo/curl/download.ml"
+  ]
+  requires = [ "opam-lib" ]
+end
+
+begin program "opam-curl-upload"
+  files = [ "src/repo/curl/upload.ml" ]
+  requires = [ "opam-lib" ]
+end
+
 
 (* GIT *)
 begin program "opam-git-init"

src/client.ml

@@ -117,14 +117,27 @@ let find_available_package_by_name t name =
   else
     Some s
 
-let update () =
-  log "update";
-  let t = load_state () in
-
-  (* first update all the repo *)
-  List.iter (fun (r,_) -> Repositories.update r) t.repositories;
-
-  (* then update $opam/repo/index *)
+let print_updated t updated =
+  if not (NV.Set.is_empty updated) then
+    Globals.msg "New packages available:\n";
+  NV.Set.iter (fun nv ->
+    Globals.msg " - %s%s\n"
+      (NV.to_string nv)
+      (if NV.Set.mem nv t.installed then " (*)" else "")
+  ) updated
+
+let print_compilers compilers repo =
+  let repo_compilers = Path.R.compiler_list repo in
+  let new_compilers = OCaml_V.Set.diff repo_compilers compilers in
+  if not (OCaml_V.Set.is_empty new_compilers) then
+    Globals.msg "New compiler descriptions available:\n";
+  OCaml_V.Set.iter (fun v ->
+    Globals.msg " -  %s\n" (OCaml_V.to_string v)
+  ) new_compilers
+
+let update_repo_index t =
+
+  (* If there are new packages, assign them to some repository *)
   let repo_index =
     List.fold_left (fun repo_index (r,p) ->
       let available = Path.R.available p in
@@ -139,19 +152,46 @@ let update () =
     ) t.repo_index t.repositories in
   File.Repo_index.write (Path.G.repo_index t.global) repo_index;
 
-  (* update $opam/$oversion/reinstall *)
+  (* Create symbolic links from $repo dirs to main dir *)
+  N.Map.iter (fun n r ->
+    let repo_p = find_repository_path t r in
+    let available_versions = Path.R.available_versions repo_p n in
+    V.Set.iter (fun v ->
+      let nv = NV.create n v in
+      let opam_dir = Path.G.opam_dir t.global in
+      let opam_f = Path.R.opam repo_p nv in
+      let descr_dir = Path.G.descr_dir t.global in
+      let descr = Path.R.descr repo_p nv in
+      Filename.link_in opam_f opam_dir;
+      if Filename.exists descr then
+        Filename.link_in descr descr_dir
+      else
+        Globals.msg "WARNING: %s does not exist\n" (Filename.to_string descr)
+    ) available_versions;
+  ) repo_index
+
+let update () =
+  log "update";
+  let t = load_state () in
+  let compilers = Path.G.compiler_list t.global in
+
+  (* first update all the repo *)
+  List.iter (fun (r,_) -> Repositories.update r) t.repositories;
+
+  (* Display the new compilers available *)
+  List.iter (fun (_, r) -> print_compilers compilers r) t.repositories;
+
+  (* then update $opam/repo/index *)
+  update_repo_index t;
+
   let updated = 
-    List.rev_map (fun (r,p) ->
+    List.rev_map (fun (_,p) ->
       let updated = File.Updated.safe_read (Path.R.updated p) in
-      if not (NV.Set.is_empty updated) then
-        Globals.msg "New packages available:\n";
-      NV.Set.iter (fun nv ->
-        Globals.msg " - %s%s\n"
-          (NV.to_string nv)
-          (if NV.Set.mem nv t.installed then " (*)" else "")
-      ) updated;
-      updated
+      print_updated t updated;
+      updated;
     ) t.repositories in  
+
+  (* update $opam/$oversion/reinstall *)
   Path.G.fold_compiler (fun () compiler ->
     let installed = File.Installed.safe_read (Path.C.installed compiler) in
     let reinstall = File.Reinstall.safe_read (Path.C.reinstall compiler) in
@@ -168,23 +208,6 @@ let update () =
       File.Reinstall.write (Path.C.reinstall compiler) reinstall
   ) () t.global;
 
-  (* finally create symbolic links from $repo dirs to main dir *)
-  N.Map.iter (fun n r ->
-    let repo_p = find_repository_path t r in
-    let available_versions = Path.R.available_versions repo_p n in
-    V.Set.iter (fun v ->
-      let nv = NV.create n v in
-      let opam_dir = Path.G.opam_dir t.global in
-      let opam_f = Path.R.opam repo_p nv in
-      let descr_dir = Path.G.descr_dir t.global in
-      let descr = Path.R.descr repo_p nv in
-      Filename.link_in opam_f opam_dir;
-      if Filename.exists descr then
-        Filename.link_in descr descr_dir
-      else
-        Globals.msg "WARNING: %s does not exist\n" (Filename.to_string descr)
-    ) available_versions
-  ) repo_index;
   (* XXX: we could have a special index for compiler descriptions as
   well, but that's become a bit too heavy *)
   List.iter (fun (r,p) ->
@@ -416,7 +439,7 @@ let list () =
           map, max_n, max_v
         else
           let is_installed = NV.Set.mem nv installed in
-          let descr_f = File.Descr.read (Path.G.descr t.global nv) in
+          let descr_f = File.Descr.safe_read (Path.G.descr t.global nv) in
           let synopsis = File.Descr.synopsis descr_f in
           let map = N.Map.add name ((if is_installed then Some version else None), synopsis) map in
           let max_n = max max_n (String.length (N.to_string name)) in
@@ -482,9 +505,15 @@ let info package =
      @ libraries
      @ syntax
      @ let latest = match o_v with
-         | None   -> V.Set.max_elt v_set
-         | Some v -> v in
-       let descr = File.Descr.read (Path.G.descr t.global (NV.create package latest)) in
+         | Some v -> Some v
+         | None   ->
+             try Some (V.Set.max_elt v_set)
+             with Not_found -> None in
+       let descr =
+         match latest with
+         | None   -> File.Descr.empty
+         | Some v ->
+             File.Descr.safe_read (Path.G.descr t.global (NV.create package v)) in
        [ "description", File.Descr.full descr ]
     )
 
@@ -1161,15 +1190,6 @@ let remote action =
   let update_config repos =
     let new_config = File.Config.with_repositories t.config repos in
     File.Config.write (Path.G.config t.global) new_config in
-  let add repo =
-    let name = Repository.name repo in
-    if List.exists (fun r -> Repository.name r = name) repos then
-      Globals.error_and_exit "%s is already a remote repository" name
-    else (
-      log "Adding %s" (Repository.to_string repo);
-      Repositories.init repo;
-      update_config (repo :: repos)
-    ) in
   match action with
   | List  ->
       let pretty_print r =
@@ -1183,13 +1203,31 @@ let remote action =
         line "NAME" "ADDRESS" "KIND" line;
       List.iter pretty_print repos;
       Globals.msg "%s\n" line
-  | Add r -> add r
+  | Add repo ->
+      let name = Repository.name repo in
+      if List.exists (fun r -> Repository.name r = name) repos then
+        Globals.error_and_exit "%s is already a remote repository" name
+      else (
+        log "Adding %s" (Repository.to_string repo);
+        Repositories.init repo;
+        update_config (repo :: repos)
+      );
+      update ()
   | Rm n  ->
       let repo =
         try List.find (fun r -> Repository.name r = n) repos
         with Not_found ->
           Globals.error_and_exit "%s is not a remote index" n in
-      update_config (List.filter ((!=) repo) repos)
+      update_config (List.filter ((!=) repo) repos);
+      let repo_index =
+        N.Map.fold (fun n r repo_index ->
+          if r = Repository.name repo then
+            repo_index
+          else
+            N.Map.add n r repo_index
+        ) t.repo_index N.Map.empty in
+        File.Repo_index.write (Path.G.repo_index t.global) repo_index;
+      Dirname.rmdir (Path.R.root (Path.R.create repo))
 
 let compiler_list () =
   log "compiler_list";

src/globals.ml

@@ -26,7 +26,7 @@ let version = "0.1+dev"
 
 let default_repository_name    = "default"
 let default_repository_address = "http://opam.ocamlpro.com"
-let default_repository_kind    = "rsync"
+let default_repository_kind    = "curl"
 
 let default_build_command = [ [ "./build.sh" ] ]
 
@@ -90,4 +90,4 @@ let os = match Sys.os_type with
   | "Cygwin" -> Cygwin
   | _        -> assert false
 
-let default_cores = 4
+let default_cores = 1

src/opam.ml

@@ -44,9 +44,13 @@ let noanon cmd s =
 
 let () = Globals.root_path := Globals.default_opam_path
 
+(* Useful for switch, who overwrite the default verbose flag *)
+let quiet = ref false
+
 let global_args = [
   "--debug"  , Arg.Set Globals.debug, " Print more debug messages";
-  "--verbose", Arg.Set Globals.verbose, " Display stdout/stderr of subprocesses";
+  "--verbose", Arg.Set Globals.verbose, " Display the stdout/stderr of subprocesses";
+  "--quiet"  , Arg.Clear quiet, " Not display the stdout/stderr of subprocesses";
   "--version", Arg.Unit version,      " Display version information";
   "--yes"    , Arg.Set Globals.yes,   " Answer yes to all questions";
   "--root"   , Arg.Set_string Globals.root_path,
@@ -288,7 +292,7 @@ let remote =
 }
 
 (* opam switch [-clone] OVERSION *)
-let switch = 
+let switch =
   let command : [`switch|`list] ref = ref `switch in
   let clone = ref false in
   let alias = ref "" in
@@ -305,6 +309,7 @@ let switch =
   ];
   anon;
   main     = parse_args (fun args ->
+    if not !quiet then Globals.verbose := true;
     match !command, args with
     | `list  , []     -> Client.compiler_list ()
     | `switch, []     -> bad_argument "switch" "Compiler name is missing"

src/process.ml

@@ -77,18 +77,20 @@ type result = {
 
 (* XXX: the function might block for ever for some channels kinds *)
 let read_lines f =
-  let ic = open_in f in
-  let lines = ref [] in
-  begin
-    try
-      while true do
-        let line = input_line ic in
-        lines := line :: !lines;
-      done
-    with _ -> ()
-  end;
-  close_in ic;
-  List.rev !lines
+  try
+    let ic = open_in f in
+    let lines = ref [] in
+    begin
+      try
+        while true do
+          let line = input_line ic in
+          lines := line :: !lines;
+        done
+      with _ -> ()
+    end;
+    close_in ic;
+    List.rev !lines
+  with _ -> []
 
 let option_map fn = function
   | None   -> None
@@ -147,7 +149,7 @@ let run ?env ~name cmd args =
         String.concat "\n" (Array.to_list env)
       ];
     close_out chan;
-    
+
     let p = create ~env ~info ~stdout ~stderr cmd args in
     wait p
   with e ->
@@ -162,7 +164,10 @@ let option_iter fn = function
   | None   -> ()
   | Some v -> fn v
 
+let safe_unlink f =
+  try Unix.unlink f with _ -> ()
+
 let clean_files r =
-  option_iter Unix.unlink r.r_proc.p_stdout;
-  option_iter Unix.unlink r.r_proc.p_stderr;
-  option_iter Unix.unlink r.r_proc.p_info
+  option_iter safe_unlink r.r_proc.p_stdout;
+  option_iter safe_unlink r.r_proc.p_stderr;
+  option_iter safe_unlink r.r_proc.p_info

src/process.mli

@@ -65,3 +65,6 @@ val is_failure : result -> bool
 
 (** Clean-up process result files *)
 val clean_files : result -> unit
+
+(** {2 Misc} *)
+val read_lines: string -> string list