WIP

opam.ocp

@@ -103,24 +103,29 @@ end
 
 
 (* GIT *)
+begin library "opam-git-lib"
+  files = [ "src/repo/git/git.ml" ]
+  requires = [ "opam-lib" ]
+end
+
 begin program "opam-git-init"
   files = [ "src/repo/git/init.ml" ]
-  requires = [ "opam-lib" ]
+  requires = [ "opam-git-lib" ]
 end
 
 begin program "opam-git-update"
   files = [ "src/repo/git/update.ml" ]
-  requires = [ "opam-lib" ]
+  requires = [ "opam-git-lib" ]
 end
 
 begin program "opam-git-download"
   files = [ "src/repo/git/download.ml" ]
-  requires = [ "opam-lib" ]
+  requires = [ "opam-git-lib" ]
 end
 
 begin program "opam-git-upload"
   files = [ "src/repo/git/upload.ml" ]
-  requires = [ "opam-lib" ]
+  requires = [ "opam-git-lib" ]
 end
 
 

src/file.ml

@@ -101,20 +101,28 @@ module URL = struct
 
   let internal = "url"
 
-  type t = filename list
+  type t = (filename * string) list
 
   let empty = []
 
   let of_string f s =
     let lines = Lines.of_string f s in
     Utils.filter_map (function
-      | []    -> None
-      | [url] -> Some (Filename.of_string url)
-      | s     -> Globals.error_and_exit "%s is not a valid url" (String.concat " " s)
+      | []         -> None
+      | [url]      ->
+          let url = Filename.of_string url in
+          let kind =
+            if Filename.exists url then
+              "rsync"
+            else
+              "curl" in
+          Some (url, kind)
+      | [url;kind] -> Some (Filename.of_string url, kind)
+      | h          -> Globals.error_and_exit "%s is not a valid url" (String.concat " " h)
     ) lines
 
   let to_string f t =
-    let lines = List.map (fun f -> [Filename.to_string f]) t in
+    let lines = List.map (fun (f,k) -> [Filename.to_string f; k]) t in
     Lines.to_string f lines
 
 end

src/file.mli

