Permalink
Browse files

Merge pull request #333 from venator/darcs-backend

Darcs backend
  • Loading branch information...
2 parents c812512 + 24456f0 commit 8713952e6ae9b29b736d8fc82bb982aae983399c @samoht samoht committed Dec 18, 2012
View
@@ -174,6 +174,7 @@ let repo_kind_flag =
"http" , `http;
"local", `local;
"git" , `git;
+ "darcs" , `darcs;
(* aliases *)
"wget" , `http;
@@ -182,7 +183,7 @@ let repo_kind_flag =
] in
mk_opt ["k";"kind"]
"KIND" "Specify the kind of the repository to be set (the main ones \
- are 'http', 'local' or 'git')."
+ are 'http', 'local', 'git' or 'darcs')."
Arg.(some (enum kinds)) None
let pattern_list =
@@ -728,14 +729,15 @@ let pin =
let pin_option =
let doc =
Arg.info ~docv:"PIN" ~doc:
- "Specific version, local path or git url to pin the package to,
+ "Specific version, local path, git or darcs url to pin the package to,
or 'none' to unpin the package." [] in
Arg.(value & pos 1 (some string) None & doc) in
let list = mk_flag ["l";"list"] "List the currently pinned packages." in
let kind =
let doc = Arg.info ~docv:"KIND" ~doc:"Force the kind of pinning." ["k";"kind"] in
let kinds = [
"git" , `git;
+ "darcs" , `darcs;
"version", `version;
"local" , `local;
"rsync" , `local;
@@ -791,10 +793,10 @@ let default =
`P "OPAM is a package manager for OCaml. It uses the powerful mancoosi
tools to handle dependencies, including support for version
constraints, optional dependencies, and conflicts management.";
- `P "It has support for different repository backends such as HTTP, rsync and
- git. It handles multiple OCaml versions concurrently, and is flexible
- enough to allow you to use your own repositories and packages in
- addition of the ones it provides.";
+ `P "It has support for different repository backends such as HTTP, rsync, git
+ and darcs. It handles multiple OCaml versions concurrently, and is
+ flexible enough to allow you to use your own repositories and packages
+ in addition of the ones it provides.";
`P "Use either `$(mname) $(i,COMMAND) --help` or `$(mname) help $(i,COMMAND)'
for more information on a specific command.";
] @ help_sections
View
@@ -23,6 +23,7 @@ let log fmt =
let () =
OpamHTTP.register ();
OpamGit.register ();
+ OpamDarcs.register();
OpamLocal.register ()
let confirm fmt =
@@ -777,7 +778,7 @@ let install_compiler t ~quiet switch compiler =
let update_pinned_package t nv pin =
match kind_of_pin_option pin with
- | (`git|`local as k) ->
+ | (`git|`darcs|`local as k) ->
let path = OpamFilename.raw_dir (path_of_pin_option pin) in
let module B = (val OpamRepository.find_backend k: OpamRepository.BACKEND) in
let build = OpamPath.Switch.build t.root t.switch nv in
View
@@ -172,6 +172,7 @@ module URL = struct
let to_string filename t =
let url_name = match t.kind with
| Some `git -> "git"
+ | Some `darcs -> "darcs"
| None
| Some `http -> "archive"
| Some `local -> OpamGlobals.error_and_exit "Local packages are not (yet) supported." in
View
@@ -372,7 +372,7 @@ module URL: sig
(** URL address *)
val url: t -> string
- (** Backend kind (could be curl/rsync/git at the moment) *)
+ (** Backend kind (could be curl/rsync/git/darcs at the moment) *)
val kind: t -> repository_kind option
(** Archive checksum *)
View
@@ -54,7 +54,7 @@ type repository_name = OpamRepositoryName.t
type 'a repository_name_map = 'a OpamRepositoryName.Map.t
-type repository_kind = [`http|`local|`git]
+type repository_kind = [`http|`local|`git|`darcs]
type repository = {
repo_name : repository_name;
@@ -67,6 +67,7 @@ let string_of_repository_kind = function
| `http -> "http"
| `local -> "local"
| `git -> "git"
+ | `darcs -> "darcs"
let repository_kind_of_string = function
| "wget"
@@ -75,6 +76,7 @@ let repository_kind_of_string = function
| "rsync"
| "local" -> `local
| "git" -> `git
+ | "darcs" -> `darcs
| s -> OpamGlobals.error_and_exit "%s is not a valid repository kind." s
type variable = OpamVariable.t
@@ -172,9 +174,10 @@ type pin_option =
| Version of version
| Path of dirname
| Git of dirname
+ | Darcs of dirname
| Unpin
-type pin_kind = [`version|`git|`local|`unpin]
+type pin_kind = [`version|`git|`darcs|`local|`unpin]
let pin_option_of_string ?kind s =
match kind with
@@ -184,6 +187,11 @@ let pin_option_of_string ?kind s =
Git (OpamFilename.Dir.of_string s)
else
Git (OpamFilename.raw_dir s)
+ | Some `darcs ->
+ if Sys.file_exists s then
+ Darcs (OpamFilename.Dir.of_string s)
+ else
+ Darcs (OpamFilename.raw_dir s)
| Some `local -> Path (OpamFilename.Dir.of_string s)
| Some `unpin -> Unpin
| None ->
@@ -199,12 +207,14 @@ let pin_option_of_string ?kind s =
let string_of_pin_kind = function
| `version -> "version"
| `git -> "git"
+ | `darcs -> "darcs"
| `local -> "local"
| `unpin -> "unpin"
let pin_kind_of_string = function
| "version" -> `version
| "git" -> `git
+ | "darcs" -> `darcs
| "rsync"
| "local" -> `local
| "unpin" -> `unpin
@@ -218,12 +228,14 @@ type pin = {
let path_of_pin_option = function
| Version v -> OpamPackage.Version.to_string v
| Git p
+ | Darcs p
| Path p -> OpamFilename.Dir.to_string p
| Unpin -> "none"
let kind_of_pin_option = function
| Version _ -> `version
| Git _ -> `git
+ | Darcs _ -> `darcs
| Path _ -> `local
| Unpin -> `unpin
View
@@ -142,13 +142,13 @@ type repository_name = OpamRepositoryName.t
type 'a repository_name_map = 'a OpamRepositoryName.Map.t
(** Repository kind *)
-type repository_kind = [`http|`local|`git]
+type repository_kind = [`http|`local|`git|`darcs]
(** Pretty-print repository kinds. *)
-val string_of_repository_kind: [`http|`local|`git] -> string
+val string_of_repository_kind: [`http|`local|`git|`darcs] -> string
(** Parser of repository kinds. Raise an error if the kind is not valid. *)
-val repository_kind_of_string: string -> [`http|`local|`git]
+val repository_kind_of_string: string -> [`http|`local|`git|`darcs]
(** Repositories *)
type repository = {
@@ -289,6 +289,7 @@ type pin_option =
| Version of version
| Path of dirname
| Git of dirname
+ | Darcs of dirname
| Unpin
(** Pinned packages *)
@@ -301,7 +302,7 @@ type pin = {
val string_of_pin: pin -> string
(** Pin kind *)
-type pin_kind = [`version|`git|`local|`unpin]
+type pin_kind = [`version|`git|`darcs|`local|`unpin]
(** Pretty-printing of pin kinds. *)
val pin_kind_of_string: string -> pin_kind
@@ -0,0 +1,169 @@
+(***********************************************************************)
+(* *)
+(* Copyright 2012 OCamlPro *)
+(* Copyright 2012 INRIA *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Public License version 3.0. *)
+(* *)
+(* OPAM is distributed in the hope that it will be useful, *)
+(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
+(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
+(* GNU General Public License for more details. *)
+(* *)
+(***********************************************************************)
+
+(* Note: this module is heavily inspired by (and tries to stay close to) OpamGit *)
+
+open OpamTypes
+open OpamFilename.OP
+
+let log fmt = OpamGlobals.log "Darcs" fmt
+
+let darcs_fetch local_path remote_address =
+ OpamGlobals.msg "Fetching %s ...\n" (OpamFilename.Dir.to_string remote_address);
+ OpamFilename.in_dir local_path (fun () ->
+ (* Fetch the changes and save them to a temporary patch bundle *)
+ OpamSystem.command [ "darcs" ; "fetch"; "--all"; "--output=opam_update.bundle"]
+ )
+
+let darcs_merge local_path =
+ OpamFilename.in_dir local_path (fun () ->
+ let patches_bundle = OpamFilename.of_string "opam_update.bundle" in
+ if OpamFilename.exists patches_bundle then
+ OpamSystem.command [ "darcs" ; "apply"; "opam_update.bundle" ];
+ OpamFilename.remove patches_bundle
+ )
+
+(* Look for file pathes {packages,compilers}/* in a set of XML lines. *)
+let files_of_xmlchanges lines =
+ let rex = Re_perl.compile_pat "((packages|compilers)((/[\\.\\w]+))+)" in
+ let rec aux acc = function
+ | [] -> acc
+ | h :: t ->
+ try
+ let subs = Re.exec rex h in
+ let file = Re.get subs 1 in
+ aux (file :: acc) t
+ with Not_found ->
+ aux acc t
+ in
+ aux [] lines
+
+(* Return the list of modified files of the darcs repository located
+ at [dirname].
+ There is no simple way to get a diff of files with differences between the
+ local and a remote repository, with darcs, as 'git diff --name-only'. We use
+ the following workaround:
+ 1. Tag the current state of the repo 'opam_update'
+ 2. Pull (fetch and apply) all new patches
+ 3. Get the changes made to the repo since the 'opam_update' tag, in a XML format
+ 4. Back to initial state: obliterate the 'opam_update' tag and all subsequent patches *)
+let darcs_diff local_path =
+ OpamFilename.in_dir local_path (fun () ->
+ OpamSystem.commands [
+ [ "darcs" ; "tag" ; "--author=opam@ocamlpro.com" ; "opam_update" ] ;
+ [ "darcs" ; "pull"; "--all" ]
+ ];
+ let xml_changes = OpamSystem.read_command_output
+ [ "darcs" ; "changes" ; "--xml-output" ; "--summary" ; "--from-tag=opam_update" ] in
+ let files = files_of_xmlchanges xml_changes in
+ OpamSystem.command [ "darcs" ; "obliterate" ; "--all" ; "--from-tag=opam_update" ];
+ OpamFilename.Set.of_list (List.map OpamFilename.of_string files)
+ )
+
+let darcs_init address =
+ let repo = OpamFilename.Dir.to_string address in
+ OpamSystem.commands [
+ (* Initialize a new darcs repository, and set a default source repository.
+ The dummy tag prevents the patches from being actually fetched. We use
+ the 'fetch' command because there is no dedicated command with darcs to set
+ a remote repository, as 'git remote'. *)
+ [ "darcs" ; "initialize" ];
+ [ "darcs" ; "fetch" ; "--tags=ThisIsADummyTag#00"; "--set-default" ; repo ];
+ ]
+
+let check_updates local_path remote_address=
+ if OpamFilename.exists_dir (local_path / "_darcs") then begin
+ darcs_fetch local_path remote_address;
+ let files = darcs_diff local_path in
+ darcs_merge local_path;
+ Some files
+ end else
+ None
+
+module B = struct
+
+ let updates r =
+ OpamPath.Repository.root r // "last-darcs-updates"
+
+ let check_file file =
+ let local_repo = OpamRepository.local_repo () in
+ let updates = OpamFile.Filenames.read (updates local_repo) in
+ if OpamFilename.Set.mem file updates then
+ Result file
+ else if OpamFilename.exists file then
+ Up_to_date file
+ else
+ Not_available
+
+ let init ~address =
+ let local_repo = OpamRepository.local_repo () in
+ darcs_init address;
+ OpamFile.Filenames.write (updates local_repo) (OpamFilename.Set.empty)
+
+ let download_archive ~address nv =
+ let local_repo = OpamRepository.local_repo () in
+ let archive = OpamPath.Repository.archive local_repo nv in
+ check_file archive
+
+ let download_file ?checksum nv filename =
+ let local_repo = OpamRepository.local_repo () in
+ let basename = OpamFilename.basename filename in
+ let file = OpamPath.Repository.tmp_dir local_repo nv // OpamFilename.Base.to_string basename in
+ check_file file
+
+ let rec download_dir nv ?dst remote_address =
+ let local_repo = OpamRepository.local_repo () in
+ let dir = match dst with
+ | None ->
+ let basename = OpamFilename.Base.to_string (OpamFilename.basename_dir remote_address) in
+ OpamPath.Repository.tmp_dir local_repo nv / basename
+ | Some d -> d in
+ match check_updates dir remote_address with
+ | None ->
+ OpamFilename.mkdir dir;
+ OpamFilename.in_dir dir (fun () -> darcs_init remote_address);
+ download_dir nv ?dst remote_address
+ | Some f ->
+ if OpamFilename.Set.empty = f then
+ Up_to_date dir
+ else
+ Result dir
+
+ let update ~address =
+ let local_repo = OpamRepository.local_repo () in
+ let local_dir = OpamPath.Repository.root local_repo in
+ match check_updates local_dir address with
+ | Some f -> OpamFile.Filenames.write (updates local_repo) f; f
+ | None ->
+ OpamGlobals.error_and_exit
+ "The repository %s is not initialized correctly"
+ (OpamFilename.Dir.to_string local_dir)
+
+ let upload_dir ~address dirname =
+ let files = OpamFilename.list_files dirname in
+ try
+ OpamSystem.commands [
+ [ "darcs"; "add"; OpamFilename.Dir.to_string dirname; ];
+ [ "darcs"; "record"; "--all"; "-m"; "upload new files" ];
+ [ "darcs"; "push"; "--all"]
+ ];
+ OpamFilename.Set.of_list files
+ with _ ->
+ OpamFilename.Set.empty
+
+end
+
+let register () =
+ OpamRepository.register_backend `darcs (module B: OpamRepository.BACKEND)
@@ -25,7 +25,7 @@ let rsync ?(delete=true) src dst =
OpamSystem.mkdir dst;
let delete = if delete then ["--delete"] else [] in
try
- let lines = OpamSystem.read_command_output (["rsync" ; "-arv"; "--exclude"; ".git/*"; src; dst] @ delete) in
+ let lines = OpamSystem.read_command_output (["rsync" ; "-arv"; "--exclude"; ".git/*"; "--exclude"; "_darcs/*"; src; dst] @ delete) in
match OpamMisc.rsync_trim lines with
| [] -> Up_to_date []
| lines -> Result lines
@@ -6,6 +6,7 @@ begin library "opam-repositories"
"opamHTTP.ml"
"opamLocal.ml"
"opamGit.ml"
+ "opamDarcs.ml"
]
requires = [
@@ -19,6 +19,7 @@ open OpamFilename.OP
let () =
OpamHTTP.register ();
OpamGit.register ();
+ OpamDarcs.register ();
OpamLocal.register ()
let log fmt = OpamGlobals.log "OPAM-MK-REPO" fmt

0 comments on commit 8713952

Please sign in to comment.