opamVCS.ml1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136(**************************************************************************) (* *) (* Copyright 2012-2015 OCamlPro *) (* Copyright 2012 INRIA *) (* *) (* All rights reserved. This file is distributed under the terms of the *) (* GNU Lesser General Public License version 2.1, with the special *) (* exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open OpamTypes open OpamStd.Op open OpamProcess.Job.Op module type VCS = sig val name: OpamUrl.backend val exists: dirname -> bool val init: dirname -> url -> unit OpamProcess.job val fetch: ?cache_dir:dirname -> dirname -> url -> unit OpamProcess.job val reset_tree: dirname -> url -> unit OpamProcess.job val patch_applied: dirname -> url -> unit OpamProcess.job val diff: dirname -> url -> filename option OpamProcess.job val is_up_to_date: dirname -> url -> bool OpamProcess.job val revision: dirname -> string option OpamProcess.job val versioned_files: dirname -> string list OpamProcess.job val vc_dir: dirname -> dirname val current_branch: dirname -> string option OpamProcess.job val is_dirty: dirname -> bool OpamProcess.job end module Make (VCS: VCS) = struct let name = VCS.name let fetch_repo_update repo_name ?cache_dir repo_root repo_url = if VCS.exists repo_root then OpamProcess.Job.catch (fun e -> Done (OpamRepositoryBackend.Update_err e)) @@ fun () -> OpamRepositoryBackend.job_text repo_name "sync" (VCS.fetch ?cache_dir repo_root repo_url) @@+ fun () -> OpamRepositoryBackend.job_text repo_name "diff" (VCS.diff repo_root repo_url) @@| function | None -> OpamRepositoryBackend.Update_empty | Some patch -> OpamRepositoryBackend.Update_patch patch else OpamProcess.Job.catch (fun e -> OpamFilename.rmdir repo_root; Done (OpamRepositoryBackend.Update_err e)) @@ fun () -> OpamRepositoryBackend.job_text repo_name "init" (VCS.init repo_root repo_url) @@+ fun () -> OpamRepositoryBackend.job_text repo_name "sync" (VCS.fetch ?cache_dir repo_root repo_url) @@+ fun () -> let tmpdir = OpamFilename.Dir.(of_string (to_string repo_root ^".new")) in OpamFilename.copy_dir ~src:repo_root ~dst:tmpdir; OpamProcess.Job.catch (fun e -> OpamFilename.rmdir tmpdir; raise e) @@ fun () -> VCS.reset_tree tmpdir repo_url @@| fun () -> OpamRepositoryBackend.Update_full tmpdir let repo_update_complete dirname url = VCS.patch_applied dirname url @@+ fun () -> Done () let pull_url ?cache_dir dirname checksum url = if checksum <> None then invalid_arg "VC pull_url doesn't allow checksums"; OpamProcess.Job.catch (fun e -> OpamConsole.error "Could not synchronize %s from %S:\n%s" (OpamFilename.Dir.to_string dirname) (OpamUrl.to_string url) (match e with Failure fw -> fw | _ -> Printexc.to_string e); Done (Not_available (None, OpamUrl.to_string url))) @@ fun () -> if VCS.exists dirname then VCS.fetch ?cache_dir dirname url @@+ fun () -> VCS.is_up_to_date dirname url @@+ function | true -> Done (Up_to_date None) | false -> VCS.reset_tree dirname url @@+ fun () -> Done (Result None) else (OpamFilename.mkdir dirname; VCS.init dirname url @@+ fun () -> VCS.fetch ?cache_dir dirname url @@+ fun () -> VCS.reset_tree dirname url @@+ fun () -> Done (Result None)) let revision repo_root = VCS.revision repo_root @@+ fun r -> Done (OpamStd.Option.map OpamPackage.Version.of_string r) let sync_dirty repo_root repo_url = match OpamUrl.local_dir repo_url with | None -> pull_url repo_root None repo_url | Some dir -> VCS.versioned_files dir @@+ fun files -> let files = List.map OpamFilename.(remove_prefix dir) (OpamFilename.rec_files (VCS.vc_dir dir)) @ files in let stdout_file = let f = OpamSystem.temp_file "rsync-files" in let fd = open_out f in List.iter (fun s -> output_string fd s; output_char fd '\n') files; close_out fd; f in (* Remove non-versionned files from destination *) (* fixme: doesn't clean directories *) let fset = OpamStd.String.Set.of_list files in List.iter (fun f -> let basename = OpamFilename.remove_prefix repo_root f in if not (OpamFilename.(starts_with (VCS.vc_dir repo_root) f) || OpamStd.String.Set.mem basename fset) then OpamFilename.remove f) (OpamFilename.rec_files repo_root); OpamLocal.rsync_dirs ~args:["--files-from"; stdout_file] ~exclude_vcdirs:false repo_url repo_root @@+ fun result -> OpamSystem.remove stdout_file; Done (match result with | Up_to_date _ -> Up_to_date None | Result _ -> Result None | Not_available _ as na -> na) end