@@ -367,7 +367,7 @@ module Subst: sig
 end
 
 (** {2 Urls for OPAM repositories *)
-module URL: IO_FILE with type t = filename list
+module URL: IO_FILE with type t = (filename * string) list
 
 (** {2 urls.txt file *} *)
 module Urls_txt: IO_FILE with type t = (basename * int * string) list

src/path.ml

@@ -201,6 +201,8 @@ module R = struct
 
   let files t nv = package t nv / "files"
 
+  let tmp_dir t nv = t / "tmp" / NV.to_string nv
+
   let available_files t nv =
     if Dirname.exists (files t nv) then
       Filename.rec_list (files t nv)

src/path.mli

@@ -244,4 +244,7 @@ module R: sig
   (** All files in the file dir *)
   val available_files: t -> nv -> filename list
 
+  (** Tempory folder {i $opam/repo/$repo/tmp/$NAME.$VERSION/} *)
+  val tmp_dir: t -> nv -> dirname
+
 end

src/repo/curl/curl.ml

@@ -56,7 +56,7 @@ module Sync = struct
       let local_file = local_of_remote_file state remote_file in
       if same_digest state t ~local_file ~remote_file then
         (* Do not overwrite the file if it is already there, with the right contents *)
-        Some (local_file, false)
+        Some local_file
       else begin
         log "dowloading %s" (Filename.to_string remote_file);
         let local_dir = Filename.dirname local_file in
@@ -74,7 +74,7 @@ module Sync = struct
               with Not_found ->
                 ()
             end;
-            Some (local_file, true)
+            Some local_file
     end
   end
 

src/repo/git/download.ml

@@ -2,51 +2,44 @@
 
 let _ =
   if Array.length Sys.argv <> 3 then (
-    Printf.eprintf "Usage: %s <remote-address> <package>" Sys.argv.(0);
+    Printf.eprintf "Usage: %s <remote_file> <package>" Sys.argv.(0);
     exit 1
   )
 
 open Types
 
-let local_path = Dirname.cwd ()
-let local_repo = Path.R.of_dirname local_path
-let remote_address = Sys.argv.(1)
-let package = Sys.argv.(2)
-let nv = NV.of_string package
-
-let git_root = local_path / "git"
-let git_dir = git_root / package
-
-let git_archive () =
+let git_archive t state nv url =
+  let git_dir = state.git_dir nv in
   (* If the git repo is not already there, then clone it *)
   if not (Dirname.exists git_dir) then (
-    let urls = File.URL.read (Path.R.url local_repo nv) in
-    Dirname.mkdir git_root;
-    Dirname.in_dir git_root (fun () ->
-      let url = match urls with h::_ -> Filename.to_string h | _ -> assert false in
-      let err = Run.command [ "git" ; "clone" ; url ; package ] in
+    Dirname.mkdir state.git_root;
+    Dirname.in_dir state.git_root (fun () ->
+      let err = Run.command [ "git" ; "clone" ; url ; NV.to_string nv ] in
       if err <> 0 then
         Globals.error_and_exit "%s is not a valid git url" url
     )
   );
   (* Then run git-archive to get a tar.gz *)
   Dirname.in_dir git_dir (fun () ->
-    let tar = package ^ ".tar" in 
+    let tar = NV.to_string nv ^ ".tar" in 
     let err =
       Run.commands [ 
-        [ "git" ; "archive" ; "--format=tar" ; "--prefix="^package^"/" ; "HEAD" ; "-o" ; tar ] ;
+        [ "git" ; "archive" ; "--format=tar" ; "--prefix="^NV.to_string nv^"/" ; "HEAD" ; "-o" ; tar ] ;
         [ "gzip" ; "-f" ; tar ] ;
       ] in
     if err <> 0 then
       Globals.error_and_exit "Cannot run git-archive in %s" (Dirname.to_string git_dir)
   )
 
 let () =
+  let t = Repo_helpers.make_state () in
+  let state = Git.make_state false t in
+
   (* Run git-archive in the right directory *)
-  git_archive ();
+  git_archive t state nv (Dirname.to_string t.remote_path)
 
   (* and copy the archive at the right place *)
-  Dirname.mkdir (Path.R.archives_dir local_repo);
+  Dirname.mkdir (Path.R.archives_dir t.local_repo);
   Filename.move
-    (git_dir // (package ^ ".tar.gz"))
-    (Path.R.archive local_repo nv)
+    (state.git_dir nv // ((NV.to_string nv) ^ ".tar.gz"))
+    (Path.R.archive t.local_repo nv)

src/repo/git/git.ml

@@ -0,0 +1,90 @@
+open Types
+open Repo_helpers
+
+let log fmt = Globals.log "git" fmt
+
+type state = {
+  git_root: dirname;
+  git_dir : NV.t -> dirname;
+  diffs   : Filename.Set.t;
+}
+
+let git_fetch dirname =
+  Dirname.in_dir dirname (fun () ->
+    let err = Run.command [ "git" ; "fetch" ; "origin" ] in
+    if err <> 0 then
+      Globals.error_and_exit
+        "Cannot fetch git repository %s"
+        (Dirname.to_string dirname)
+  )
+
+let git_merge dirname =
+  Dirname.in_dir dirname (fun () ->
+      let err = Run.command [ "git" ; "merge" ; "origin/master" ] in
+      if err <> 0 then
+        Globals.error_and_exit
+          "Cannot update git repository %s"
+          (Dirname.to_string dirname)
+    )
+
+(* Return the list of modified files of the git repository located
+   at [dirname] *)
+let get_diff t dirname =
+  Dirname.in_dir dirname (fun () ->
+    match
+      Run.read_command_output
+        [ "git" ; "diff" ; "remotes/origin/master" ; "--name-only" ]
+    with
+    | Some fs -> Filename.Set.of_list (List.map ((//) t.remote_path) fs)
+    | None    ->
+        Globals.error_and_exit
+          "Cannot diff git repository %s"
+          (Dirname.to_string dirname)
+  )
+
+let make_state fetch t =
+  log "make_state fetch=%b" fetch;
+  let git_root = t.local_path / "git" in
+  let git_dir nv = git_root / (NV.to_string nv) in
+  let diffs =
+    if Dirname.exists (t.local_path / ".git") then begin
+      if fetch then git_fetch t.local_path;
+      get_diff t t.local_path
+    end else
+      Filename.Set.empty in
+  { git_root; git_dir; diffs }
+
+module Sync = struct
+
+  type t = state
+
+  let update state =
+    if not (Filename.Set.is_empty (get_diff state state.local_path)) then
+      git_merge state.local_path
+
+  let file state t filename =
+    update state;
+    let local_file = Repo_helpers.local_of_remote_file state filename in
+    if Filename.exists local_file then
+      Some local_file
+    else
+      None
+
+  let dir state t dirname =
+    update state;
+    let local_dir = Repo_helpers.local_of_remote_dir state dirname in
+    if Dirname.exists local_dir then
+      Filename.Set.of_list (Filename.rec_list local_dir)
+    else
+      Filename.Set.empty
+
+  let same_digest state t ~local_file ~remote_file =
+    true
+
+  let upload state t =
+    assert false
+
+end
+
+module M = Repo_helpers.Make(Sync)
+include M

src/repo/git/init.ml

@@ -17,26 +17,21 @@ let _ =
   )
 
 open Types
+open Repo_helpers
+open Git
 
-let remote_address = Sys.argv.(1)
-let local_dir = Dirname.cwd ()
-
-let git_clone () =
+let git_init t =
+  let repo = Dirname.to_string t.remote_path in
   let err =
     Run.commands [
       [ "git" ; "init" ] ;
-      [ "git" ; "remote" ; "add" ; "origin" ; remote_address ] ;
+      [ "git" ; "remote" ; "add" ; "origin" ; repo ] ;
     ] in
   if err <> 0 then
-    Globals.error_and_exit "Cannot clone %s" remote_address
-
-let packages () =
-  let all = Filename.rec_list local_dir in
-  NV.Set.of_list (Utils.filter_map NV.of_filename all)
+    Globals.error_and_exit "Cannot clone %s" repo
 
 let () =
-  Run.mkdir "git";
-  git_clone ();
-  File.Updated.write
-    (Path.R.updated (Path.R.of_dirname local_dir))
-    (packages ())
+  let t = Repo_helpers.make_state () in
+  let state = Git.make_state false t in
+  git_init t;
+  Dirname.mkdir state.git_root

src/repo/git/update.ml

@@ -11,48 +11,24 @@ let _ =
     exit 1;
   )
 
-let local_path = Run.cwd ()
-let remote_address = Sys.argv.(1)
-let repositories = Filename.concat local_path "git"
-
-(* Return the list of modified files of the git repository located
-   at [dirname] *)
-let get_updates dirname =
-  Run.in_dir dirname (fun () ->
-    let err = Run.command [ "git" ; "fetch" ; "origin" ] in
-    let error () = Globals.error_and_exit "Cannot fetch git repository %s" dirname in
-    if err = 0 then
-      match
-        Run.read_command_output
-          [ "git" ; "diff" ; "remotes/origin/master" ; "--name-only" ]
-      with
-      | None   -> error ()
-      | Some o -> o
-    else
-      error ()
-  )
-
-(* Update the git repository located at [dirname] *)
-let update dirname =
-  Run.in_dir dirname (fun () ->
-    let err = Run.command [ "git" ; "pull" ; "origin" ; "master" ] in
-    if err <> 0 then
-      Globals.error_and_exit "Cannot update git repository %s" dirname
-  )
-
-let needs_update dirname =
-  get_updates dirname <> []
-
 open Types
+open Repo_helpers
 
-let (++) = NV.Set.union
+open Types
 
 let () =
-  (* Look at new packages *)
-  let repo_updates = get_updates local_path in
+  let t = Repo_helpers.make_state () in
+  let state = Git.make_state true t in
+  let updates = Git.Updates.get t state in
+  File.Updated.write (Path.R.updated t.local_repo) updates
 
+(*
+  (* Look at new packages *)
   (* re-clone the repository if the url has changed *)
-  let url_updates = List.filter (Utils.starts_with ~prefix:"url/") repo_updates in
+  let url_updates =
+    Filename.Set.filter (fun f ->
+      Filename.basename f = Basename.of_string "url"
+    ) repo_updates in
   let url_updates =
     Utils.filter_map (fun url ->
       if Sys.file_exists url then begin
@@ -89,3 +65,4 @@ let () =
   File.Updated.write
     (Path.R.updated (Path.R.of_dirname (Dirname.of_string local_path)))
     (repo_updates ++ url_updates ++ updates)
+*)