Permalink
Browse files

[git] Add git repository pluggins

It compiles, but untested.

The basic idea is to have a git repository storing OPAM, description files and git urls of dev packages:

* opam-git-init clones the repository at the right place

* opam-git-download clones the git repository for the right pacakge, and call git-archive to create a .tar.gz which is copied at the right place (to follow the OPAM repository pluggin protocol)

* opam-git-update updates the main repository to look for new packages and then updates each already cloned packages to see if they need to be updated
  • Loading branch information...
1 parent fb6191e commit bc5a548df2ea7912f4bc363c2f23e9b0843a87c9 @samoht samoht committed May 15, 2012
Showing with 185 additions and 3 deletions.
  1. +3 −1 Makefile
  2. +23 −0 opam.ocp
  3. +49 −0 src/repo/git/download.ml
  4. +27 −0 src/repo/git/init.ml
  5. +62 −0 src/repo/git/update.ml
  6. +4 −0 src/repo/git/upload.ml
  7. +1 −1 src/repo/rsync/init.ml
  8. +3 −0 src/run.mli
  9. +9 −1 src/types.ml
  10. +4 −0 src/types.mli
View
@@ -2,7 +2,9 @@ BIN = /usr/local/bin
OCPBUILD ?= ./_obuild/unixrun ./boot/ocp-build.boot
OCAMLC=ocamlc
SRC_EXT=src_ext
-TARGETS = opam opam-rsync-init opam-rsync-update opam-rsync-download opam-rsync-upload
+TARGETS = opam opam-rsync-init \
+ opam-rsync-update opam-rsync-download opam-rsync-upload \
+ opam-git-update opam-git-download opam-git-upload
.PHONY: all
View
@@ -48,6 +48,7 @@ end
(* Repository Scripts *)
+(* RSYNC *)
begin program "opam-rsync-init"
files = [ "src/repo/rsync/init.ml" ]
requires = [ "opam-lib" ]
@@ -68,3 +69,25 @@ begin program "opam-rsync-upload"
requires = [ "opam-lib" ]
end
+
+(* GIT *)
+begin program "opam-git-init"
+ files = [ "src/repo/git/init.ml" ]
+ requires = [ "opam-lib" ]
+end
+
+begin program "opam-git-update"
+ files = [ "src/repo/git/update.ml" ]
+ requires = [ "opam-lib" ]
+end
+
+begin program "opam-git-download"
+ files = [ "src/repo/git/download.ml" ]
+ requires = [ "opam-lib" ]
+end
+
+begin program "opam-git-upload"
+ files = [ "src/repo/git/upload.ml" ]
+ requires = [ "opam-lib" ]
+end
+
View
@@ -0,0 +1,49 @@
+(* Download script for git repositories *)
+
+let _ =
+ if Array.length Sys.argv <> 3 then (
+ Printf.eprintf "Usage: opam-rsync-init <remote-address> <package>";
+ exit 1
+ )
+
+
+let local_path = Run.cwd ()
+let remote_address = Sys.argv.(1)
+let package = Sys.argv.(2)
+
+let (/) = Filename.concat
+
+let git_archive () =
+ let dirname = local_path / "git" / package in
+ (* If the git repo is not already there, then clone it *)
+ if not (Sys.file_exists dirname) then (
+ let url =
+ let p = local_path / "url" / package in
+ if Sys.file_exists p then
+ Run.read p
+ else
+ Globals.error_and_exit "Cannot find %s" p in
+ Run.mkdir "git";
+ Run.in_dir (local_path / "git") (fun () ->
+ let err = Run.command "git clone %s %s" url package 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 *)
+ Run.in_dir dirname (fun () ->
+ let err =
+ Run.command "git archive --format=tar --prefix=%s HEAD | gzip > %s.tar.gz" package package in
+ if err <> 0 then
+ Globals.error_and_exit "Cannot run git-archive in %s" dirname
+ )
+
+let () =
+ (* Run git-archive in the right directory *)
+ git_archive ();
+
+ (* and copy the archive at the right place *)
+ Run.mkdir (local_path / "archive");
+ Run.copy
+ (local_path / "git" / package / package ^ ".tar.gz")
+ (local_path / "archive" / package ^ ".tar.gz")
View
@@ -0,0 +1,27 @@
+(* Init script for git repositories *)
+
+(* Git repositories should have the following structure:
+ - opam/ contains the OPAM files
+ - descr/ contains the description files
+ - url/$name.$version contains the git url for package
+ $name.version
+ - git/$name.$version/ will contain the git repo for the
+ package $name.$version when it will
+ be cloned
+*)
+
+let _ =
+ if Array.length Sys.argv <> 2 then (
+ Printf.eprintf "Usage: opam-git-init <remote-address>";
+ exit 1
+ )
+
+let remote_address = Sys.argv.(1)
+
+let git_clone () =
+ let err =
+ Run.command "git clone %s ./" remote_address in
+ exit err
+
+let () =
+ git_clone ()
View
@@ -0,0 +1,62 @@
+(* Update script for git repositories *)
+
+(* The update script:
+ - pull the main repo to see if some new packages are available
+ - pull each git sub-repo to see if the package has been updated
+*)
+
+let _ =
+ if Array.length Sys.argv <> 2 then (
+ Printf.eprintf "Usage: opam-git-init <remote-address>";
+ exit 1;
+ )
+
+let local_path = Run.cwd ()
+let remote_address = Sys.argv.(1)
+let repositories = Filename.concat local_path "repositories"
+
+(* 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
+ if err = 0 then
+ Run.read_command_output "git diff remotes/origin/master --name-only"
+ else
+ Globals.error_and_exit "Cannot fetch git repository %s" dirname
+ )
+
+(* 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
+
+let () =
+ (* Look at new packages *)
+ (* XXX: do something if a file related to an already cloned sub-tree is modified *)
+ let repo_updates = get_updates local_path in
+ let repo_updates =
+ Utils.filter_map (fun f -> NV.of_filename (Filename.of_string f)) repo_updates in
+ let repo_updates = List.fold_right NV.Set.add repo_updates NV.Set.empty in
+
+ (* Look at already cloned packages *)
+ let dirs = Run.directories repositories in
+ let updates = List.filter needs_update dirs in
+ let updates = Utils.filter_map (fun d -> NV.of_dirname (Dirname.of_string d)) updates in
+ let updates = List.fold_right NV.Set.add updates NV.Set.empty in
+
+ (* Write $opam/repo/$repo/updated *)
+ File.Updated.write
+ (Path.R.updated (Path.R.of_path (Dirname.of_string local_path)))
+ (NV.Set.union repo_updates updates)
+
+
+
View
@@ -0,0 +1,4 @@
+(* Upload script for git repositories *)
+
+let () =
+ Globals.error_and_exit "Upload capacity is not available for GIT repositories"
View
@@ -9,7 +9,7 @@ let _ =
let remote_address = Sys.argv.(1)
let rsync dir =
- Run.mkdir "opam";
+ Run.mkdir dir;
let err =
Run.command "rsync -ar %s/ %s/"
(Filename.concat remote_address dir) dir in
View
@@ -49,6 +49,9 @@ val in_dir: string -> (unit -> 'a) -> 'a
(** [files dir] returns the files in the directory [dir] *)
val files: string -> string list
+(** [files dir] returns the directories in the directory [dir] *)
+val directories: string -> string list
+
(** [command fmt] executes the command [fmt] *)
val command: ('a, unit, string, int) format4 -> 'a
View
@@ -46,6 +46,7 @@ module Dirname: sig
val mkdir: t -> unit
val exec: t -> string list -> int
val chdir: t -> unit
+ val basename: t -> string
end = struct
include Base
@@ -65,6 +66,9 @@ end = struct
let chdir dirname =
Unix.chdir (to_string dirname)
+ let basename dirname =
+ Filename.basename (to_string dirname)
+
end
type dirname = Dirname.t
@@ -220,6 +224,7 @@ module NV: sig
val version: t -> version
val create: name -> version -> t
val of_filename: filename -> t option
+ val of_dirname: dirname -> t option
val of_dpkg: Debian.Packages.package -> t
val of_cudf: Debian.Debcudf.tables -> Cudf.package -> t
val to_map: Set.t -> V.Set.t N.Map.t
@@ -256,7 +261,10 @@ end = struct
else if F.check_suffix b ".tar.gz" then
check (F.chop_suffix b ".tar.gz")
else
- None
+ check b
+
+ let of_dirname d =
+ check (Dirname.basename d)
let of_dpkg d =
{ name = N.of_string d.Debian.Packages.name;
View
@@ -176,6 +176,10 @@ module NV: sig
with various heuristics.*)
val of_filename: filename -> t option
+ (** Create a new pair from a directory name. This function extracts {i
+ $name} and {i $version} from {i /path/to/$name.$version/} *)
+ val of_dirname: dirname -> t option
+
(** Create a new pair from a debian package *)
val of_dpkg: Debian.Packages.package -> t

0 comments on commit bc5a548

Please sign in to comment.