Fix ocp-get init

It seems to work fine now, and when the server is running it is able to communicate with it

Also, start adding some useful debug message

Makefile

@@ -4,7 +4,7 @@ TARGET   = ocp-get ocp-get-server
 
 .PHONY: all
 
-all: ./_obuild/unixrun compile clone
+all: ./_obuild/unixrun compile clone link
 	@
 
 scan: ./_obuild/unixrun
@@ -19,6 +19,10 @@ opt: ./_obuild/unixrun
 	mkdir -p ./_obuild
 	ocamlc -o ./_obuild/unixrun -make-runtime unix.cma
 
+link:
+	ln -s _obuild/ocp-get/ocp-get.asm ocp-get
+	ln -s _obuild/ocp-get-server/ocp-get-server.asm ocp-get-server
+
 compile: ./_obuild/unixrun clone
 	$(OCPBUILD) -init -scan -sanitize $(TARGET)
 
@@ -48,6 +52,7 @@ ocamlgraph:
 clean:
 	$(OCPBUILD) -clean
 	rm -rf src/*.annot bat/*.annot
+	rm -f ocp-get ocp-get-server
 
 ocaml-re:
 	git clone https://github.com/avsm/ocaml-re

ocp-get.ocp

@@ -1,3 +1,5 @@
+comp = [ "-g" ]
+
 begin library "extlib"
    sort = true
    files = [
@@ -164,8 +166,8 @@ end
 
 begin library "ocp-get-lib"
   dirname = [ "src" ]
-  comp = [ "-annot" ]
-  files = [
+  comp   += [ "-annot" ]
+  files   = [
     "globals.ml"
     "namespace.ml"
     "path.ml"
@@ -183,7 +185,7 @@ end
 
 begin program "ocp-get"
   dirname  = [ "src" ]
-  comp     = [ "-annot" ]
+  comp    += [ "-annot" ]
   files    = [
     "solver.ml"
     "client.ml"
@@ -194,7 +196,7 @@ end
 
 begin program "ocp-get-server"
   dirname  = [ "src" ]
-  comp     = [ "-annot" ]
+  comp    += [ "-annot" ]
   files    = [ "ocp_get_server.ml" ]
   requires = [ "ocp-get-lib" ]
 end

src/client.ml

@@ -3,6 +3,9 @@ open Path
 open Server
 open Solver
 
+let log fmt =
+  Globals.log "CLIENT" fmt
+
 module type CLIENT =
 sig
   type t
@@ -46,7 +49,8 @@ module Client : CLIENT = struct
   (* Look into the content of ~/.opam/config to build the client state *)
   let load_state () =
     let home = Path.init Globals.opam_path in
-    { server = File.Config.sources (File.Config.find home (Path.config home))
+    let config = File.Config.find home (Path.config home) in
+    { server = File.Config.sources config
     ;  home }
 
   let update_aux t =
@@ -79,12 +83,13 @@ module Client : CLIENT = struct
     update_aux (load_state ())
 
   let init url =
+    log "init %s" (string_of_url url);
     let config =
       File.Config.config
         (Version Globals.default_opam_version)
         url
         (Version Globals.default_ocaml_version) in
-    let home = Path.init Globals.opam_path in (* THOMAS: not sure about that *)
+    let home = Path.init Globals.opam_path in
     File.Config.add home (Path.config home) config;
     update ()
 
@@ -99,11 +104,10 @@ module Client : CLIENT = struct
          (fun map (n, v) -> 
             N_map.modify_def V_set.empty n (V_set.add v) map) N_map.empty l)
 
-  let info =
+  let info package =
     let t = load_state () in
     let s_not_installed = "--" in
-
-    function
+    match package with
     | None -> 
         let install_set = NV_set.of_enum (BatList.enum (File.Installed.find t.home (Path.installed t.home))) in
         let map, max_n, max_v = 
@@ -371,9 +375,3 @@ module Client : CLIENT = struct
           Printf.printf "-I %s" 
             (match Path.ocaml_options_of_library t.home name with I s -> s)
 end
-
-
-
-
-
-

src/file.ml

@@ -56,26 +56,36 @@ struct
       ocaml_version = Version Sys.ocaml_version
     }
 
-    let find t f = 
+    let find t f =
+      let aux contents =
+        let file = parse_colon contents in
+        let version = try List.assoc "version" file with _ -> Globals.default_opam_version in
+        let sources =
+          try
+            let sources = List.assoc "sources" file in
+            let hostname, port =  BatString.split sources ":" in
+            url hostname (try int_of_string port with _ -> Globals.default_port)
+          with _ ->
+            url Globals.default_hostname Globals.default_port in
+        let ocaml_version = try List.assoc "ocaml-version" file with _ -> Sys.ocaml_version in
+        { version = Version version; sources; ocaml_version = Version ocaml_version } in
+
       match Path.find t f with
-      | Path.File (Binary s) ->
-          let file = parse_colon s in
-          let version = try List.assoc "version" file with _ -> Globals.default_opam_version in
-          let sources =
-            try
-              let sources = List.assoc "sources" file in
-              let hostname, port =  BatString.split sources ":" in
-              url hostname (try int_of_string port with _ -> Globals.default_port)
-            with _ ->
-              url Globals.default_hostname Globals.default_port in
-          let ocaml_version = try List.assoc "ocaml-version" file with _ -> Sys.ocaml_version in
-          { version = Version version; sources; ocaml_version = Version ocaml_version }
-      | _ -> failwith (Printf.sprintf "%s does not exist" (Path.string_of_filename f))
+      | Path.File (Binary s)   -> aux s
+      | Path.File (Filename s) ->
+          let contents =
+            let ic = open_in s in
+            let n = in_channel_length ic in
+            let s = String.create n in
+            really_input ic s 0 n;
+            close_in ic;
+            s in
+          aux contents
+      | Path.Directory _ -> failwith (Printf.sprintf "%s is a directory" (Path.string_of_filename f))
+      | Path.Not_exists  -> failwith (Printf.sprintf "%s does not exist" (Path.string_of_filename f))
 
     let to_string t =
-      Printf.sprintf "
-version: %s
-sources: %s" 
+      Printf.sprintf "version: %s\nsources: %s\n"
         (match t.version with Version s -> s)
         (string_of_url t.sources)
 
@@ -187,9 +197,13 @@ sources: %s"
         | _ -> empty
 
     let to_string = 
-      BatIO.to_string (BatList.print (fun oc (name, version) -> BatString.print oc (Printf.sprintf "%s %s" 
-                                                                                      (Namespace.string_user_of_name name) 
-                                                                                      (Namespace.string_user_of_version version)))) 
+      BatIO.to_string
+        (BatList.print (fun oc (name, version) ->
+          BatString.print oc
+            (Printf.sprintf "%s %s" 
+               (Namespace.string_user_of_name name) 
+               (Namespace.string_user_of_version version))))
+
     let add t f v = Path.add t f (Path.File (Binary (to_string v)))
   end
 

src/globals.ml

@@ -10,3 +10,9 @@ let default_opam_version = "1"
 
 let opam_server_path = ".opam-server"
 let opam_path = ".opam"
+
+let log section fmt =
+  Printf.kprintf (fun str ->
+    if !debug then
+      Printf.eprintf " %-20s %s\n%!" section str
+  ) fmt

src/ocp_get.ml

@@ -38,7 +38,7 @@ let filename_of_string s =
     Path.root
     (BatString.nsplit (BatString.strip ~chars:"/" s) "/")
 *)
-let () = 
+let () =
   let error msg =
     Printf.eprintf "%s\n" msg;
     nice_exit () in

src/ocp_get_server.ml

@@ -41,15 +41,32 @@ let server fn =
 
   establish_server (fn state) addr
 
+let request = ref 0
+
+let log fmt =
+  Globals.log (Printf.sprintf "REQUEST-%d" !request) fmt
+
 let fn t stdin stdout =
+  incr request;
+  log "Processing an incoming request";
+
   let output = match (input_value stdin : input_api) with
-  | IgetList                    -> OgetList (Server.getList t)
-  | IgetOpam name_version       -> OgetOpam (Server.getOpam t name_version)
-  | IgetArchive opam            -> OgetArchive (Server.getArchive t opam)
+  | IgetList                    ->
+      log "getList";
+      OgetList (Server.getList t)
+  | IgetOpam name_version       ->
+      log "getOpam";
+      OgetOpam (Server.getOpam t name_version)
+  | IgetArchive opam            ->
+      log "getArchive";
+      OgetArchive (Server.getArchive t opam)
   | InewArchive (opam, archive) ->
       (* XXX: need to protect the server state mutation as it can be updated concurrently *)
+      log "newArchive";
       Server.newArchive t opam archive; OnewArchive in 
-  output_value stdout output
+
+  output_value stdout output;
+  flush stdout
 
 let _ =
   handle_unix_error server fn

src/path.ml

@@ -1,5 +1,8 @@
 open Namespace
 
+let log fmt =
+  Globals.log "PATH" fmt
+
 type url = {
   hostname: string;
   port: int;
@@ -257,31 +260,33 @@ module Path : PATH = struct
 
   end
 
-  let add t f = function 
-  | Directory d -> failwith "to complete !"
-  | File (Binary cts) -> 
-      let () = contents (fun _ -> failwith "to complete !") Unix.unlink () t f in
-      let fic = s_of_filename f in
-      U.mkdir (fun fic -> BatFile.with_file_out fic (fun oc -> BatString.print oc cts)) fic
-  | File (Filename fic) -> 
-      begin match (Unix.lstat fic).Unix.st_kind with
-      | Unix.S_DIR -> 
-          let () = contents (fun _ -> ()) (fun _ -> failwith "to complete !") () t f in
-          let rec aux f_from f_to = 
-            (match (Unix.lstat f_from).Unix.st_kind with
-            | Unix.S_DIR -> List.fold_left (fun _ b -> aux (f_from // b) (f_to // b)) () (BatSys.files_of f_from)
-            | Unix.S_REG -> 
-                let () = 
-                  if Sys.file_exists f_to then
-                    Unix.unlink f_to
-                  else
-                    () in
-                U.link f_from f_to
-            | _ -> failwith "to complete !") in
-          aux fic (s_of_filename f)
-      | _ -> Printf.kprintf failwith "to complete ! copy the given filename %s" fic
-      end
-  | Not_exists -> ()
+  let add t f content =
+    log "add %s" (s_of_filename f);
+    match content with
+    | Directory d -> failwith "to complete !"
+    | File (Binary cts) -> 
+        let () = contents (fun _ -> failwith "to complete !") Unix.unlink () t f in
+        let fic = s_of_filename f in
+        U.mkdir (fun fic -> BatFile.with_file_out fic (fun oc -> BatString.print oc cts)) fic
+    | File (Filename fic) -> 
+        begin match (Unix.lstat fic).Unix.st_kind with
+        | Unix.S_DIR -> 
+            let () = contents (fun _ -> ()) (fun _ -> failwith "to complete !") () t f in
+            let rec aux f_from f_to = 
+              (match (Unix.lstat f_from).Unix.st_kind with
+              | Unix.S_DIR -> List.fold_left (fun _ b -> aux (f_from // b) (f_to // b)) () (BatSys.files_of f_from)
+              | Unix.S_REG -> 
+                  let () = 
+                    if Sys.file_exists f_to then
+                      Unix.unlink f_to
+                    else
+                      () in
+                  U.link f_from f_to
+              | _ -> failwith "to complete !") in
+            aux fic (s_of_filename f)
+        | _ -> Printf.kprintf failwith "to complete ! copy the given filename %s" fic
+        end
+    | Not_exists -> ()
 
   let exec_buildsh t n_v = 
     let _ = Sys.chdir (s_of_filename (build t (Some n_v))) in

src/server.ml

@@ -100,9 +100,16 @@ module RemoteServer : SERVER with type t = url = struct
   let send url (m : input_api) =
     let host = (gethostbyname(gethostname ())).h_addr_list.(0) in
     let addr = ADDR_INET (host, url.port) in
-    let stdin, stdout = open_connection addr in
-    output_value stdout m;
-    (input_value stdin : output_api)
+    try
+      let stdin, stdout = open_connection addr in
+      output_value stdout m;
+      flush stdout;
+      (input_value stdin : output_api)
+    with _ ->
+      Printf.eprintf
+        "ERROR: The server (%s) is unreachable. Please check your network configuration.\n%!"
+        (string_of_url url);
+      exit 1
 
   let error str =
     failwith (str ^ ": protocol error")